New patches: [Added documentation. Thomas Schilling **20070528211221] { hunk ./Distribution/ParseUtils.hs 136 +-- Parser combinator for simple fields. Takes a field name, a pretty printer, +-- a parser function, an accessor, and a modifier, returns a package +-- FieldDescr over the compoid structure. } [Extended low-level parsing routines to also allow labelled blocks and if-blocks. Thomas Schilling **20070529205958] { hunk ./Distribution/InstalledPackageInfo.hs 59 - LineNo, simpleField, listField, parseLicenseQ, + Field(F), simpleField, listField, parseLicenseQ, hunk ./Distribution/InstalledPackageInfo.hs 159 - -> (LineNo, String, String) + -> Field hunk ./Distribution/InstalledPackageInfo.hs 161 -parseBasicStanza ((FieldDescr name _ set):fields) pkg (lineNo, f, val) +parseBasicStanza ((FieldDescr name _ set):fields) pkg (F lineNo f val) hunk ./Distribution/InstalledPackageInfo.hs 163 - | otherwise = parseBasicStanza fields pkg (lineNo, f, val) -parseBasicStanza [] pkg (_, _, _) = return pkg + | otherwise = parseBasicStanza fields pkg (F lineNo f val) +parseBasicStanza [] pkg _ = return pkg hunk ./Distribution/PackageDescription.hs 595 - parseExtraStanza pkg st@((_lineNo, "executable",_eName):_) = do + parseExtraStanza pkg st@((F _lineNo "executable" _eName):_) = do hunk ./Distribution/PackageDescription.hs 611 -isStanzaHeader (_,f,_) = f == "executable" +isStanzaHeader (F _ f _) = f == "executable" hunk ./Distribution/PackageDescription.hs 617 -parseField ((FieldDescr name _ parse):fields) a (lineNo, f, val) +parseField ((FieldDescr name _ parse):fields) a (F lineNo f val) hunk ./Distribution/PackageDescription.hs 619 - | otherwise = parseField fields a (lineNo, f, val) + | otherwise = parseField fields a (F lineNo f val) hunk ./Distribution/PackageDescription.hs 621 -parseField [] a (_, 'x':'-':_, _) = return a -parseField [] a (_, f, _) = do +parseField [] a (F _ ('x':'-':_) _) = return a +parseField [] a (F _ f _) = do hunk ./Distribution/PackageDescription.hs 628 -deprecField (line,fld,val) = do +deprecField (F line fld val) = do hunk ./Distribution/PackageDescription.hs 637 - return (line,fld',val) - + return (F line fld' val) hunk ./Distribution/PackageDescription.hs 639 + hunk ./Distribution/PackageDescription.hs 649 - parseLib (bi@((_, inFieldName, _):_)) + parseLib (bi@((F _ inFieldName _):_)) hunk ./Distribution/PackageDescription.hs 654 - parseExe ((lineNo, inFieldName, mName):bi) + parseExe ((F lineNo inFieldName mName):bi) hunk ./Distribution/ParseUtils.hs 1 +{-# OPTIONS -cpp #-} hunk ./Distribution/ParseUtils.hs 50 - Field, + Field(..), hunk ./Distribution/ParseUtils.hs 169 +------------------------------------------------------------------------------ + hunk ./Distribution/ParseUtils.hs 174 -type Field = (LineNo,String,String) + +dropSpaces :: String -> String +dropSpaces = dropWhile isSpace + +data Field = F LineNo String String + | Section String String [Field] + | IfBlock String [Field] [Field] + deriving (Show + ,Eq) -- for testing + +-- sectionname ::= "library" | "executable" +sectionNames :: [String] +sectionNames = ["library", "executable:"] hunk ./Distribution/ParseUtils.hs 190 -readFields = mkStanza . merge . filter validLine . zip [1..] . map trimTrailingSpaces . lines - where validLine (_,s) = case dropWhile isSpace s of +readFields = mkStanza + -- . merge + . filter validLine + . zip [1..] + . map trimTrailingSpaces . lines + where validLine (_,s) = case dropSpaces s of hunk ./Distribution/ParseUtils.hs 200 -merge :: [(a, [Char])] -> [(a, [Char])] -merge ((n,x):ys) = (n, x++concat (map (get_continuation . snd) rest)):merge ys' - where (rest, ys') = span (is_continuation . snd) ys - is_continuation (c:_) = isSpace c - is_continuation [] = False - get_continuation s = '\n':strip_dot (dropWhile isSpace s) - strip_dot "." = "" - strip_dot s = s -merge [] = [] - hunk ./Distribution/ParseUtils.hs 201 -mkStanza [] = return [] -mkStanza ((n,'#':xs):ys) | not (isSpace (head xs)) = do - ss <- mkStanza ys - return ((n, '#':dir, dropWhile isSpace val) : ss) +mkStanza lines = parseLines lines [] + where + parseLines [] fs = return (reverse fs) + parseLines ls fs = do (f, ls') <- getField ls + parseLines ls' $ maybe fs (:fs) f + +-- parses: +-- +-- field ::= '#' directive value '\n' +-- | [] fieldname ':' space* fieldvalue +-- | "if" space cond +-- | sectionname section +-- +getField :: [(Int,String)] -> ParseResult (Maybe Field,[(Int,String)]) +getField [] = return (Nothing, []) +getField ((n,[]):lines) = return (Nothing,lines) +getField ((n,'#':xs):lines) | not (isSpace (head xs)) = do + return (Just $ F n ('#':dir) (dropSpaces val), lines) hunk ./Distribution/ParseUtils.hs 220 -mkStanza ((n,xs):ys) = - case break (==':') xs of - (fld0, ':':val) -> do - let fld = map toLower fld0 - ss <- mkStanza ys - return ((n, fld, dropWhile isSpace val):ss) - (_, _) -> syntaxError n "Invalid syntax (no colon after field name)" +getField ((lineno,line0):lines) = + let (spaces,line) = span isSpace line0 + indent = length spaces in + case break (`elem` " :{") line of + (fld0, ':':val0) -> do -- regular field + let fld = map toLower fld0 + (val, lines') = getFieldValue indent (dropWhile isSpace val0) lines + return (Just $ F lineno fld val, lines') + (blkName, ' ':rest) + | map toLower blkName == "if" -> getIf (lineno,rest) lines + | map toLower blkName `elem` sectionNames -> getSection blkName (lineno,rest) lines + | otherwise -> syntaxError lineno $ + "Missing colon after field label or invalid section name" + (blkName, '{':rest) + | map toLower blkName `elem` sectionNames -> + getSection blkName (lineno,'{':rest) lines + ("","") -> return (Nothing,lines) + (_,_) -> syntaxError lineno $ + "Unrecognized field format: '" ++ line ++ "'" + + + +-- parses: +-- +-- cond ::= (any - '}')* block [ space* "else" block ] +-- +getIf :: (Int,String) -> [(Int,String)] -> ParseResult (Maybe Field,[(Int,String)]) +getIf (n,rest) lines = do + (cond, ifBlock, lines') <- + case break (=='{') (dropSpaces rest) of + (cond, '{':cs) -> + do (b,ls) <- getBlock (n,'{':cs) lines + return (cond, b, ls) + (cond, _) -> -- condition spans more than one line + syntaxError n "Multi-line conditions currently not supported." + (elseBlock, lines'') <- tryElseBlock lines' + return (Just $ IfBlock cond ifBlock elseBlock, lines'') + where + tryElseBlock [] = return ([], []) + tryElseBlock ((n,l):ls) = + if all isSpace l then return ([],ls) + else case (splitAt 4 . dropSpaces) l of + (kw, rest) -> + if kw == "else" then + getBlock (n,dropSpaces rest) ls + else syntaxError n "Only 'else' may appear after an if-Block" + +-- parses: +-- +-- block ::= space* '{' space* '\n' +-- field* +-- space* '}' space* '\n' +-- +getBlock :: (Int,String) -> [(Int,String)] -> ParseResult ([Field],[(Int,String)]) +getBlock (n,rest) lines = do + lines' <- checkBlockStart (n,dropSpaces rest) lines + munchTillEndOfBlock lines' [] + where + checkBlockStart (n,'{':cs) ls = + if all isSpace cs then return ls + else syntaxError n "Invalid characters after '{'" + checkBlockStart (_,[]) ((n,l):ls) = + checkBlockStart (n,dropSpaces l) ls + checkBlockStart (n,_) _ = syntaxError n "'{' expected" + + munchTillEndOfBlock [] _ = syntaxError (-1) "missing '}' at end of file" + munchTillEndOfBlock lines@((n,l):ls) fs = + case break (=='}') l of + (spaces, '}':rest) -> + if all isSpace spaces + then return ( reverse fs + , (n, rest):ls) + else syntaxError n "'}' must be first character on the line" + _ -> do (f,ls') <- getField lines + munchTillEndOfBlock ls' $ maybe fs (:fs) f + +-- parses: +-- +-- section ::= space* [ blocklabel ] space* block +-- +getSection :: String -> (Int,String) -> [(Int,String)] + -> ParseResult (Maybe Field,[(Int,String)]) +getSection sectName (n,l) lines = + case break (=='{') (dropSpaces l) of + (sectLabel, '{':rest) -> + do (b,lines') <- getBlock (n,'{':rest) lines + return (Just $ Section sectName sectLabel b, lines') + +-- Get the field value of a field at given indentation +getFieldValue :: Int -> String -> [(Int,String)] + -> (String,[(Int,String)]) +getFieldValue indent val lines = + ( val' ++ rest + , lines') + where + val' = dropWhile isSpace val + rest = (if val' == "" then tail else id) $ + -- don't include initial newline if it would be the first + -- character + concatMap (getContinuation . snd) valrest + + (valrest,lines') = span (isContinuation indent . snd) lines + -- the continuation of a field value is everything that is indented + -- relative to the field's label + isContinuation indent line = + length (takeWhile isSpace line) > indent && not (all isSpace line) + getContinuation line = '\n':stripDot (dropWhile isSpace line) + stripDot "." = "" + stripDot s = s + +------------------------------------------------------------------------------ hunk ./Distribution/ParseUtils.hs 434 +------------------------------------------------------------------------------ +-- TESTING + +#ifdef DEBUG +test_readFields = case readFields testFile of + ParseOk _ x -> x == expectedResult + _ -> False + where + testFile = unlines $ + [ "Cabal-version: 3" + , "" + , "Description: This is a test file " + , " with a description longer than two lines. " + , "if os(windows) {" + , " License: You may not use this software" + , " ." + , " If you do use this software you will be seeked and destroyed." + , "}" + , "if os(linux) {" + , " Main-is: foo1 " + , "}" + , "" + , "if os(vista) {" + , " executable RootKit {" + , " Main-is: DRMManager.hs" + , " }" + , "} else {" + , " executable VistaRemoteAccess {" + , " Main-is: VCtrl" + , "}}" + , "" + , "executable Foo-bar {" + , " Main-is: Foo.hs" + , "}" + ] + expectedResult = + [ F 1 "cabal-version" "3" + , F 3 "description" + "This is a test file\nwith a description longer than two lines." + , IfBlock "os(windows) " + [ F 6 "license" + "You may not use this software\n\nIf you do use this software you will be seeked and destroyed." + ] + [] + , IfBlock "os(linux) " + [ F 11 "main-is" "foo1" ] + [ ] + , IfBlock "os(vista) " + [ Section "executable" "RootKit " + [ F 16 "main-is" "DRMManager.hs"] + ] + [ Section "executable" "VistaRemoteAccess " + [F 20 "main-is" "VCtrl"] + ] + , Section "executable" "Foo-bar " + [F 24 "main-is" "Foo.hs"] + ] + +test_readFieldsCompat' = case test_readFieldsCompat of + ParseOk _ fs -> mapM_ (putStrLn . show) fs + x -> putStrLn $ "Failed: " ++ show x +test_readFieldsCompat = readFields testPkgDesc + where + testPkgDesc = unlines [ + "-- Required", + "Name: Cabal", + "Version: 0.1.1.1.1-rain", + "License: LGPL", + "License-File: foo", + "Copyright: Free Text String", + "Cabal-version: >1.1.1", + "-- Optional - may be in source?", + "Author: Happy Haskell Hacker", + "Homepage: http://www.haskell.org/foo", + "Package-url: http://www.haskell.org/foo", + "Synopsis: a nice package!", + "Description: a really nice package!", + "Category: tools", + "buildable: True", + "CC-OPTIONS: -g -o", + "LD-OPTIONS: -BStatic -dn", + "Frameworks: foo", + "Tested-with: GHC", + "Stability: Free Text String", + "Build-Depends: haskell-src, HUnit>=1.0.0-rain", + "Other-Modules: Distribution.Package, Distribution.Version,", + " Distribution.Simple.GHCPackageConfig", + "Other-files: file1, file2", + "Extra-Tmp-Files: file1, file2", + "C-Sources: not/even/rain.c, such/small/hands", + "HS-Source-Dirs: src, src2", + "Exposed-Modules: Distribution.Void, Foo.Bar", + "Extensions: OverlappingInstances, TypeSynonymInstances", + "Extra-Libraries: libfoo, bar, bang", + "Extra-Lib-Dirs: \"/usr/local/libs\"", + "Include-Dirs: your/slightest, look/will", + "Includes: /easily/unclose, /me, \"funky, path\\\\name\"", + "Install-Includes: /easily/unclose, /me, \"funky, path\\\\name\"", + "GHC-Options: -fTH -fglasgow-exts", + "Hugs-Options: +TH", + "Nhc-Options: ", + "Jhc-Options: ", + "", + "-- Next is an executable", + "Executable: somescript", + "Main-is: SomeFile.hs", + "Other-Modules: Foo1, Util, Main", + "HS-Source-Dir: scripts", + "Extensions: OverlappingInstances", + "GHC-Options: ", + "Hugs-Options: ", + "Nhc-Options: ", + "Jhc-Options: " + ] +{- +test' = do h <- openFile "../Cabal.cabal" ReadMode + s <- hGetContents h + let r = readFields s + case r of + ParseOk _ fs -> mapM_ (putStrLn . show) fs + x -> putStrLn $ "Failed: " ++ show x + putStrLn "===================" + mapM_ (putStrLn . show) $ + merge . zip [1..] . lines $ s + hClose h +-} +#endif + } [Added Configuration parsing and simplification. Thomas Schilling **20070529210344] { addfile ./Distribution/Configuration.hs hunk ./Distribution/Configuration.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Configuration +-- Copyright : Thomas Schilling 2007 +-- +-- Maintainer : Isaac Jones +-- Stability : alpha +-- Portability : portable +-- +-- Configurations + +{- All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Isaac Jones nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} + +module Distribution.Configuration where + +import Distribution.ParseUtils +import Distribution.Compat.ReadP as ReadP + +import Data.Char ( isAlphaNum, toLower ) + +data FlagValue = FLUnknown | FlTrue | FlFalse + deriving (Eq, Show) + +data Flag = MkFlag + { flagName :: String + , flagDescription :: String + , flagDefault :: FlagValue + } + +data Condition = OS String + | Arch String + | Flag String + | Lit Bool + | CNot Condition + | COr Condition Condition + | CAnd Condition Condition + deriving Show + +-- | Simplify the condition and return its free flag-variables. +simplifyCondition :: Condition + -> String -- ^ Arch identifier + -> String -- ^ OS identifier + -> (Condition, [String]) +simplifyCondition cond arch os = fv . walk $ cond + where + -- reduce arch(..) and os(..) to boolean and simplify tree + walk c = case c of + OS name -> if os == name then Lit True else Lit False + Arch a -> if a == arch then Lit True else Lit False + Flag f -> Flag f + Lit b -> Lit b + CNot c -> case walk c of + Lit True -> Lit False + Lit False -> Lit True + c' -> CNot c' + COr c d -> case (walk c, walk d) of + (Lit False, d') -> d' + (Lit True, d') -> Lit True + (c', Lit False) -> c' + (c', Lit True) -> Lit True + (c',d') -> COr c' d' + CAnd c d -> case (walk c, walk d) of + (Lit False, _) -> Lit False + (Lit True, d') -> d' + (_, Lit False) -> Lit False + (c', Lit True) -> c' + (c',d') -> CAnd c' d' + -- gather free flags + fv c = (c, fv' c) + fv' c = case c of + Flag f -> [f] + Lit b -> [] + CNot c' -> fv' c' + COr c1 c2 -> fv' c1 ++ fv' c2 + CAnd c1 c2 -> fv' c1 ++ fv' c2 + + + +parseCondition :: ReadP r Condition +parseCondition = condOr + where + condOr = sepBy1 condAnd (oper "||") >>= return . foldl1 COr + condAnd = sepBy1 cond (oper "&&")>>= return . foldl1 CAnd + cond = sp >> (lit +++ parens condOr +++ notCond +++ osCond + +++ archCond +++ flagCond) + parens = between (char '(' >> sp) (sp >> char ')' >> sp) + notCond = char '!' >> sp >> cond >>= return . CNot + osCond = string "os" >> sp >> parens osIdent >>= return . OS + archCond = string "arch" >> sp >> parens archIdent >>= return . Arch + flagCond = string "flag" >> sp >> parens flagIdent >>= return . Flag + ident = munch1 isIdentChar >>= return . map toLower + lit = ((string "true" <++ string "True") >> return (Lit True)) <++ + ((string "false" <++ string "False") >> return (Lit False)) + archIdent = ident + osIdent = ident + flagIdent = ident + isIdentChar c = isAlphaNum c || (c `elem` "_-") + oper s = sp >> string s >> sp + sp = skipSpaces + +------------------------------------------------------------------------------ +-- Testing + +test_simplifyCondition = simplifyCondition tstCond "ia32" "darwin" + where + tstCond = COr (CAnd (Arch "ppc") (OS "darwin")) + (CAnd (Flag "debug") (OS "darwin")) + +test_parseCondition = map (runP 1 "test" parseCondition) testConditions + where + testConditions = [ "os(darwin)" + , "arch(i386)" + , "!os(linux)" + , "! arch(ppc)" + , "os(windows) && arch(i386)" + , "os(windows) && arch(i386) && flag(debug)" + , "true && false || false && true" -- should be same + , "(true && false) || (false && true)" -- as this + , "(os(darwin))" + , " ( os ( darwin ) ) " + , "true && !(false || os(plan9))" + , "flag( foo_bar )" + , "flag( foo_O_-_O_bar )" + ] } [Abstracted variables out of conditions. Generalized simplification Thomas Schilling **20070613172114 function to accept an arbitrary partial assignment of these variables. ] { hunk ./Distribution/Configuration.hs 46 +import Distribution.Version hunk ./Distribution/Configuration.hs 50 -data FlagValue = FLUnknown | FlTrue | FlFalse +data FlagValue = FlUnknown | FlTrue | FlFalse hunk ./Distribution/Configuration.hs 57 - } + } deriving Show hunk ./Distribution/Configuration.hs 59 -data Condition = OS String - | Arch String - | Flag String - | Lit Bool - | CNot Condition - | COr Condition Condition - | CAnd Condition Condition +data ConfVar = OS OSName + | Arch ArchName + | Flag String + -- | Depend [Dependency] hunk ./Distribution/Configuration.hs 65 --- | Simplify the condition and return its free flag-variables. -simplifyCondition :: Condition - -> String -- ^ Arch identifier - -> String -- ^ OS identifier - -> (Condition, [String]) -simplifyCondition cond arch os = fv . walk $ cond +data Condition c = Var c + | Lit Bool + | CNot (Condition c) + | COr (Condition c) (Condition c) + | CAnd (Condition c) (Condition c) + deriving Show + +-- | The name of an operating system. Abstract, so we can implement dedicated +-- operations on them if needed. +data OSName = MkOSName String + deriving (Show, Eq) + +mkOSName :: String -> OSName +mkOSName = MkOSName + +-- | The name of an architecture. Abstract. +data ArchName = MkArchName String + deriving (Show, Eq) + +mkArchName :: String -> ArchName +mkArchName = MkArchName + +-- | Simplify the condition and return its free variables. +simplifyCondition :: Condition c + -> (c -> Maybe Bool) -- ^ (partial) variable assignment + -> (Condition c, [c]) +simplifyCondition cond i = fv . walk $ cond hunk ./Distribution/Configuration.hs 93 - -- reduce arch(..) and os(..) to boolean and simplify tree hunk ./Distribution/Configuration.hs 94 - OS name -> if os == name then Lit True else Lit False - Arch a -> if a == arch then Lit True else Lit False - Flag f -> Flag f + Var v -> maybe (Var v) Lit (i v) hunk ./Distribution/Configuration.hs 112 - -- gather free flags + -- gather free vars hunk ./Distribution/Configuration.hs 115 - Flag f -> [f] + Var v -> [v] hunk ./Distribution/Configuration.hs 121 +simplifyWithSysParams :: Condition ConfVar -> ArchName -> OSName -> + (Condition ConfVar, [String]) +simplifyWithSysParams cond arch os = (cond', flags) + where + (cond', fvs) = simplifyCondition cond interp + interp (OS name) = Just $ name == os + interp (Arch name) = Just $ name == arch + interp _ = Nothing + flags = [ fname | Flag fname <- fvs ] hunk ./Distribution/Configuration.hs 131 +-- XXX: Add instances and check +-- +-- prop_sC_idempotent cond a o = cond' == cond'' +-- where +-- cond' = simplifyCondition cond a o +-- cond'' = simplifyCondition cond' a o +-- +-- prop_sC_noLits cond a o = isLit res || not (hasLits res) +-- where +-- res = simplifyCondition cond a o +-- hasLits (Lit _) = True +-- hasLits (CNot c) = hasLits c +-- hasLits (COr l r) = hasLits l || hasLits r +-- hasLits (CAnd l r) = hasLits l || hasLits r +-- hasLits _ = False +-- hunk ./Distribution/Configuration.hs 148 -parseCondition :: ReadP r Condition +parseCondition :: ReadP r (Condition ConfVar) hunk ./Distribution/Configuration.hs 157 - osCond = string "os" >> sp >> parens osIdent >>= return . OS - archCond = string "arch" >> sp >> parens archIdent >>= return . Arch - flagCond = string "flag" >> sp >> parens flagIdent >>= return . Flag + osCond = string "os" >> sp >> parens osIdent >>= return . Var. OS + archCond = string "arch" >> sp >> parens archIdent >>= return . Var . Arch + flagCond = string "flag" >> sp >> parens flagIdent >>= return . Var . Flag hunk ./Distribution/Configuration.hs 163 - archIdent = ident - osIdent = ident + archIdent = ident >>= return . mkArchName + osIdent = ident >>= return . mkOSName hunk ./Distribution/Configuration.hs 170 + +data CondTree v c a = CondLeaf [c] [a] + | Cond (Condition v) + ([c], [a], CondTree v c a) + ([c], [a], CondTree v c a) + deriving Show + +{- +-- | A @Conditional@ guards a value of type @a@ with a condition. The idea is +-- that the value is only accessible if the condition can be satisfied. +data Conditional c a = MkCond + { condCondition :: Condition c + , condValue :: a + } deriving Show + +getValue :: Conditional c a + -> (c -> Bool) -- ^ Truth assignment for all the values. (Must be + -- defined for all free variables.) + -> Maybe a +getValue c i = case eval c of + (Lit True, _) -> Just $ condValue c + _ -> Nothing + where + eval c = simplifyCondition (condCondition c) (Just . i) +-} + hunk ./Distribution/Configuration.hs 199 -test_simplifyCondition = simplifyCondition tstCond "ia32" "darwin" +test_simplify = simplifyWithSysParams tstCond i386 darwin hunk ./Distribution/Configuration.hs 201 - tstCond = COr (CAnd (Arch "ppc") (OS "darwin")) - (CAnd (Flag "debug") (OS "darwin")) + tstCond = COr (CAnd (Var (Arch ppc)) (Var (OS darwin))) + (CAnd (Var (Flag "debug")) (Var (OS darwin))) + [ppc,i386] = map (mkArchName) ["ppc","i386"] + [darwin,windows] = map (mkOSName) ["darwin","windows"] + + } [fixed typo Thomas Schilling **20070613172230] { hunk ./Distribution/ParseUtils.hs 109 -locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambigous parse in field '"++f++"'") +locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambiguous parse in field '"++f++"'") } [added docs Thomas Schilling **20070613172309] { hunk ./Distribution/ParseUtils.hs 119 +-- | Field descriptor. The parameter @a@ parameterizes over where the field's +-- value is stored in. hunk ./Distribution/ParseUtils.hs 126 + -- ^ @fieldSet n str x@ Parses the field value from the given input + -- string @str@ and stores the result in @x@ if the parse was + -- successful. Otherwise, reports an error on line number @n@. hunk ./Distribution/ParseUtils.hs 135 +-- Lift a field descriptor storing into an 'a' to a field descriptor storing +-- into a 'b'. } [add flag as a section Thomas Schilling **20070613172416] { hunk ./Distribution/ParseUtils.hs 193 -sectionNames = ["library", "executable:"] +sectionNames = ["library", "executable", "flag"] } [add line numbers to all field times Thomas Schilling **20070613173548] { hunk ./Distribution/ParseUtils.hs 50 - Field(..), + Field(..), fName, lineNo, hunk ./Distribution/ParseUtils.hs 185 -data Field = F LineNo String String - | Section String String [Field] - | IfBlock String [Field] [Field] - deriving (Show - ,Eq) -- for testing +data Field = F LineNo String String + | Section LineNo String String [Field] + | IfBlock LineNo String [Field] [Field] + deriving (Show + ,Eq) -- for testing + +lineNo :: Field -> LineNo +lineNo (F n _ _) = n +lineNo (Section n _ _ _) = n +lineNo (IfBlock n _ _ _) = n + +fName (F _ n _) = n hunk ./Distribution/ParseUtils.hs 270 - return (Just $ IfBlock cond ifBlock elseBlock, lines'') + return (Just $ IfBlock n cond ifBlock elseBlock, lines'') hunk ./Distribution/ParseUtils.hs 320 - return (Just $ Section sectName sectLabel b, lines') + return (Just $ Section n sectName (trimTrailingSpaces sectLabel) b, lines') hunk ./Distribution/ParseUtils.hs 487 - , IfBlock "os(windows) " + , IfBlock 5 "os(windows) " hunk ./Distribution/ParseUtils.hs 492 - , IfBlock "os(linux) " + , IfBlock 10 "os(linux) " hunk ./Distribution/ParseUtils.hs 495 - , IfBlock "os(vista) " - [ Section "executable" "RootKit " + , IfBlock 14 "os(vista) " + [ Section 15 "executable" "RootKit " hunk ./Distribution/ParseUtils.hs 499 - [ Section "executable" "VistaRemoteAccess " + [ Section 19 "executable" "VistaRemoteAccess " hunk ./Distribution/ParseUtils.hs 502 - , Section "executable" "Foo-bar " + , Section 23 "executable" "Foo-bar " } [Prototypical configurations Thomas Schilling **20070613184332] { hunk ./Distribution/PackageDescription.hs 101 +import Control.Monad.State hunk ./Distribution/PackageDescription.hs 103 -import Data.Maybe(fromMaybe, isNothing, catMaybes) +import Data.Maybe(fromMaybe, isNothing, catMaybes, listToMaybe) hunk ./Distribution/PackageDescription.hs 107 +import qualified System.Info hunk ./Distribution/PackageDescription.hs 118 +import Distribution.Configuration hunk ./Distribution/PackageDescription.hs 125 +import Data.List (sortBy, partition) + hunk ./Distribution/PackageDescription.hs 129 -import Data.List (sortBy) hunk ./Distribution/PackageDescription.hs 594 +-- detectCabalFormat all_fields0 hunk ./Distribution/PackageDescription.hs 604 +{- +mapSimpleFields :: (Field -> ParseResult Field) -> [Field] + -> ParseResult [Field] +mapSimpleFields f fs = mapM walk fs + where + walk fld@(F _ _ _) = f fld + walk (IfBlock l c fs1 fs2) = do + fs1' <- mapM walk fs1 + fs2' <- mapM walk fs2 + return (IfBlock l c fs1' fs2') + walk (Section ln n l fs1) = do + fs1' <- mapM walk fs1 + return (Section ln n l fs1') +-- prop_isMapM fs = mapSimpleFields return fs == return fs +-} +{- +detectCabalFormat :: [Field] -> ParseResult [Field] +detectCabalFormat fs = + if isSimpleFormat then return fs + else + + where + + isSimpleFormat = and (map isSimpleField fs) + isSimpleField (F _ _ _) = True + isSimpleField _ = False +-} + +headerFieldNames :: [String] +headerFieldNames = filter (\n -> not (n `elem` ["build-depends"])) + . map fieldName $ pkgDescrFieldDescrs + +libFieldNames = map fieldName libFieldDescrs ++ buildInfoNames ++ ["build-depends"] + +exeFieldNames = map fieldName executableFieldDescrs ++ buildInfoNames + +buildInfoNames = map fieldName binfoFieldDescrs + + + + +-- Just to make the structure explicit +data CabalFile = MkCabalFile + { headerFields :: [Field] + , flags :: [Flag] + , exeFields :: [(String,CondTree ConfVar Dependency Field)] + , libFields :: CondTree ConfVar Dependency Field + } deriving Show + +data Config = MkConfig [PackageIdentifier] OSName ArchName + +preParseDescription :: CabalFile -> ParseResult PreparedPackageDescription +preParseDescription (MkCabalFile hdrs flags exes lib) = undefined + + +findDescription :: Config -> CabalFile -> ParseResult PackageDescription +findDescription (MkConfig pkgs os arch) + (MkCabalFile hdrs flags exes lib) = do + -- first we try to find a suitable (and admissable) assignment for the + -- flags + let mfass = tryAssignments flags [] + when (isNothing mfass) $ + error "Could not satisfy required dependencies." + let Just fass = mfass + pkg <- parseFields pkgDescrFieldDescrs emptyPackageDescription hdrs + let (deps, libfields) = evalCond fass lib + lib <- parseFields libFieldDescrs emptyLibrary libfields + let exefs = map (\(n,c) -> (n, snd $ evalCond fass c)) exes + exes <- mapM parseExeStanzas exefs + return $ pkg { buildDepends = deps + , library = Just lib + , executables = exes + } + where + parseExeStanzas (_name, flds) = + parseFields executableFieldDescrs emptyExecutable flds + + -- find first possible assignment and return this assignment, the + -- dependencies and the other fields + tryAssignments :: [Flag] -> [(String, Bool)] + -> Maybe ([(String, Bool)]) + tryAssignments (MkFlag name _ dflt : flags) env = + case dflt of + FlTrue -> tryAssignments flags ((name,True):env) + FlFalse -> tryAssignments flags ((name,False):env) + FlUnknown -> maybe (tryAssignments flags ((name,False):env)) Just $ + tryAssignments flags ((name,True):env) + tryAssignments [] env = + case mapM (satisfyDependency pkgs) deps of + Just pkgs' -> Just env + Nothing -> Nothing + where + (deps, fs) = evalCond env lib + + evalCond env (CondLeaf ds fs) = (ds, fs) + evalCond env (Cond cnd y n) = + case simplifyCondition cnd (f env) of + (Lit b, _) -> let (ds', fs', cnd') = if b then y else n + (ds, fs) = evalCond env cnd' + in (ds' ++ ds, fs' ++ fs) + x -> error $ "This should not have happened, consider it a bug." + ++ show cnd ++ " / " ++ show x ++ " / " ++ show env + + f _ (OS o) = Just $ o == os + f _ (Arch a) = Just $ a == arch + f env (Flag n) = lookup n env + +type PM a = StateT [Field] ParseResult a + +stanzas' :: [Field] -> ParseResult CabalFile +stanzas' fields = flip evalStateT fields $ do + hfs <- getHeader [] + (flags, Just lib, exes) <- getBody + warnIfRest + return (MkCabalFile hfs flags exes lib) + where + peekField :: PM (Maybe Field) + peekField = get >>= return . listToMaybe + skipField = modify tail + warnIfRest :: PM () + warnIfRest = do + s <- get + case s of + [] -> return () + fs -> lift $ warning "Ignoring trailing declarations." -- add line no. + + getHeader fs = peekField >>= \mf -> case mf of + Just f@(F l n v) | n `elem` headerFieldNames -> + skipField >> getHeader (f:fs) + _ -> return (reverse fs) -- check for required fields + + getBody = do + mf <- peekField + case mf of + Just f@(F l n v) + | n `elem` libFieldNames -> compatParse f -- old-style format + | n == "executable" -> compatParse f + | otherwise -> error "???" -- XXX + Just f@(Section l sn sl fs) + | sn == "flag" -> do + flags <- getFlags [] + (lib, exes) <- getLibOrExe (Lit True) + return (flags, lib, exes) + | sn `elem` ["library", "executable"] -> do + (lib,exes) <- getLibOrExe (Lit True) + return ([], lib, exes) + | otherwise -> + lift $ syntaxError l $ "Unknown section type: " ++ sn + + --Just f@(IfBlock l s yes no) -> getLibOrExe f + Nothing -> errEOF + + getFlags acc = peekField >>= \mf -> case mf of + Just (Section l sn sl fs) + | sn == "flag" -> do + skipField >> getFlags (MkFlag (map toLower sl) "" FlUnknown : acc) + _ -> return (reverse acc) + + getLibOrExe cond = peekField >>= \mf -> case mf of + Just (Section l sn sl fs) + | sn == "executable" -> do + flds <- collectFields exeFieldNames fs + skipField + (lib, exes) <- getLibOrExe cond + return (lib, exes ++ [(sl, flds)]) + | sn == "library" -> do + flds <- collectFields libFieldNames fs + skipField + (lib, exes) <- getLibOrExe cond + return (maybe (Just flds) + (const (error "Multiple libraries specified")) + lib + , exes) + Nothing -> return (Nothing, []) + _ -> lift $ syntaxError (-42) "Unexpected directive" + -- XXX : fix line number + + -- extracts all fields in a block, possibly add dependencies to the + -- guard condition + collectFields :: [String] -> [Field] + -> PM (CondTree ConfVar Dependency Field) + collectFields names allflds = do + (ifs, ds, fs) <- collect names allflds + processIfs names ifs (CondLeaf ds fs) + + collect names allflds = do + checkFieldsOk simplflds names + deps <- liftM concat . mapM parseDep $ deps0 + return (ifflds, deps, flds) + where + (deps0,flds) = partition isConstraint simplflds + simplflds = [ F l n v | F l n v <- allflds ] + ifflds = [ f | f@(IfBlock _ _ _ _) <- allflds ] + isConstraint (F _ n v) = n == "build-depends" + isConstraint _ = False + + checkFieldsOk fields names = do + let (ok, other) = partition ((`elem` names) . fName) fields + when (not (null other)) $ + lift $ syntaxError (lineNo (head other)) + ("Field not allowed in this section: " ++ fName (head other)) + + -- "wraps" the current cond with a node with two edges, representing + -- the then- and else-branch, respectively. + processIfs _ [] c = return c + processIfs names (IfBlock l cs b1 b2 : other) c = do + cnd <- lift $ runP l "if" parseCondition cs + (ifs1, d1, f1) <- collect names b1 + if1 <- processIfs names ifs1 c + (ifs2, d2, f2) <- collect names b2 + if2 <- processIfs names ifs2 c + processIfs names other (Cond cnd (d1, f1, if1) (d2, f2, if2)) + + parseDep (F l f v) = lift $ runP l f (parseCommaList parseDependency) v + + compatParse _ = error "to be implemented" + + errEOF = lift $ syntaxError (-1) "Unexpected end of file" hunk ./Distribution/PackageDescription.hs 831 - where (this, rest) = break isStanzaHeader fields + where + (this, rest) = break isStanzaHeader fields hunk ./Distribution/PackageDescription.hs 1215 +------------------------------------------------------------------------------ + +test_stanzas' = readFields testFile >>= stanzas' +-- ParseOk _ x -> putStrLn $ show x +-- _ -> return () + +testFile = unlines $ + [ "Cabal-version: >= 1.7" + , "" + , "Description: This is a test file " + , " with a description longer than two lines. " + , "" + , "flag Debug {" + , " Description: Enable debug information" + , " Default: False" + , "}" + , "" + , "library {" + , " build-depends: blub" + , " if os(win32) && flag(debug) {" + , " build-depends: hunit" + , " ghc-options: -DDEBUG" + , " if !flag(debug) {" + , " build-depends: impossible" + , " }" + , " }" + , "}" + , "" + , "executable foo-bar {" + , " Main-is: Foo.hs" + , "}" + ] hunk ./Distribution/PackageDescription.hs 1248 +test_findDescription = readFields testFile >>= stanzas' >>= return . findDescription tstCfg + where tstCfg = MkConfig pkgs (MkOSName "win32") (MkArchName "amd64") + pkgs = [ PackageIdentifier "blub" (Version [1,0] []) ] + -- , PackageIdentifier "hunit" (Version [1,1] []) ] } [Pretty printing of conditions and CondTrees. Non-dependency Thomas Schilling **20070614125031 information of CondTrees is now a modifier. Move CondTree resolution functionality. ] { hunk ./Distribution/Configuration.hs 45 -import Distribution.Compat.ReadP as ReadP +import Distribution.Compat.ReadP as ReadP hiding ( char ) +import qualified Distribution.Compat.ReadP as ReadP ( char ) hunk ./Distribution/Configuration.hs 49 +import Text.PrettyPrint.HughesPJ + hunk ./Distribution/Configuration.hs 52 +import Control.Monad ( msum ) hunk ./Distribution/Configuration.hs 61 - } deriving Show + } + +instance Show Flag where show (MkFlag n _ _) = n hunk ./Distribution/Configuration.hs 69 - deriving Show + +instance Show ConfVar where + show (OS n) = "os(" ++ show n ++ ")" + show (Arch n) = "arch(" ++ show n ++ ")" + show (Flag f) = "flag(" ++ f ++ ")" hunk ./Distribution/Configuration.hs 80 - deriving Show + +instance Show c => Show (Condition c) where + show c = render $ ppCond c + +ppCond (Var x) = text (show x) +ppCond (Lit b) = text (show b) +ppCond (CNot c) = char '!' <> parens (ppCond c) +ppCond (COr c1 c2) = parens $ sep [ppCond c1, text "||" <+> ppCond c2] +ppCond (CAnd c1 c2) = parens $ sep [ppCond c1, text "&&" <+> ppCond c2] hunk ./Distribution/Configuration.hs 93 - deriving (Show, Eq) + deriving (Eq) + +instance Show OSName where show (MkOSName n) = n hunk ./Distribution/Configuration.hs 102 - deriving (Show, Eq) + deriving (Eq) + +instance Show ArchName where show (MkArchName n) = n + hunk ./Distribution/Configuration.hs 178 - parens = between (char '(' >> sp) (sp >> char ')' >> sp) - notCond = char '!' >> sp >> cond >>= return . CNot + parens = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp) + notCond = ReadP.char '!' >> sp >> cond >>= return . CNot hunk ./Distribution/Configuration.hs 194 -data CondTree v c a = CondLeaf [c] [a] +data CondTree v c a = CondLeaf [c] (a -> a) hunk ./Distribution/Configuration.hs 196 - ([c], [a], CondTree v c a) - ([c], [a], CondTree v c a) - deriving Show + ([c], a -> a, CondTree v c a) + ([c], a -> a, CondTree v c a) + --deriving Show +instance (Show c, Show v) => Show (CondTree v c a) where + show c = render $ pp c [] + where + pp (CondLeaf ds _) ds' = deps (ds' ++ ds) + pp (Cond c (d1s, _, ct1) (d2s, _, ct2)) ds' = + ((text "if" <+> ppCond c <> colon) $$ + nest 2 (pp ct1 (d1s ++ ds'))) + $+$ + (text "else:" $$ nest 2 (pp ct2 (d2s ++ ds'))) + deps ds = text "build-depends:" <+> + (fsep $ punctuate (char ',') $ map (text . show) ds) + + +evalCond :: (v -> Maybe Bool) -> CondTree v d a -> ([d], a -> a) +evalCond f (CondLeaf ds fs) = (ds, fs) +evalCond f (Cond cnd y n) = + case simplifyCondition cnd f of + (Lit b, _) -> let (ds', fs', cnd') = if b then y else n + (ds, fs) = evalCond f cnd' + in (ds' ++ ds, fs' . fs) + x -> error $ "Environment not defined for all free vars" + +satisfyFlags :: [(String,[Bool])] -> OSName -> ArchName + -> CondTree ConfVar d a -> ([d] -> Bool) -> a + -> Maybe (a, [d], [(String, Bool)]) +satisfyFlags dom os arch tree depsOk init = try dom [] + where + try [] env = let (deps, mod) = evalCond (f env) tree in + if depsOk deps + then Just (mod init, deps, env) + else Nothing + try ((n, vals):rest) env = + msum $ map (\v -> try rest ((n, v):env)) vals + + f _ (OS o) = Just $ o == os + f _ (Arch a) = Just $ a == arch + f env (Flag n) = lookup n env + + +test_satisfyFlags = satisfyFlags dom os arch tstTree check [] + where + dom = [("a",[True,False]),("b",[False,True]),("c",[True,False])] + os = MkOSName "house" + arch = MkArchName "i386" + + check xs = all (`elem` avail) xs + avail = [1,5,4,0,42] hunk ./Distribution/Configuration.hs 247 +tstTree = Cond (CNot (Var (Flag "a"))) ([1], (1:), t1) ([2], (2:), t2) + where + t1 = Cond (CAnd (Var (Flag "b")) (Var (Flag "c"))) + ([3], (3:), t2) ([4], (4:), t2) + t2 = CondLeaf [0,42] (0:) } [Compatibility parsing and working configurations. Thomas Schilling **20070618195329] { hunk ./Distribution/Configuration.hs 54 -data FlagValue = FlUnknown | FlTrue | FlFalse - deriving (Eq, Show) - hunk ./Distribution/Configuration.hs 57 - , flagDefault :: FlagValue + , flagDefault :: Bool hunk ./Distribution/Configuration.hs 197 - show c = render $ pp c [] - where - pp (CondLeaf ds _) ds' = deps (ds' ++ ds) - pp (Cond c (d1s, _, ct1) (d2s, _, ct2)) ds' = + show c = render $ ppCondTree c (text . show) [] + +ppCondTree (CondLeaf ds _) ppD ds' = + text "build-depends:" <+> + (fsep $ punctuate (char ',') $ map ppD (ds' ++ ds)) +ppCondTree (Cond c (d1s, _, ct1) (d2s, _, ct2)) ppD ds' = hunk ./Distribution/Configuration.hs 204 - nest 2 (pp ct1 (d1s ++ ds'))) + nest 2 (ppCondTree ct1 ppD (d1s ++ ds'))) hunk ./Distribution/Configuration.hs 206 - (text "else:" $$ nest 2 (pp ct2 (d2s ++ ds'))) - deps ds = text "build-depends:" <+> - (fsep $ punctuate (char ',') $ map (text . show) ds) + (text "else:" $$ nest 2 (ppCondTree ct2 ppD (d2s ++ ds'))) hunk ./Distribution/PackageDescription.hs 103 -import Data.Maybe(fromMaybe, isNothing, catMaybes, listToMaybe) -import Data.List (nub,maximumBy) +import Data.Maybe(fromMaybe, isNothing, isJust, catMaybes, listToMaybe) +import Data.List (nub, maximumBy, unfoldr) hunk ./Distribution/PackageDescription.hs 201 +data PreparedPackageDescription = + PreparedPackageDescription { + packageDescription :: PackageDescription, + packageFlags :: [Flag], + condLibrary :: Maybe (CondTree ConfVar Dependency Library), + condExecutables :: [(String, CondTree ConfVar Dependency Executable)] + } + --deriving (Show) + +instance Show PreparedPackageDescription where + show (PreparedPackageDescription pkg flags mlib exes) = + showPackageDescription pkg ++ "\n" ++ + (render $ vcat $ map ppFlag flags) ++ "\n" ++ + render (maybe empty (\l -> text "Library:" $+$ + nest 2 (ppCondTree l showDependency [])) mlib) + ++ "\n" ++ + (render $ vcat $ + map (\(n,ct) -> (text ("Executable: " ++ n) $+$ + nest 2 (ppCondTree ct showDependency []))) exes) + where + ppFlag (MkFlag name desc dflt) = + (text ("Flag: " ++ name) <> colon) $+$ + nest 2 + ((if (null desc) then empty else + text ("Description: " ++ desc)) $+$ + text ("Default: " ++ show dflt)) + + +finalizePackageDescription :: [(String,Bool)] -> [PackageIdentifier] + -> OSName -> ArchName + -> PreparedPackageDescription + -> Maybe PackageDescription +finalizePackageDescription userflags pkgs os arch + (PreparedPackageDescription pkg flags mlib0 exes) = + do (mlib, deps, flagVals) <- resolveFlags mlib0 + let exes = finalizeExes flagVals + return $ pkg { library = mlib + , executables = exes + , buildDepends = deps + } + where + resolveFlags Nothing = return (Nothing, [], flagDefaults) + resolveFlags (Just ct) = do + (l, ds, as) <- satisfyFlags flagChoices os arch ct check nullLibrary + return (Just (libFillInDefaults l), ds, as) + flagChoices = map (\(MkFlag n _ d) -> (n, d2c n d)) flags + d2c n b = maybe [b, not b] (\x -> [x]) $ lookup n userflags + flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices + check = all (isJust . satisfyDependency pkgs) + + + + finalizeExes fvs = + map (\(n, ct) -> exeFillInDefaults $ + (snd (evalCond lu ct)) (nullExecutable { exeName = n })) + exes + where lu (OS o) = Just $ o == os + lu (Arch a) = Just $ a == arch + lu (Flag f) = lookup f fvs + + hunk ./Distribution/PackageDescription.hs 361 +nullLibrary = Library [] nullBuildInfo + hunk ./Distribution/PackageDescription.hs 392 +unionLibrary :: Library -> Library -> Library +unionLibrary l1 l2 = + l1 { exposedModules = combine exposedModules + , libBuildInfo = unionBuildInfo (libBuildInfo l1) (libBuildInfo l2) + } + where combine f = f l1 ++ f l2 + +-- This is in fact rather a hack. The original version just overrode the +-- default values, however, when adding conditions we had to switch to a +-- modifier-based approach. There, nothing is ever overwritten, but only +-- joined together. +-- +-- This is the cleanest way i could think of, that doesn't require +-- changing all field parsing functions to return modifiers instead. +libFillInDefaults lib@(Library { libBuildInfo = bi }) = + lib { libBuildInfo = biFillInDefaults bi } + hunk ./Distribution/PackageDescription.hs 426 +nullExecutable = emptyExecutable { buildInfo = nullBuildInfo } + +-- note comment at libFillInDefaults +exeFillInDefaults exe@(Executable { buildInfo = bi }) = + exe { buildInfo = biFillInDefaults bi } + + hunk ./Distribution/PackageDescription.hs 458 +unionExecutable :: Executable -> Executable -> Executable +unionExecutable e1 e2 = + e1 { exeName = combine exeName + , modulePath = combine modulePath + , buildInfo = unionBuildInfo (buildInfo e1) (buildInfo e2) + } + where combine f = case (f e1, f e2) of + ("","") -> "" + ("", x) -> x + (x, "") -> x + (x, y) -> error $ "Ambiguous values for executable field: '" + ++ x ++ "' and '" ++ y ++ "'" + hunk ./Distribution/PackageDescription.hs 494 -emptyBuildInfo :: BuildInfo -emptyBuildInfo = BuildInfo { +nullBuildInfo :: BuildInfo +nullBuildInfo = BuildInfo { hunk ./Distribution/PackageDescription.hs 501 - hsSourceDirs = [currentDir], + hsSourceDirs = [], hunk ./Distribution/PackageDescription.hs 510 - ghcProfOptions = [] + ghcProfOptions = [] merger 0.0 ( hunk ./Distribution/PackageDescription.hs 513 +-- | Modify all the 'BuildInfo's in a package description. +mapBuildInfo :: (BuildInfo -> BuildInfo) -> + PackageDescription -> PackageDescription +mapBuildInfo f pkg = pkg { + library = liftM mapLibBuildInfo (library pkg), + executables = map mapExeBuildInfo (executables pkg) } + where + mapLibBuildInfo lib = lib { libBuildInfo = f (libBuildInfo lib) } + mapExeBuildInfo exe = exe { buildInfo = f (buildInfo exe) } + hunk ./Distribution/PackageDescription.hs 513 +emptyBuildInfo :: BuildInfo +emptyBuildInfo = nullBuildInfo { hsSourceDirs = [currentDir] } + +-- see comment at libFillInDefaults +biFillInDefaults bi = + if null (hsSourceDirs bi) + then bi { hsSourceDirs = [currentDir] } + else bi + ) hunk ./Distribution/PackageDescription.hs 572 +------------------------------------------------------------------------------ + +flagFieldDescrs :: [FieldDescr Flag] +flagFieldDescrs = + [ simpleField "description" + showFreeText (munch (const True)) + flagDescription (\val fl -> fl{ flagDescription = val }) + , simpleField "default" + (text . show) parseReadS + flagDefault (\val fl -> fl{ flagDefault = val }) + ] + hunk ./Distribution/PackageDescription.hs 706 -{- + hunk ./Distribution/PackageDescription.hs 720 --} + hunk ./Distribution/PackageDescription.hs 734 +depFieldNames = ["build-depends"] + hunk ./Distribution/PackageDescription.hs 737 -headerFieldNames = filter (\n -> not (n `elem` ["build-depends"])) +headerFieldNames = filter (\n -> not (n `elem` depFieldNames)) hunk ./Distribution/PackageDescription.hs 740 -libFieldNames = map fieldName libFieldDescrs ++ buildInfoNames ++ ["build-depends"] +libFieldNames = map fieldName libFieldDescrs ++ buildInfoNames ++ depFieldNames hunk ./Distribution/PackageDescription.hs 755 - } deriving Show + } -- deriving Show hunk ./Distribution/PackageDescription.hs 758 - -preParseDescription :: CabalFile -> ParseResult PreparedPackageDescription -preParseDescription (MkCabalFile hdrs flags exes lib) = undefined hunk ./Distribution/PackageDescription.hs 759 - +{- hunk ./Distribution/PackageDescription.hs 798 - - evalCond env (CondLeaf ds fs) = (ds, fs) - evalCond env (Cond cnd y n) = - case simplifyCondition cnd (f env) of - (Lit b, _) -> let (ds', fs', cnd') = if b then y else n - (ds, fs) = evalCond env cnd' - in (ds' ++ ds, fs' ++ fs) - x -> error $ "This should not have happened, consider it a bug." - ++ show cnd ++ " / " ++ show x ++ " / " ++ show env - - f _ (OS o) = Just $ o == os - f _ (Arch a) = Just $ a == arch - f env (Flag n) = lookup n env +-} hunk ./Distribution/PackageDescription.hs 802 -stanzas' :: [Field] -> ParseResult CabalFile -stanzas' fields = flip evalStateT fields $ do - hfs <- getHeader [] - (flags, Just lib, exes) <- getBody - warnIfRest - return (MkCabalFile hfs flags exes lib) +parseDescription' :: [Field] -> ParseResult PreparedPackageDescription +parseDescription' fields0 = do + fields <- mapSimpleFields deprecField fields1 + flip evalStateT fields $ do + hfs <- getHeader [] + pkg <- lift $ parseFields pkgDescrFieldDescrs emptyPackageDescription hfs + (flags, mlib, exes) <- getBody + warnIfRest + return (PreparedPackageDescription pkg flags mlib exes) + hunk ./Distribution/PackageDescription.hs 813 + fields1 = squeezeIntoShape fields0 + + -- "sectionize" an old-style Cabal file + squeezeIntoShape fs + | all isSimpleField fs = + let (hdr0, exes0) = break ((=="executable") . fName) fs + (hdr, libfs) = partition (not . (`elem` libFieldNames) . fName) hdr0 + exes = unfoldr toExe exes0 + toExe [] = Nothing + toExe (F l e n : r) + | e == "executable" = + let (efs, r') = break ((=="executable") . fName) r + in Just (Section l "executable" n efs, r') + | otherwise = error "OMG! The world is ending! Call Buffy!" + in hdr + ++ + if null libfs then [] + else [Section (lineNo (head libfs)) "library" "" libfs] + ++ + exes + | otherwise = fs + + isSimpleField (F _ _ _) = True + isSimpleField _ = False + hunk ./Distribution/PackageDescription.hs 849 - Just f@(F l n v) | n `elem` headerFieldNames -> - skipField >> getHeader (f:fs) - _ -> return (reverse fs) -- check for required fields + Just f@(F l n v) -> skipField >> getHeader (f:fs) + _ -> return (reverse fs) -- XXX: check for required fields hunk ./Distribution/PackageDescription.hs 858 - | otherwise -> error "???" -- XXX + | otherwise -> error $ "???" ++ show f -- XXX hunk ./Distribution/PackageDescription.hs 876 - skipField >> getFlags (MkFlag (map toLower sl) "" FlUnknown : acc) + fl <- lift $ parseFields + flagFieldDescrs + (MkFlag (map toLower sl) "" True) + fs + skipField >> getFlags (fl : acc) hunk ./Distribution/PackageDescription.hs 886 - flds <- collectFields exeFieldNames fs + flds <- collectFields parseExeFields fs hunk ./Distribution/PackageDescription.hs 891 - flds <- collectFields libFieldNames fs + flds <- collectFields parseLibFields fs hunk ./Distribution/PackageDescription.hs 904 - collectFields :: [String] -> [Field] - -> PM (CondTree ConfVar Dependency Field) - collectFields names allflds = do - (ifs, ds, fs) <- collect names allflds - processIfs names ifs (CondLeaf ds fs) + collectFields :: ([Field] -> PM (a -> a)) -> [Field] + -> PM (CondTree ConfVar Dependency a) + collectFields parser allflds = do + (ifs, ds, fs) <- collect allflds + mod <- parser fs + processIfs parser ifs (CondLeaf ds mod) hunk ./Distribution/PackageDescription.hs 911 - collect names allflds = do - checkFieldsOk simplflds names + collect allflds = do hunk ./Distribution/PackageDescription.hs 921 - checkFieldsOk fields names = do - let (ok, other) = partition ((`elem` names) . fName) fields - when (not (null other)) $ - lift $ syntaxError (lineNo (head other)) - ("Field not allowed in this section: " ++ fName (head other)) - - -- "wraps" the current cond with a node with two edges, representing - -- the then- and else-branch, respectively. + -- "wraps" the current cond with a node with two edges, representing + -- the then- and else-branch, respectively. hunk ./Distribution/PackageDescription.hs 924 - processIfs names (IfBlock l cs b1 b2 : other) c = do + processIfs parser (IfBlock l cs b1 b2 : other) c = do hunk ./Distribution/PackageDescription.hs 926 - (ifs1, d1, f1) <- collect names b1 - if1 <- processIfs names ifs1 c - (ifs2, d2, f2) <- collect names b2 - if2 <- processIfs names ifs2 c - processIfs names other (Cond cnd (d1, f1, if1) (d2, f2, if2)) + (ifs1, d1, f1) <- collect b1 + mod1 <- parser f1 + if1 <- processIfs parser ifs1 c + (ifs2, d2, f2) <- collect b2 + mod2 <- parser f2 + if2 <- processIfs parser ifs2 c + processIfs parser other (Cond cnd (d1, mod1, if1) (d2, mod2, if2)) hunk ./Distribution/PackageDescription.hs 934 +-- checkFieldsOk fields names = do +-- let (ok, other) = partition ((`elem` names) . fName) fields +-- when (not (null other)) $ +-- lift $ syntaxError (lineNo (head other)) +-- ("Field not allowed in this section: " ++ fName (head other)) + + parseLibFields = mkMod libFieldDescrs nullLibrary unionLibrary + + parseExeFields = mkMod executableFieldDescrs nullExecutable unionExecutable + + -- Make a modifier on 'a' out of FieldDescr a + mkMod descrs init union flds = do + a <- lift $ parseFields descrs init flds + return (union a) + + -- XXX: extract to some more appropriate position hunk ./Distribution/PackageDescription.hs 1355 - [ "Cabal-version: >= 1.7" + [ "Name: dwim" + , "Cabal-version: >= 1.7" hunk ./Distribution/PackageDescription.hs 1368 + , " exposed-modules: DWIM.Main, DWIM" hunk ./Distribution/PackageDescription.hs 1372 + , " exposed-modules: DWIM.Internal" hunk ./Distribution/PackageDescription.hs 1384 -test_findDescription = readFields testFile >>= stanzas' >>= return . findDescription tstCfg - where tstCfg = MkConfig pkgs (MkOSName "win32") (MkArchName "amd64") - pkgs = [ PackageIdentifier "blub" (Version [1,0] []) ] - -- , PackageIdentifier "hunit" (Version [1,1] []) ] + +test_compatParsing = + let ParseOk ws (p, pold) = do + fs <- readFields testPkgDesc + ppd <- parseDescription' fs + let Just pd = finalizePackageDescription [] pkgs os arch ppd + pdold <- parseDescription testPkgDesc + return (pd, pdold) + in do putStrLn $ unlines $ map show ws + putStrLn "===========" + putStrLn $ showPackageDescription p + putStrLn "===========" + putStrLn $ showPackageDescription testPkgDescAnswer + putStrLn "===========" + putStrLn $ showPackageDescription pold + putStrLn $ show (p == pold) + where + pkgs = [ PackageIdentifier "haskell-src" (Version [1,0] []) + , PackageIdentifier "HUnit" (Version [1,1] ["rain"]) + ] + os = (MkOSName "win32") + arch = (MkArchName "amd64") + +test_finalizePD = + let ParseOk _ ppd = readFields testFile >>= parseDescription' + Just pd = finalizePackageDescription [("debug",True)] pkgs os arch ppd + in putStrLn $ showPackageDescription pd + where + pkgs = [ PackageIdentifier "blub" (Version [1,0] []) + , PackageIdentifier "hunit" (Version [1,1] []) + ] + os = (MkOSName "win32") + arch = (MkArchName "amd64") + hunk ./Distribution/ParseUtils.hs 330 - rest = (if val' == "" then tail else id) $ + rest = (if val' == "" then safeTail else id) $ hunk ./Distribution/ParseUtils.hs 334 + safeTail (_:xs) = xs + safeTail [] = [] } [Add commandline support for specifying defaults for flags. Thomas Schilling **20070618195449] { merger 0.0 ( hunk ./Distribution/Setup.hs 148 - configSplitObjs :: Bool, -- ^Enable -split-objs with GHC - configHaddockUsePackages :: Bool -- ^ auto-gen haddock --use-package + configSplitObjs :: Bool -- ^Enable -split-objs with GHC hunk ./Distribution/Setup.hs 149 - configHaddockUsePackages :: Bool -- ^ auto-gen haddock --use-package + configHaddockUsePackages :: Bool, -- ^ auto-gen haddock --use-package + configConfigurationsFlags :: [(String, Bool)] ) merger 0.0 ( hunk ./Distribution/Setup.hs 183 - configSplitObjs = False, -- takes longer, so turn off by default - configHaddockUsePackages = True + configSplitObjs = False -- takes longer, so turn off by default hunk ./Distribution/Setup.hs 184 - configHaddockUsePackages = True + configHaddockUsePackages = True, + configConfigurationsFlags = [] ) merger 0.0 ( hunk ./Distribution/Setup.hs 301 - | WithHaddockUsePackages | WithoutHaddockUsePackages hunk ./Distribution/Setup.hs 302 + | ConfigurationsFlags [(String, Bool)] ) merger 0.0 ( hunk ./Distribution/Setup.hs 537 - "(default) dependencies must be satisfied from the global package database", - Option "" ["enable-haddock-use-packages"] (NoArg WithHaddockUsePackages) - "Automatically pass --use-library flags to haddock.", - Option "" ["disable-haddock-use-packages"] (NoArg WithoutHaddockUsePackages) - "Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs." + "(default) dependencies must be satisfied from the global package database" hunk ./Distribution/Setup.hs 541 - "Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs." - ] + "Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs.", + Option "f" ["flags"] (reqFlagsArgs ConfigurationsFlags) + "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." +] ) hunk ./Distribution/Setup.hs 574 +reqFlagsArgs :: ([(String,Bool)] -> a) -> ArgDescr a +reqFlagsArgs constr = ReqArg (constr . flagList) "FLAGS" + +flagList :: String -> [(String, Bool)] +flagList = map tagWithValue . words + where tagWithValue ('-':name) = (name, False) + tagWithValue name = (name, True) + merger 0.0 ( hunk ./Distribution/Setup.hs 625 + updateCfg t (ConfigureOption s) = t { configConfigureArgs = configConfigureArgs t ++ [s] } merger 0.0 ( hunk ./Distribution/Setup.hs 625 - updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True } - updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False } hunk ./Distribution/Setup.hs 625 - updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True } - updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False } + updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True } + updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False } + updateCfg t (ConfigurationsFlags fs) = t { configConfigurationsFlags = + fs ++ configConfigurationsFlags t } ) ) } [Add helpers for reading and writing the file to hold a configured cabal-file. Thomas Schilling **20070618195710] { hunk ./Distribution/Simple/Configure.hs 104 --- internal function -tryGetPersistBuildConfig :: IO (Either String LocalBuildInfo) -tryGetPersistBuildConfig = do - e <- doesFileExist localBuildInfoFile - let dieMsg = "error reading " ++ localBuildInfoFile ++ "; run \"setup configure\" command?\n" +tryGetConfigStateFile :: (Read a) => FilePath -> IO (Either String a) +tryGetConfigStateFile filename = do + e <- doesFileExist filename + let dieMsg = "error reading " ++ filename ++ + "; run \"setup configure\" command?\n" hunk ./Distribution/Simple/Configure.hs 110 - str <- readFile localBuildInfoFile + str <- readFile filename hunk ./Distribution/Simple/Configure.hs 115 +-- internal function +tryGetPersistBuildConfig :: IO (Either String LocalBuildInfo) +tryGetPersistBuildConfig = tryGetConfigStateFile localBuildInfoFile + hunk ./Distribution/Simple/Configure.hs 142 + +configuredPkgDescr :: FilePath +configuredPkgDescr = "./.configured.cabal" + + +writeConfiguredPkgDescr :: PackageDescription -> IO () +writeConfiguredPkgDescr pd = do + writeFile configuredPkgDescr (show pd) + +tryGetConfiguredPkgDescr :: IO (Either String PackageDescription) +tryGetConfiguredPkgDescr = tryGetConfigStateFile configuredPkgDescr + +getConfiguredPkgDescr :: IO PackageDescription +getConfiguredPkgDescr = tryGetConfiguredPkgDescr >>= either die return + + } [Fixed warnings, added documentation, and changed os and arch names to Thomas Schilling **20070623200453 simple strings. ] { hunk ./Distribution/Configuration.hs 1 +{-# OPTIONS -cpp #-} hunk ./Distribution/Configuration.hs 5 --- Copyright : Thomas Schilling 2007 +-- Copyright : Thomas Schilling, 2007 hunk ./Distribution/Configuration.hs 43 -module Distribution.Configuration where +module Distribution.Configuration ( + Flag(..), + ConfVar(..), + Condition(..), parseCondition, simplifyCondition, + CondTree(..), ppCondTree, evalCond, + satisfyFlags, DepTestRslt(..) + ) where hunk ./Distribution/Configuration.hs 51 -import Distribution.ParseUtils hunk ./Distribution/Configuration.hs 53 -import Distribution.Version hunk ./Distribution/Configuration.hs 57 -import Control.Monad ( msum ) hunk ./Distribution/Configuration.hs 58 +#ifdef DEBUG +import Distribution.ParseUtils +#endif + +------------------------------------------------------------------------------ + +-- | A flag can represent a feature to be included, or a way of linking +-- a target against its dependencies, or in fact whatever you can think of. hunk ./Distribution/Configuration.hs 74 -data ConfVar = OS OSName - | Arch ArchName +-- | A @ConfVar@ represents the variable type used. +data ConfVar = OS String + | Arch String hunk ./Distribution/Configuration.hs 78 - -- | Depend [Dependency] hunk ./Distribution/Configuration.hs 80 - show (OS n) = "os(" ++ show n ++ ")" - show (Arch n) = "arch(" ++ show n ++ ")" + show (OS n) = "os(" ++ n ++ ")" + show (Arch n) = "arch(" ++ n ++ ")" hunk ./Distribution/Configuration.hs 84 +-- | A boolean expression parameterized over the variable type used. hunk ./Distribution/Configuration.hs 93 - + +-- | Pretty print a @Condition@. +ppCond :: Show c => Condition c -> Doc hunk ./Distribution/Configuration.hs 102 --- | The name of an operating system. Abstract, so we can implement dedicated --- operations on them if needed. -data OSName = MkOSName String - deriving (Eq) - -instance Show OSName where show (MkOSName n) = n - -mkOSName :: String -> OSName -mkOSName = MkOSName - --- | The name of an architecture. Abstract. -data ArchName = MkArchName String - deriving (Eq) - -instance Show ArchName where show (MkArchName n) = n - - -mkArchName :: String -> ArchName -mkArchName = MkArchName hunk ./Distribution/Configuration.hs 109 - walk c = case c of + walk cnd = case cnd of hunk ./Distribution/Configuration.hs 118 - (Lit True, d') -> Lit True + (Lit True, _) -> Lit True hunk ./Distribution/Configuration.hs 120 - (c', Lit True) -> Lit True + (_, Lit True) -> Lit True hunk ./Distribution/Configuration.hs 132 - Lit b -> [] + Lit _ -> [] hunk ./Distribution/Configuration.hs 137 -simplifyWithSysParams :: Condition ConfVar -> ArchName -> OSName -> +-- | Simplify a configuration condition using the os and arch names. Returns +-- the names of all the flags occurring in the condition. +simplifyWithSysParams :: Condition ConfVar -> String -> String -> hunk ./Distribution/Configuration.hs 166 +-- | Parse a configuration condition from a string. hunk ./Distribution/Configuration.hs 172 - cond = sp >> (lit +++ parens condOr +++ notCond +++ osCond + cond = sp >> (lit +++ inparens condOr +++ notCond +++ osCond hunk ./Distribution/Configuration.hs 174 - parens = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp) + inparens = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp) hunk ./Distribution/Configuration.hs 176 - osCond = string "os" >> sp >> parens osIdent >>= return . Var. OS - archCond = string "arch" >> sp >> parens archIdent >>= return . Var . Arch - flagCond = string "flag" >> sp >> parens flagIdent >>= return . Var . Flag + osCond = string "os" >> sp >> inparens osIdent >>= return . Var. OS + archCond = string "arch" >> sp >> inparens archIdent >>= return . Var . Arch + flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var . Flag hunk ./Distribution/Configuration.hs 182 - archIdent = ident >>= return . mkArchName - osIdent = ident >>= return . mkOSName + archIdent = ident >>= return + osIdent = ident >>= return hunk ./Distribution/Configuration.hs 190 +-- | A CondTree is the internal (normalized) representation of a specification +-- with (optional) conditional statements in it. To get to the final value, +-- a sequence of conditions has to be evaluated completely, which then specifies +-- which path to take, until we reach a leaf. +-- +-- Each path is annotated with a number of constraints, which must be +-- fulfilled and a modifier, describing which information to add to the final +-- value. We record constraints and data separately, to allow possible +-- optimizations later on. +-- +-- Although the a CondTree is a tree, it can be constructed in a way to +-- preserve maximum sharing. For example, in the following, the specification +-- on the left can be represented using the graph depicted on the right. +-- +-- > if C1 { C1 +-- > constraints: A,B A,B / \ +-- > if C2 { / \ +-- > constraints: D C2 \ +-- > data: 42 D / \ E \ +-- > } else { 42 / | 3 | +-- > constraints: E | | | +-- > data: 3 \ | / +-- > } \ | / +-- > } \ | / +-- > constraint: F v v v +-- > data: 1 F ; 1 +-- hunk ./Distribution/Configuration.hs 225 +-- Pretty print a cond tree. The printed tree will be normalized to have all +-- it's data in the nodes, which results in a fair amount of duplication. So, +-- ya be warned. +ppCondTree :: (Show v) => CondTree v c a -> (c -> Doc) -> [c] -> Doc hunk ./Distribution/Configuration.hs 238 - +-- | Completely evaluate a CondTree with the given variable assignment. The +-- environment must be defined for all free variables in all the conditions. hunk ./Distribution/Configuration.hs 241 -evalCond f (CondLeaf ds fs) = (ds, fs) +evalCond _ (CondLeaf ds fs) = (ds, fs) hunk ./Distribution/Configuration.hs 247 - x -> error $ "Environment not defined for all free vars" + _ -> error $ "Environment not defined for all free vars" hunk ./Distribution/Configuration.hs 249 -satisfyFlags :: [(String,[Bool])] -> OSName -> ArchName - -> CondTree ConfVar d a -> ([d] -> Bool) -> a - -> Maybe (a, [d], [(String, Bool)]) -satisfyFlags dom os arch tree depsOk init = try dom [] +data DepTestRslt d = DepOk | MissingDeps [d] -- result of dependency test +data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree + +-- | Search Condition graph for a combination that satisfies certain +-- dependencies. Returns either the missing dependencies, or a tuple +-- containing the resulting data, the associated dependencies, and the chosen +-- flag assignments. +-- +-- In case of failure, the _smallest_ number of of missing dependencies is +-- returned. +-- +-- XXX: The current algorithm is rather naive. A better approach would be to: +-- +-- * Rule out possible paths, by taking a look at the associated dependencies. +-- +-- * Infer the required values for the conditions of these paths, and +-- calculate the required domains for the variables used in these +-- conditions. Then picking a flag assignment would be linear (I guess). +-- +-- This would require some sort of SAT solving, though, thus it's not +-- implemented unless we really need it. +-- +satisfyFlags :: [(String,[Bool])] + -- ^ Domain for each flag name, will be tested in order. + -> String -- ^ OS name, as returned System.Info.os + -> String -- ^ arch name, as returned System.Info.arch + -> CondTree ConfVar d a + -> ([d] -> DepTestRslt d) -- ^ Dependency test function. + -> a -- ^ Empty result value. + -> (Either [d] -- missing dependencies + (a, [d], [(String, Bool)])) +satisfyFlags dom os arch tree depsOk ini = + case try dom [] of + Right r -> Right r + Left dbt -> Left $ findShortest dbt hunk ./Distribution/Configuration.hs 285 - try [] env = let (deps, mod) = evalCond (f env) tree in - if depsOk deps - then Just (mod init, deps, env) - else Nothing + -- @try@ recursively tries all possible flag assignments in the domain and + -- either succeeds or returns a binary tree with the missing dependencies + -- encountered in each run. Since the tree is constructed lazily, we + -- avoid some computation overhead in the successful case. + try [] env = let (deps, dmod) = evalCond (f env) tree in + case depsOk deps of + DepOk -> Right (dmod ini, deps, env) + MissingDeps ds -> Left (BTN ds) hunk ./Distribution/Configuration.hs 294 - msum $ map (\v -> try rest ((n, v):env)) vals + tryAll $ map (\v -> try rest ((n, v):env)) vals + + tryAll = foldr mp mz + + -- special kind of `mplus' for our local purposes + mp (Left xs) (Left ys) = (Left (BTB xs ys)) + mp (Left _) m@(Right _) = m + mp m@(Right _) _ = m + + -- `mzero' + mz = Left (BTN []) hunk ./Distribution/Configuration.hs 310 + findShortest (BTN x) = x + findShortest (BTB lt rt) = + let l = findShortest lt + r = findShortest rt + in case (l,r) of + ([], xs) -> xs -- [] is too short + (xs, []) -> xs + ([x], _) -> [x] -- single elem is optimum + (_, [x]) -> [x] + (xs, ys) -> if lazyLengthCmp xs ys + then xs else ys + -- lazy variant of @\xs ys -> length xs <= length ys@ + lazyLengthCmp [] _ = True + lazyLengthCmp _ [] = False + lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp xs ys + +------------------------------------------------------------------------------ +-- Testing hunk ./Distribution/Configuration.hs 329 +#ifdef DEBUG hunk ./Distribution/Configuration.hs 333 - os = MkOSName "house" - arch = MkArchName "i386" + os = "house" + arch = "i386" hunk ./Distribution/Configuration.hs 336 - check xs = all (`elem` avail) xs + check xs = if all (`elem` avail) xs + then DepOk + else (MissingDeps (filter (not . (`elem` avail)) xs)) hunk ./Distribution/Configuration.hs 345 - t2 = CondLeaf [0,42] (0:) + t2 = CondLeaf [0,7,42] (0:) hunk ./Distribution/Configuration.hs 372 - [ppc,i386] = map (mkArchName) ["ppc","i386"] - [darwin,windows] = map (mkOSName) ["darwin","windows"] + [ppc,i386] = ["ppc","i386"] + [darwin,windows] = ["darwin","windows"] hunk ./Distribution/Configuration.hs 393 + +#endif + } [Fixed warning Thomas Schilling **20070623200522] { hunk ./Distribution/InstalledPackageInfo.hs 165 +parseBasicStanza _ _ _ = + error "parseBasicStanza must be called with a simple field." } [Make explicit that reading package descriptions isn't supported here, ATM. Thomas Schilling **20070623200701] { hunk ./Distribution/Make.hs 113 - defaultPackageDesc verbosity >>= - readPackageDescription verbosity + error "Package Descripion was promised not be used here" + --defaultPackageDesc verbosity >>= + -- readPackageDescription verbosity hunk ./Distribution/Make.hs 120 - defaultMainHelper args $ \ _ -> return pkg_descr + defaultMainHelper args $ \ _ -> return pkg_descr } [Fix warnings, add documentation and changes in response to some Thomas Schilling **20070623201135 interface changes. ] { hunk ./Distribution/PackageDescription.hs 46 + PreparedPackageDescription(..), + finalizePackageDescription, hunk ./Distribution/PackageDescription.hs 103 -import Control.Monad.State hunk ./Distribution/PackageDescription.hs 104 -import Data.Maybe(fromMaybe, isNothing, isJust, catMaybes, listToMaybe) -import Data.List (nub, maximumBy, unfoldr) +import Data.Maybe(isNothing, isJust, catMaybes, listToMaybe) +import Data.List (nub, maximumBy, unfoldr, partition) hunk ./Distribution/PackageDescription.hs 108 -import qualified System.Info hunk ./Distribution/PackageDescription.hs 125 -import Data.List (sortBy, partition) hunk ./Distribution/PackageDescription.hs 127 +import Data.List ( sortBy ) hunk ./Distribution/PackageDescription.hs 210 +-- XXX: I think we really want a PPrint or Pretty or ShowPretty class. hunk ./Distribution/PackageDescription.hs 212 - show (PreparedPackageDescription pkg flags mlib exes) = + show (PreparedPackageDescription pkg flgs mlib exes) = hunk ./Distribution/PackageDescription.hs 214 - (render $ vcat $ map ppFlag flags) ++ "\n" ++ + (render $ vcat $ map ppFlag flgs) ++ "\n" ++ hunk ./Distribution/PackageDescription.hs 230 -finalizePackageDescription :: [(String,Bool)] -> [PackageIdentifier] - -> OSName -> ArchName +finalizePackageDescription :: [(String,Bool)] -> Maybe [PackageIdentifier] + -> String -> String hunk ./Distribution/PackageDescription.hs 233 - -> Maybe PackageDescription -finalizePackageDescription userflags pkgs os arch + -> Either [Dependency] + (PackageDescription, [(String,Bool)]) +finalizePackageDescription userflags mpkgs os arch hunk ./Distribution/PackageDescription.hs 237 - do (mlib, deps, flagVals) <- resolveFlags mlib0 - let exes = finalizeExes flagVals - return $ pkg { library = mlib - , executables = exes + case resolveFlags mlib0 of + Right (mlib, deps, flagVals) -> + let exes' = finalizeExes flagVals in + Right ( pkg { library = mlib + , executables = exes' hunk ./Distribution/PackageDescription.hs 244 + , flagVals ) + Left missing -> Left missing hunk ./Distribution/PackageDescription.hs 247 - resolveFlags Nothing = return (Nothing, [], flagDefaults) - resolveFlags (Just ct) = do - (l, ds, as) <- satisfyFlags flagChoices os arch ct check nullLibrary - return (Just (libFillInDefaults l), ds, as) - flagChoices = map (\(MkFlag n _ d) -> (n, d2c n d)) flags - d2c n b = maybe [b, not b] (\x -> [x]) $ lookup n userflags - flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices - check = all (isJust . satisfyDependency pkgs) + resolveFlags Nothing = Right (Nothing, [], flagDefaults) + resolveFlags (Just ct) = + case satisfyFlags flagChoices os arch ct check nullLibrary of + Right (l, ds, as) -> Right (Just (libFillInDefaults l), ds, as) + Left missing -> Left missing hunk ./Distribution/PackageDescription.hs 253 - + flagChoices = map (\(MkFlag n _ d) -> (n, d2c n d)) flags + d2c n b = maybe [b, not b] (\x -> [x]) $ lookup n userflags + flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices + check ds = if all satisfyDep ds + then DepOk + else MissingDeps $ filter (not . satisfyDep) ds + -- if we don't know which packages are present, we just accept any + -- dependency + satisfyDep = maybe (const True) + (\pkgs -> isJust . satisfyDependency pkgs) + mpkgs hunk ./Distribution/PackageDescription.hs 299 - [ simpleField reqNameName + [ simpleField reqNameName hunk ./Distribution/PackageDescription.hs 373 +nullLibrary :: Library hunk ./Distribution/PackageDescription.hs 419 +libFillInDefaults :: Library -> Library hunk ./Distribution/PackageDescription.hs 440 +nullExecutable :: Executable hunk ./Distribution/PackageDescription.hs 444 +exeFillInDefaults :: Executable -> Executable hunk ./Distribution/PackageDescription.hs 529 +-- | Modify all the 'BuildInfo's in a package description. +mapBuildInfo :: (BuildInfo -> BuildInfo) -> + PackageDescription -> PackageDescription +mapBuildInfo f pkg = pkg { + library = liftM mapLibBuildInfo (library pkg), + executables = map mapExeBuildInfo (executables pkg) } + where + mapLibBuildInfo lib = lib { libBuildInfo = f (libBuildInfo lib) } + mapExeBuildInfo exe = exe { buildInfo = f (buildInfo exe) } + +emptyBuildInfo :: BuildInfo +emptyBuildInfo = nullBuildInfo { hsSourceDirs = [currentDir] } + +-- see comment at libFillInDefaults +biFillInDefaults :: BuildInfo -> BuildInfo +biFillInDefaults bi = + if null (hsSourceDirs bi) + then bi { hsSourceDirs = [currentDir] } + else bi + hunk ./Distribution/PackageDescription.hs 717 - let (lineNo, message) = locatedErrorMsg e - dieWithLocation fpath lineNo message + let (line, message) = locatedErrorMsg e + dieWithLocation fpath line message hunk ./Distribution/PackageDescription.hs 727 -readPackageDescription :: Verbosity -> FilePath -> IO PackageDescription -readPackageDescription verbosity = readAndParseFile verbosity parseDescription +-- readPackageDescription :: Int -> FilePath -> IO PackageDescription +-- readPackageDescription verbosity = readAndParseFile verbosity parseDescription +readPackageDescription :: Verbosity -> FilePath -> IO PreparedPackageDescription +readPackageDescription verbosity = + readAndParseFile verbosity (\s -> readFields s >>= parseDescription') +{- hunk ./Distribution/PackageDescription.hs 747 +basic_field_descrs :: [FieldDescr PackageDescription] +basic_field_descrs = pkgDescrFieldDescrs ++ map liftToPkg libFieldDescrs + where liftToPkg = liftField (fromMaybe emptyLibrary . library) + (\lib pkg -> pkg{library = Just lib}) +-} +stanzas :: [Field] -> [[Field]] +stanzas [] = [] +stanzas (f:fields) = (f:this) : stanzas rest + where + (this, rest) = break isStanzaHeader fields + +isStanzaHeader :: Field -> Bool +isStanzaHeader (F _ f _) = f == "executable" +isStanzaHeader _ = False + +------------------------------------------------------------------------------ + + hunk ./Distribution/PackageDescription.hs 777 + hunk ./Distribution/PackageDescription.hs 780 -{- -detectCabalFormat :: [Field] -> ParseResult [Field] -detectCabalFormat fs = - if isSimpleFormat then return fs - else - - where - - isSimpleFormat = and (map isSimpleField fs) - isSimpleField (F _ _ _) = True - isSimpleField _ = False --} hunk ./Distribution/PackageDescription.hs 781 -depFieldNames = ["build-depends"] +-- names of fields that represents dependencies, thus consrca +constraintFieldNames :: [String] +constraintFieldNames = ["build-depends"] + +-- Possible refactoring would be to have modifiers be explicit about what +-- they add and define an accessor that specifies what the dependencies +-- are. This way we would completely reuse the parsing knowledge from the +-- field descriptor. +parseConstraint :: Field -> ParseResult [Dependency] +parseConstraint (F l n v) + | n == "build-depends" = runP l n (parseCommaList parseDependency) v +parseConstraint f = error $ "Constraint was expected. Report as a bug." + ++ "got: " ++ show f hunk ./Distribution/PackageDescription.hs 795 +{- hunk ./Distribution/PackageDescription.hs 797 -headerFieldNames = filter (\n -> not (n `elem` depFieldNames)) - . map fieldName $ pkgDescrFieldDescrs +headerFieldNames = filter (\n -> not (n `elem` constraintFieldNames)) + . map fieldName $ pkgDescrFieldDescrs +-} hunk ./Distribution/PackageDescription.hs 801 -libFieldNames = map fieldName libFieldDescrs ++ buildInfoNames ++ depFieldNames +libFieldNames :: [String] +libFieldNames = map fieldName libFieldDescrs + ++ buildInfoNames ++ constraintFieldNames hunk ./Distribution/PackageDescription.hs 805 -exeFieldNames = map fieldName executableFieldDescrs ++ buildInfoNames +-- exeFieldNames :: [String] +-- exeFieldNames = map fieldName executableFieldDescrs +-- ++ buildInfoNames hunk ./Distribution/PackageDescription.hs 809 +buildInfoNames :: [String] hunk ./Distribution/PackageDescription.hs 814 - +{- hunk ./Distribution/PackageDescription.hs 818 - , flags :: [Flag] + , cfFlags :: [Flag] hunk ./Distribution/PackageDescription.hs 822 +-} hunk ./Distribution/PackageDescription.hs 824 -data Config = MkConfig [PackageIdentifier] OSName ArchName - -{- -findDescription :: Config -> CabalFile -> ParseResult PackageDescription -findDescription (MkConfig pkgs os arch) - (MkCabalFile hdrs flags exes lib) = do - -- first we try to find a suitable (and admissable) assignment for the - -- flags - let mfass = tryAssignments flags [] - when (isNothing mfass) $ - error "Could not satisfy required dependencies." - let Just fass = mfass - pkg <- parseFields pkgDescrFieldDescrs emptyPackageDescription hdrs - let (deps, libfields) = evalCond fass lib - lib <- parseFields libFieldDescrs emptyLibrary libfields - let exefs = map (\(n,c) -> (n, snd $ evalCond fass c)) exes - exes <- mapM parseExeStanzas exefs - return $ pkg { buildDepends = deps - , library = Just lib - , executables = exes - } - where - parseExeStanzas (_name, flds) = - parseFields executableFieldDescrs emptyExecutable flds +-- A minimal implementation of the StateT monad transformer to avoid depending +-- on the 'mtl' package. +newtype StT s m a = StT { runStT :: s -> m (a,s) } hunk ./Distribution/PackageDescription.hs 828 - -- find first possible assignment and return this assignment, the - -- dependencies and the other fields - tryAssignments :: [Flag] -> [(String, Bool)] - -> Maybe ([(String, Bool)]) - tryAssignments (MkFlag name _ dflt : flags) env = - case dflt of - FlTrue -> tryAssignments flags ((name,True):env) - FlFalse -> tryAssignments flags ((name,False):env) - FlUnknown -> maybe (tryAssignments flags ((name,False):env)) Just $ - tryAssignments flags ((name,True):env) - tryAssignments [] env = - case mapM (satisfyDependency pkgs) deps of - Just pkgs' -> Just env - Nothing -> Nothing - where - (deps, fs) = evalCond env lib --} +instance Monad m => Monad (StT s m) where + return a = StT (\s -> return (a,s)) + StT f >>= g = StT $ \s -> do + (a,s') <- f s + runStT (g a) s' + +get :: Monad m => StT s m s +get = StT $ \s -> return (s, s) + +modify :: Monad m => (s -> s) -> StT s m () +modify f = StT $ \s -> return ((),f s) + +lift :: Monad m => m a -> StT s m a +lift m = StT $ \s -> m >>= \a -> return (a,s) + +evalStT :: Monad m => StT s m a -> s -> m a +evalStT st s = runStT st s >>= return . fst + +-- Our monad for parsing a list/tree of fields. +-- +-- The state represents the remaining fields to be processed. +type PM a = StT [Field] ParseResult a + + + +-- return look-ahead field or nothing if we're at the end of the file +peekField :: PM (Maybe Field) +peekField = get >>= return . listToMaybe hunk ./Distribution/PackageDescription.hs 857 -type PM a = StateT [Field] ParseResult a +-- Unconditionally discard the first field in our state. Will error when it +-- reaches end of file. (Yes, that's evil.) +skipField :: PM () +skipField = modify tail hunk ./Distribution/PackageDescription.hs 862 +-- | Parses the pre-parsed list of fields into a prepared package description. hunk ./Distribution/PackageDescription.hs 865 - fields <- mapSimpleFields deprecField fields1 - flip evalStateT fields $ do + let sf = sectionizeFields fields0 + fields <- mapSimpleFields deprecField sf + + flip evalStT fields $ do hunk ./Distribution/PackageDescription.hs 876 - fields1 = squeezeIntoShape fields0 - - -- "sectionize" an old-style Cabal file - squeezeIntoShape fs + -- "Sectionize" an old-style Cabal file. A sectionized file has: + -- + -- * all global fields at the beginning, followed by + -- * all flag declarations, followed by + -- * an optional library section, and + -- * an arbitrary number of executable sections. + -- + -- The current implementatition just gathers all library-specific fields + -- in a library section and wraps all executable stanzas in an executable + -- section. + sectionizeFields fs hunk ./Distribution/PackageDescription.hs 896 - | otherwise = error "OMG! The world is ending! Call Buffy!" + toExe l = error $ "unexpeced input to 'toExe'. Consider it a bug." + ++ "input was: " ++ show l hunk ./Distribution/PackageDescription.hs 909 - peekField :: PM (Maybe Field) - peekField = get >>= return . listToMaybe - skipField = modify tail + -- warn if there's something at the end of the file hunk ./Distribution/PackageDescription.hs 915 - fs -> lift $ warning "Ignoring trailing declarations." -- add line no. + _ -> lift $ warning "Ignoring trailing declarations." -- add line no. hunk ./Distribution/PackageDescription.hs 917 - getHeader fs = peekField >>= \mf -> case mf of - Just f@(F l n v) -> skipField >> getHeader (f:fs) - _ -> return (reverse fs) -- XXX: check for required fields + -- all simple fields at the beginning of the file are (considered) header + -- fields + getHeader acc = peekField >>= \mf -> case mf of + Just f@(F _ _ _) -> skipField >> getHeader (f:acc) + _ -> return (reverse acc) hunk ./Distribution/PackageDescription.hs 923 + -- + -- body ::= [ flags ] { library | executable }+ -- at most one lib + -- hunk ./Distribution/PackageDescription.hs 929 - Just f@(F l n v) - | n `elem` libFieldNames -> compatParse f -- old-style format - | n == "executable" -> compatParse f - | otherwise -> error $ "???" ++ show f -- XXX - Just f@(Section l sn sl fs) + -- Just f@(F l n v) + -- | n `elem` libFieldNames -> compatParse f -- old-style format + -- | n == "executable" -> compatParse f + -- | otherwise -> error $ "???" ++ show f -- XXX + Just (Section l sn _label _fields) hunk ./Distribution/PackageDescription.hs 935 - flags <- getFlags [] + -- don't skipField here. it's simpler to let getFlags do it + -- itself + flags <- getFlags [] hunk ./Distribution/PackageDescription.hs 945 - - --Just f@(IfBlock l s yes no) -> getLibOrExe f hunk ./Distribution/PackageDescription.hs 946 - + Just f -> lift $ syntaxError (lineNo f) $ + "Construct not supported at this position: " ++ show f + + -- + -- flags ::= "flag:" name { flag_prop } + -- hunk ./Distribution/PackageDescription.hs 953 - Just (Section l sn sl fs) + Just (Section _ sn sl fs) hunk ./Distribution/PackageDescription.hs 963 - Just (Section l sn sl fs) + Just (Section _ sn sl fs) hunk ./Distribution/PackageDescription.hs 987 - mod <- parser fs - processIfs parser ifs (CondLeaf ds mod) + fmod <- parser fs + processIfs parser ifs (CondLeaf ds fmod) hunk ./Distribution/PackageDescription.hs 991 - deps <- liftM concat . mapM parseDep $ deps0 + deps <- liftM concat . mapM (lift . parseConstraint) $ deps0 hunk ./Distribution/PackageDescription.hs 997 - isConstraint (F _ n v) = n == "build-depends" + isConstraint (F _ n _) = n `elem` constraintFieldNames hunk ./Distribution/PackageDescription.hs 1005 + hunk ./Distribution/PackageDescription.hs 1009 + hunk ./Distribution/PackageDescription.hs 1013 - processIfs parser other (Cond cnd (d1, mod1, if1) (d2, mod2, if2)) hunk ./Distribution/PackageDescription.hs 1014 --- checkFieldsOk fields names = do --- let (ok, other) = partition ((`elem` names) . fName) fields --- when (not (null other)) $ --- lift $ syntaxError (lineNo (head other)) --- ("Field not allowed in this section: " ++ fName (head other)) + processIfs parser other (Cond cnd (d1, mod1, if1) (d2, mod2, if2)) + processIfs _ l _ = error $ "List of if-blocks expected. Consider this a bug. " + ++ "got: " ++ show l hunk ./Distribution/PackageDescription.hs 1023 - mkMod descrs init union flds = do - a <- lift $ parseFields descrs init flds + -- + -- 'ini' is the empty result, + -- 'union is a function to join two partial results + -- + mkMod descrs ini union flds = do + a <- lift $ parseFields descrs ini flds hunk ./Distribution/PackageDescription.hs 1031 - -- XXX: extract to some more appropriate position - parseDep (F l f v) = lift $ runP l f (parseCommaList parseDependency) v - - compatParse _ = error "to be implemented" hunk ./Distribution/PackageDescription.hs 1034 -basic_field_descrs :: [FieldDescr PackageDescription] -basic_field_descrs = pkgDescrFieldDescrs ++ map liftToPkg libFieldDescrs - where liftToPkg = liftField (fromMaybe emptyLibrary . library) - (\lib pkg -> pkg{library = Just lib}) hunk ./Distribution/PackageDescription.hs 1035 -stanzas :: [Field] -> [[Field]] -stanzas [] = [] -stanzas (f:fields) = (f:this) : stanzas rest - where - (this, rest) = break isStanzaHeader fields hunk ./Distribution/PackageDescription.hs 1036 -isStanzaHeader :: Field -> Bool -isStanzaHeader (F _ f _) = f == "executable" hunk ./Distribution/PackageDescription.hs 1041 -parseField ((FieldDescr name _ parse):fields) a (F lineNo f val) - | name == f = parse lineNo val a - | otherwise = parseField fields a (F lineNo f val) +parseField ((FieldDescr name _ parse):fields) a (F line f val) + | name == f = parse line val a + | otherwise = parseField fields a (F line f val) hunk ./Distribution/PackageDescription.hs 1049 +parseField _ _ _ = error "'parseField' called on a non-field. This is a bug." + hunk ./Distribution/PackageDescription.hs 1064 +deprecField _ = error "'deprecField' called on a non-field. This is a bug." hunk ./Distribution/PackageDescription.hs 1081 - parseExe ((F lineNo inFieldName mName):bi) + parseExe ((F line inFieldName mName):bi) hunk ./Distribution/PackageDescription.hs 1085 - | otherwise = syntaxError lineNo "expecting 'executable' at top of stanza" + | otherwise = syntaxError line "expecting 'executable' at top of stanza" + parseExe (_:_) = error "`parseExe' called on a non-field. This is a bug." hunk ./Distribution/PackageDescription.hs 1124 -ppFields pkg' ((FieldDescr name get _):flds) = - ppField name (get pkg') $$ ppFields pkg' flds +ppFields pkg' ((FieldDescr name getter _):flds) = + ppField name (getter pkg') $$ ppFields pkg' flds hunk ./Distribution/PackageDescription.hs 1195 + hunk ./Distribution/PackageDescription.hs 1418 -#endif hunk ./Distribution/PackageDescription.hs 1421 -test_stanzas' = readFields testFile >>= stanzas' +test_stanzas' = readFields testFile >>= parseDescription' hunk ./Distribution/PackageDescription.hs 1455 - +{- hunk ./Distribution/PackageDescription.hs 1460 - let Just pd = finalizePackageDescription [] pkgs os arch ppd + let Right (pd,_) = finalizePackageDescription [] (Just pkgs) os arch ppd hunk ./Distribution/PackageDescription.hs 1480 - Just pd = finalizePackageDescription [("debug",True)] pkgs os arch ppd + Right (pd,_) = finalizePackageDescription [("debug",True)] (Just pkgs) os arch ppd hunk ./Distribution/PackageDescription.hs 1488 +-} + +#endif + } [Fix warnings. Thomas Schilling **20070623201254] { hunk ./Distribution/ParseUtils.hs 98 -runP lineNo fieldname p s = +runP line fieldname p s = hunk ./Distribution/ParseUtils.hs 103 - [] -> ParseFailed (NoParse fieldname lineNo) - _ -> ParseFailed (AmbigousParse fieldname lineNo) - _ -> ParseFailed (AmbigousParse fieldname lineNo) + [] -> ParseFailed (NoParse fieldname line) + _ -> ParseFailed (AmbigousParse fieldname line) + _ -> ParseFailed (AmbigousParse fieldname line) hunk ./Distribution/ParseUtils.hs 133 - FieldDescr name showF (\lineNo val _st -> runP lineNo name readF val) + FieldDescr name showF (\line val _st -> runP line name readF val) hunk ./Distribution/ParseUtils.hs 140 - (\lineNo str b -> do - a <- parseF lineNo str (get b) + (\line str b -> do + a <- parseF line str (get b) hunk ./Distribution/ParseUtils.hs 196 +fName :: Field -> String hunk ./Distribution/ParseUtils.hs 198 +fName (Section _ n _ _) = n +fName _ = undefined hunk ./Distribution/ParseUtils.hs 218 -mkStanza lines = parseLines lines [] +mkStanza lines0 = parseLines lines0 [] hunk ./Distribution/ParseUtils.hs 233 -getField ((n,[]):lines) = return (Nothing,lines) -getField ((n,'#':xs):lines) | not (isSpace (head xs)) = do - return (Just $ F n ('#':dir) (dropSpaces val), lines) +getField ((_,[]):ls) = return (Nothing,ls) +getField ((n,'#':xs):ls) | not (isSpace (head xs)) = do + return (Just $ F n ('#':dir) (dropSpaces val), ls) hunk ./Distribution/ParseUtils.hs 237 -getField ((lineno,line0):lines) = +getField ((lineno,line0):lines0) = hunk ./Distribution/ParseUtils.hs 243 - (val, lines') = getFieldValue indent (dropWhile isSpace val0) lines + (val, lines') = getFieldValue indent (dropWhile isSpace val0) lines0 hunk ./Distribution/ParseUtils.hs 246 - | map toLower blkName == "if" -> getIf (lineno,rest) lines - | map toLower blkName `elem` sectionNames -> getSection blkName (lineno,rest) lines + | map toLower blkName == "if" -> getIf (lineno,rest) lines0 + | map toLower blkName `elem` sectionNames -> + getSection (map toLower blkName) (lineno,rest) lines0 hunk ./Distribution/ParseUtils.hs 253 - getSection blkName (lineno,'{':rest) lines - ("","") -> return (Nothing,lines) + getSection (map toLower blkName) (lineno,'{':rest) lines0 + ("","") -> return (Nothing,lines0) hunk ./Distribution/ParseUtils.hs 265 -getIf (n,rest) lines = do +getIf (n,rest) ls = do hunk ./Distribution/ParseUtils.hs 269 - do (b,ls) <- getBlock (n,'{':cs) lines - return (cond, b, ls) - (cond, _) -> -- condition spans more than one line + do (b,ls') <- getBlock (n,'{':cs) ls + return (cond, b, ls') + (_, _) -> -- condition spans more than one line hunk ./Distribution/ParseUtils.hs 277 - tryElseBlock ((n,l):ls) = - if all isSpace l then return ([],ls) + tryElseBlock ((m,l):ls') = + if all isSpace l then return ([],ls') hunk ./Distribution/ParseUtils.hs 280 - (kw, rest) -> + (kw, rst) -> hunk ./Distribution/ParseUtils.hs 282 - getBlock (n,dropSpaces rest) ls - else syntaxError n "Only 'else' may appear after an if-Block" + getBlock (m,dropSpaces rst) ls' + else syntaxError m "Only 'else' may appear after an if-Block" hunk ./Distribution/ParseUtils.hs 292 -getBlock (n,rest) lines = do - lines' <- checkBlockStart (n,dropSpaces rest) lines +getBlock (lnum,rest) lines0 = do + lines' <- checkBlockStart (lnum,dropSpaces rest) lines0 hunk ./Distribution/ParseUtils.hs 304 - munchTillEndOfBlock lines@((n,l):ls) fs = + munchTillEndOfBlock lines1@((n,l):ls) fs = hunk ./Distribution/ParseUtils.hs 306 - (spaces, '}':rest) -> + (spaces, '}':rst) -> hunk ./Distribution/ParseUtils.hs 309 - , (n, rest):ls) + , (n, rst):ls) hunk ./Distribution/ParseUtils.hs 311 - _ -> do (f,ls') <- getField lines + _ -> do (f,ls') <- getField lines1 hunk ./Distribution/ParseUtils.hs 320 -getSection sectName (n,l) lines = +getSection sectName (n,l) lines0 = hunk ./Distribution/ParseUtils.hs 323 - do (b,lines') <- getBlock (n,'{':rest) lines + do (b,lines') <- getBlock (n,'{':rest) lines0 hunk ./Distribution/ParseUtils.hs 325 + (_,_) -> error "getSection got a line without a '{'. Consider this a bug." hunk ./Distribution/ParseUtils.hs 330 -getFieldValue indent val lines = +getFieldValue indent val lines0 = hunk ./Distribution/ParseUtils.hs 342 - (valrest,lines') = span (isContinuation indent . snd) lines + (valrest,lines') = span (isContinuation indent . snd) lines0 hunk ./Distribution/ParseUtils.hs 345 - isContinuation indent line = - length (takeWhile isSpace line) > indent && not (all isSpace line) + isContinuation ind line = + length (takeWhile isSpace line) > ind && not (all isSpace line) hunk ./Distribution/ParseUtils.hs 459 -test_readFields = case readFields testFile of +test_readFields = case + readFields testFile + of hunk ./Distribution/ParseUtils.hs 583 -#endif +-- +#endif } [Downcase flagnames. Re-add config flags (were removed due to update). Thomas Schilling **20070623201455] { hunk ./Distribution/Setup.hs 82 +import Data.Char( toLower ) hunk ./Distribution/Setup.hs 150 - configHaddockUsePackages :: Bool -- ^ auto-gen haddock --use-package + configHaddockUsePackages :: Bool, -- ^ auto-gen haddock --use-package + configConfigurationsFlags :: [(String, Bool)] hunk ./Distribution/Setup.hs 186 - configHaddockUsePackages = True + configHaddockUsePackages = True, + configConfigurationsFlags = [] hunk ./Distribution/Setup.hs 305 + | ConfigurationsFlags [(String, Bool)] hunk ./Distribution/Setup.hs 545 - "Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs." - ] + "Don't automatically pass --use-library flags to haddock. Instead, you might use --haddock-args with --read-interface to get web links to your dependent library docs.", + Option "f" ["flags"] (reqFlagsArgs ConfigurationsFlags) + "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." +] hunk ./Distribution/Setup.hs 585 - where tagWithValue ('-':name) = (name, False) - tagWithValue name = (name, True) + where tagWithValue ('-':name) = (map toLower name, False) + tagWithValue name = (map toLower name, True) hunk ./Distribution/Setup.hs 631 - updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True } - updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False } + updateCfg t WithHaddockUsePackages = t { configHaddockUsePackages = True } + updateCfg t WithoutHaddockUsePackages = t { configHaddockUsePackages = False } + updateCfg t (ConfigurationsFlags fs) = t { configConfigurationsFlags = + fs ++ configConfigurationsFlags t } } [Adjust to new package reading interface. Thomas Schilling **20070623201546] { hunk ./Distribution/SetupWrapper.hs 28 + PreparedPackageDescription(..), hunk ./Distribution/SetupWrapper.hs 64 - pkg_descr <- readPackageDescription (verbosity flags) pkg_descr_file + ppkg_descr <- readPackageDescription (verbosity flags) pkg_descr_file hunk ./Distribution/SetupWrapper.hs 68 - cabal_flag <- configCabalFlag flags (descCabalVersion pkg_descr) comp + cabal_flag <- configCabalFlag flags (descCabalVersion (packageDescription ppkg_descr)) comp hunk ./Distribution/SetupWrapper.hs 88 - case lookup (buildType pkg_descr) buildTypes of + case lookup (buildType (packageDescription ppkg_descr)) buildTypes of hunk ./Distribution/SetupWrapper.hs 90 - if withinRange cabalVersion (descCabalVersion pkg_descr) + if withinRange cabalVersion (descCabalVersion (packageDescription ppkg_descr)) } [Fix warnings. Thomas Schilling **20070623201723] { hunk ./Distribution/Simple.hs 88 -import Distribution.Simple.Configure(getPersistBuildConfig, maybeGetPersistBuildConfig, - configure, writePersistBuildConfig, localBuildInfoFile, - haddockVersion) +import Distribution.Simple.Configure + ( getPersistBuildConfig, maybeGetPersistBuildConfig, + configure, writePersistBuildConfig, localBuildInfoFile, + haddockVersion, writeConfiguredPkgDescr, getConfiguredPkgDescr + ) hunk ./Distribution/Simple.hs 100 - moduleToFilePath, findFile, warn) + moduleToFilePath, findFile) hunk ./Distribution/Simple.hs 107 -import System.Exit(ExitCode(..), exitWith) +--import System.Exit(ExitCode(..), exitWith) hunk ./Distribution/Simple.hs 116 -import System.IO ( hPutStrLn, stderr ) -import System.Environment ( getProgName ) hunk ./Distribution/Simple.hs 147 - confHook :: PackageDescription -> ConfigFlags -> IO LocalBuildInfo, + confHook :: ( Either PreparedPackageDescription PackageDescription + , HookedBuildInfo) + -> ConfigFlags -> IO (LocalBuildInfo, PackageDescription), hunk ./Distribution/Simple.hs 164 - -- |Over-ride this hook to gbet different behavior during makefile. + -- |Over-ride this hook to get different behavior during makefile. hunk ./Distribution/Simple.hs 264 - let get_pkg_descr verbosity = - case mdescr of - Just pkg_descr -> return pkg_descr - Nothing -> do - maybeDesc <- readDesc hooks - case maybeDesc of - Nothing -> defaultPkgDescr - Just p -> return p - where - defaultPkgDescr = do - pkg_descr_file <- defaultPackageDesc verbosity - readPackageDescription verbosity pkg_descr_file - defaultMainWorker get_pkg_descr action args' hooks prog_conf + -- let get_pkg_descr verbosity = case mdescr of +-- Just pkg_descr -> return pkg_descr +-- Nothing -> do +-- maybeDesc <- readDesc hooks +-- case maybeDesc of +-- Nothing -> defaultPkgDescr +-- Just p -> return p +-- where +-- defaultPkgDescr = do +-- -- FIXME: add compat mode or flag to enable configs +-- pkg_descr_file <- defaultPackageDesc verbosity +-- readPackageDescription verbosity pkg_descr_file + defaultMainWorker mdescr action args' hooks prog_conf hunk ./Distribution/Simple.hs 297 -defaultMainWorker :: (Verbosity -> IO PackageDescription) +defaultMainWorker :: (Maybe PackageDescription) hunk ./Distribution/Simple.hs 303 -defaultMainWorker get_pkg_descr action all_args hooks prog_conf +defaultMainWorker mdescr action all_args hooks prog_conf hunk ./Distribution/Simple.hs 309 - pkg_descr0 <- get_pkg_descr (configVerbose flags') - let pkg_descr = updatePackageDescription pbi pkg_descr0 - (warns, ers) <- sanityCheckPackage pkg_descr - errorOut (configVerbose flags') warns ers - localbuildinfo <- confHook hooks pkg_descr flags' - writePersistBuildConfig (foldr id localbuildinfo optFns) + + pkg_descr0 <- maybe (confPkgDescr flags') (return . Right) mdescr + + -- get_pkg_descr (configVerbose flags') + --let pkg_descr = updatePackageDescription pbi pkg_descr0 + let epkg_descr = (pkg_descr0, pbi) + + --(warns, ers) <- sanityCheckPackage pkg_descr + --errorOut (configVerbose flags') warns ers + + (localbuildinfo, pkg_descr) <- confHook hooks epkg_descr flags' + + writePersistBuildConfig (foldr id localbuildinfo optFns) + writeConfiguredPkgDescr pkg_descr + hunk ./Distribution/Simple.hs 325 + where + confPkgDescr :: ConfigFlags -> IO (Either PreparedPackageDescription + PackageDescription) + confPkgDescr cfgflags = do + mdescr' <- readDesc hooks + case mdescr' of + Just descr -> return $ Right descr + Nothing -> do + pdfile <- defaultPackageDesc (configVerbose cfgflags) + ppd <- readPackageDescription (configVerbose cfgflags) pdfile + return (Left ppd) hunk ./Distribution/Simple.hs 378 - (verbosity,_, args) <- parseTestArgs all_args [] + (_verbosity,_, args) <- parseTestArgs all_args [] hunk ./Distribution/Simple.hs 380 - pkg_descr <- get_pkg_descr verbosity + pkg_descr <- getConfiguredPkgDescr -- get_pkg_descr verbose hunk ./Distribution/Simple.hs 395 - command parse_args get_verbosity + command parse_args _get_verbosity hunk ./Distribution/Simple.hs 400 - pkg_descr0 <- get_pkg_descr (get_verbosity flags) + pkg_descr0 <- getConfiguredPkgDescr + --pkg_descr0 <- get_pkg_descr (get_verbose flags) hunk ./Distribution/Simple.hs 459 - packageFlags <- liftM catMaybes $ mapM makeReadInterface (packageDeps lbi) + pkgFlags <- liftM catMaybes $ mapM makeReadInterface (packageDeps lbi) hunk ./Distribution/Simple.hs 479 - ++ packageFlags + ++ pkgFlags hunk ./Distribution/Simple.hs 501 - ++ packageFlags + ++ pkgFlags hunk ./Distribution/Simple.hs 766 --- |Output warnings and errors. Exit if any errors. -errorOut :: Verbosity -- ^Verbosity - -> [String] -- ^Warnings - -> [String] -- ^errors - -> IO () -errorOut verbosity warnings errors = do - mapM_ (warn verbosity) warnings - when (not (null errors)) $ do - pname <- getProgName - mapM (hPutStrLn stderr . ((pname ++ ": Error: ") ++)) errors - exitWith (ExitFailure 1) } [Add proper handling of configurations to configure command. Thomas Schilling **20070623202017] { hunk ./Distribution/Simple/Configure.hs 48 + writeConfiguredPkgDescr, + configuredPkgDescrFile, + getConfiguredPkgDescr, hunk ./Distribution/Simple/Configure.hs 80 + PreparedPackageDescription(..), + finalizePackageDescription, + HookedBuildInfo, sanityCheckPackage, updatePackageDescription, hunk ./Distribution/Simple/Configure.hs 88 +--import Distribution.Configuration ( mkOSName, mkArchName ) hunk ./Distribution/Simple/Configure.hs 90 +import Distribution.ParseUtils ( showDependency ) + +import Text.PrettyPrint.HughesPJ ( comma, punctuate, render, nest, sep ) hunk ./Distribution/Simple/Configure.hs 98 +import System.Environment ( getProgName ) +import System.IO ( hPutStrLn, stderr ) hunk ./Distribution/Simple/Configure.hs 103 +import System.Exit(ExitCode(..), exitWith) +--import System.Exit ( ExitCode(..) ) +import qualified System.Info ( os, arch ) hunk ./Distribution/Simple/Configure.hs 158 -configuredPkgDescr :: FilePath -configuredPkgDescr = "./.configured.cabal" +configuredPkgDescrFile :: FilePath +configuredPkgDescrFile = "./.configured_cabal" hunk ./Distribution/Simple/Configure.hs 164 - writeFile configuredPkgDescr (show pd) + writeFile configuredPkgDescrFile (show pd) hunk ./Distribution/Simple/Configure.hs 167 -tryGetConfiguredPkgDescr = tryGetConfigStateFile configuredPkgDescr +tryGetConfiguredPkgDescr = tryGetConfigStateFile configuredPkgDescrFile hunk ./Distribution/Simple/Configure.hs 177 --- |Perform the \"@setup configure@\" action. --- Outputs the @dist\/setup-config@ file. -configure :: PackageDescription -> ConfigFlags -> IO LocalBuildInfo -configure pkg_descr cfg +-- |Perform the \"@.\/setup configure@\" action. +-- Returns the @.setup-config@ file. +configure :: ( Either PreparedPackageDescription PackageDescription + , HookedBuildInfo) + -> ConfigFlags -> IO (LocalBuildInfo, PackageDescription) +configure (pkg_descr0, pbi) cfg hunk ./Distribution/Simple/Configure.hs 188 - ipkgs <- case f' of + mipkgs <- case f' of hunk ./Distribution/Simple/Configure.hs 190 - getInstalledPackagesAux comp cfg + getInstalledPackagesAux comp cfg >>= return . Just hunk ./Distribution/Simple/Configure.hs 192 - getInstalledPackagesJHC comp cfg - _ -> do - return $ map setDepByVersion (buildDepends pkg_descr) - setupMessage (configVerbose cfg) "Configuring" pkg_descr + getInstalledPackagesJHC comp cfg >>= return . Just + _ -> + return Nothing + -- return $ map setDepByVersion (buildDepends pkg_descr) + + setupMessage (configVerbose cfg) "Configuring" + (either packageDescription id pkg_descr0) + + (pkg_descr, flags) <- case pkg_descr0 of + Left ppd -> + case finalizePackageDescription + (configConfigurationsFlags cfg) + mipkgs + System.Info.os + System.Info.arch + ppd + of Right r -> return r + Left missing -> + die $ "At least the following dependencies are missing:\n" + ++ (render . nest 4 . sep . punctuate comma $ + map showDependency missing) + Right pd -> return (pd,[]) + + + when (not (null flags)) $ + message $ "Flags chosen: " ++ (concat . intersperse ", " . + map (\(n,b) -> n ++ "=" ++ show b) $ flags) + + (warns, ers) <- sanityCheckPackage $ + updatePackageDescription pbi pkg_descr + + errorOut (configVerbose cfg) warns ers + + let ipkgs = fromMaybe (map setDepByVersion (buildDepends pkg_descr)) mipkgs hunk ./Distribution/Simple/Configure.hs 239 - defPrefix <- default_prefix + defPrefix <- defalt_prefix hunk ./Distribution/Simple/Configure.hs 333 - return lbi + return (lbi, pkg_descr) hunk ./Distribution/Simple/Configure.hs 548 + +-- |Output warnings and errors. Exit if any errors. +errorOut :: Verbosity -- ^Verbosity + -> [String] -- ^Warnings + -> [String] -- ^errors + -> IO () +errorOut verbosity warnings errors = do + mapM_ (warn verbosity) warnings + when (not (null errors)) $ do + pname <- getProgName + mapM (hPutStrLn stderr . ((pname ++ ": Error: ") ++)) errors + exitWith (ExitFailure 1) + + } [Fix typo. Thomas Schilling **20070623202333] { hunk ./Distribution/Simple/Configure.hs 239 - defPrefix <- defalt_prefix + defPrefix <- default_prefix } [Disable (comment out) tests for now. Break due to changed interface. Thomas Schilling **20070623203121] { hunk ./Distribution/PackageDescription.hs 1200 +-- disabled for now +{- hunk ./Distribution/PackageDescription.hs 1456 - +-} } [Properly fix tests. Thomas Schilling **20070623203939] { hunk ./Distribution/PackageDescription.hs 1312 - +-- #ifdef DEBUG +-} hunk ./Distribution/PackageDescription.hs 1315 +hunitTests = [] +{- hunk ./Distribution/PackageDescription.hs 1420 - +-} hunk ./Distribution/PackageDescription.hs 1423 - +{- hunk ./tests/ModuleTest.hs 72 - +import Distribution.Verbosity ( silent ) hunk ./tests/ModuleTest.hs 487 - compiler <- configCompiler (Just compilerFlavour) Nothing Nothing 0 + compiler <- configCompiler (Just compilerFlavour) Nothing Nothing silent } [Re-add configurations module to .cabal file. (Got removed on update.) Thomas Schilling **20070623204706] { hunk ./Cabal.cabal 34 + Distribution.Configuration, } Context: [update output Ross Paterson **20070620152404] [break up the long string literal Ross Paterson **20070620152103 This makes the output work with implementations (like Hugs) that impose a limit on the size of string literals. ] [update Simon Marlow **20070620091950] [include Makefile.local if it exists; allows local customization Simon Marlow **20070620091946] [clean up .hi-boot and .o-boot Simon Marlow **20070620091843] [add a "DO NOT EDIT" notice to the top of Cabal-generated Makefiles Simon Marlow **20070620091759] [Fix warning Ian Lynagh **20070615183346] [report non-option arguments as errors (fixes #90 and #113) Ross Paterson **20070607082326 Formerly, non-option arguments to all commands were silently ignored. Now setup halts with an error message in this case. ] [Fix error message regression Simon Marlow **20070606142650 Passing a non-existent program for --with-hc-pkg used to say this: $ ./Setup configure --with-hc-pkg=foo Configuring QuickCheck-2.0... /bin/sh: foo: command not found Setup: executing external program failed: "foo" --global list >tmp23634 Now it is rather less useful: $ ./setup configure --with-hc-pkg=foo configure: Reading installed packages... zsh: 23596 exit 127 ./setup configure --with-hc-pkg=foo This patch restores the old behaviour, slightly improved: $ ./Setup --with-hc-pkg=foo configure configure: Reading installed packages... Setup: executing external program failed (exit 127) : foo --global list ] [don't pass unrecognized arguments to ./configure Ross Paterson **20070605231500 They are now reported as errors. To pass them to configure, use the new --configure-option flag. Non-option arguments are still ignored (#90 and #113), as with all of the other commands. ] [Add and use createDirectoryIfMissingVerbose Ian Lynagh **20070602002507 rather than createDirectoryIfMissing ] [Overwrite .installed-pkg-config if it exists when registering Ian Lynagh **20070530150838] [add --cpphs-options Ross Paterson *-20070115141053] [add --cpphs-options Ross Paterson **20070115141053] [implement --configure-option and --ghc-option (#139) Ross Paterson **20070604114851 Added options used for building in the GHC tree: setup configure --configure-option=STR setup build --ghc-option=STR setup makefile --ghc-option=STR These were formerly scattered across Setup.hs files. ] [warning police on SetupWrapper Ross Paterson **20070603104827] [trim imports Ross Paterson **20070603104802] [include preprocessed modules in setup haddock (fixes #138) Ross Paterson **20070602195508] [move dotfiles into dist Ross Paterson **20070602175348 .setup-config -> dist/setup-config .installed-pkg-config -> dist/installed-pkg-config .inplace-pkg-config -> dist/inplace-pkg-config ] [mark mkGHCMakefile.sh and GHCMakefile.in as source files Ross Paterson **20070601155538 so that they'll be included in source distributions of this package. ] [cope with ghc-pkg returning multiple values for a field Ross Paterson **20070601155450] [Close the handle of temporary files before removing them Ian Lynagh **20070529192852 The removal fails on Windows if we don't, giving unhelpful errors like Setup.exe: .\tmp3660: removeFile: permission denied (Permission denied) ] [add nhc98-options: field to .cabal file Malcolm.Wallace@cs.york.ac.uk**20070528122833] [Fix warnings in Paths_* autogenerated module Ian Lynagh **20070527220538] [Fix quoting when doing gen-script of ' in descriptions Ian Lynagh **20070526154747 It used to turn into '', which just disappears. Now it turns into '\''. ] [Add Distribution.Simple.GHCMakefile to Exposed-Modules Ian Lynagh **20070526153905] [old nhc98 Makefiles now obsolete Malcolm.Wallace@cs.york.ac.uk**20070525133004] [Remove package.conf.in and GHC bits of Makefile (used in the old build system) Ian Lynagh **20070524142725] [avoid overflowing the argument limit when building a split-objs lib Simon Marlow **20070524134817] [Improvements for 'setup makefile' Simon Marlow **20070524132736 - now the makefile can build the library too; so 'setup build' isn't required (unless there are post-build steps). This will be necessary for bootstrapping GHC from .hc files, where we'll be using Makefiles generated by 'setup makefile' to build the libraries. - the Makefile tempate is in a text file, processed into a .hs file by a small script (mkGHCMakefile.sh). This is run by hand for now, and I've included the generated module, so there shouldn't be any problems with building Cabal. - some cleanup and refactoring in Distribution.Simple.GHC ] [fix cut&pasto Simon Marlow **20070520185605] [generalise type of xargs Simon Marlow **20070520185556] [We now depend on process Ian Lynagh **20070523181444] [We now depend on pretty, directory and old-time Ian Lynagh **20070522133304] [Pass rawSystemStdout verbosity, not verbose Ian Lynagh **20070523212145] [fix compilation with GHC 6.2.x Simon Marlow **20070523083703] [now needs -package filepath Malcolm.Wallace@cs.york.ac.uk**20070522085446] [Dumping Distribution.Compat.FilePath in favor of System.FilePath Pepe Iborra **20070521125919 sorry folks, Compat.FilePath is gone ] [Get right the verbosity correspondence for GHC Pepe Iborra **20070521124306 GHC has more verbosity levels than Distribution.Verbosity, this patch gives a more accurate correspondence ] [portability fix Ross Paterson **20070521113908] [custom show'ers for Verbosity Pepe Iborra **20070520233520] [Export simpleUserHooks Ian Lynagh **20070518152026] [FIX BUILD with GHC 6.2.x Simon Marlow **20070516103919] [Small tidyup Ian Lynagh **20070515151409] [cope with pre-requisite packages with empty haddock fields (like rts) Ross Paterson **20070515150935] [Put some comments in about what the verbosity stuff means Ian Lynagh **20070515125013] [rejig location of package interfaces for haddock Ross Paterson **20070515110833 Formerly, setup haddock invoked haddock with a --use-package option for each prerequisite package, causing haddock to invoke ghc-pkg to get the haddock-interfaces and haddock-html fields for each package. The former is accurate, but the latter is not what you want if your documentation is to be placed on the web. Now setup haddock invokes ghc-pkg itself, but if the --html-location option is given, its argument is expanded for each package and used instead of the haddock-html field. The results are then assembed as --read-interface options for haddock. For example, setup haddock '--html-location=http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html' generates HTML documentation with hyperlinks pointing at the pages on HackageDB. ] [Fix warnings Ian Lynagh **20070514173011] [Fix warnings Ian Lynagh **20070514171124] [Fix a warning Ian Lynagh **20070514170157] [Fix warnings Ian Lynagh **20070514165951] [Compile with -Wall Ian Lynagh **20070514161917] [Make a proper verbosity type, rather than using Int values Ian Lynagh **20070514165514 Hopefully this will make it easier to get better verbosity consistency. We could, by changing only Distribution.Verbosity, use "type Verbosity = Int" for now to give users of the library a chance to catch up, but the upcoming Cabal release seems like a good opportunity to cram in as much of the interface-changing stuff that we want to do as we can. I think the added benefit of a slow switch would be very low indeed. ] [separate build and output directory for Hugs build Ross Paterson **20070513001502 Hugs requires a separate directory for the output files from the directory containing the preprocessed files. The --scratchdir option now sets the former (and thus has an effect only for Hugs). This repairs the Hugs build. ] [non-GHC version of rawSystemStdout Ross Paterson **20070513001017] [remove copy of cabal-install library Ross Paterson **20070501160347] [Use Control.Exception even for nhc98 now. Malcolm.Wallace@cs.york.ac.uk**20070504144146] [remove cabal-install and cabal-setup from Makefile Duncan Coutts **20070503220644 These are no longer in the tree, they have their own repos now. ] [Fix more verbosity settings of messages Duncan Coutts **20070503213124] [Fix import of IO.try Duncan Coutts **20070503205024 Hopefully System.IO.Error exists for nhc98 too. ] [For nhc98, restore 'systemGetStdout' under the name 'rawSystemStdout' :-) Malcolm.Wallace@cs.york.ac.uk**20070503145457 This should now be equivalent in functionality to what was previously removed. ] [Hack around non-portable System.Process stuff for nhc98. Malcolm.Wallace@cs.york.ac.uk**20070503142544 This is enough to permit Cabal to compile again, but it certainly won't run. ] [Fix a couple verbosity settings Duncan Coutts **20070502211900 Showing what files are copied should only be shown at verbosity level 2 and above. The default verbosity level is 1. Similarly, creating the hidden package registration file should not be shown at the default verbosity level. ] [fix installIncludeFiles again. Bertram Felgenhauer **20070502182917 the include file directory must be created for ghc, otherwise package registration will fail. sigh. ] [nhc98 does not have Control.Exception Malcolm.Wallace@cs.york.ac.uk**20070502122017] [fix Haddock syntax error Simon Marlow **20070502093700] [Add test case for platform dependent and independent generated sources Duncan Coutts **20070501142716 The c2hs .hs files should go in dist/build while the happy .hs source should remain in the src dir and end up in the sdist tarball. ] [fix installIncludeFiles thinko Bertram Felgenhauer **20070501131608 due to the newly added guard, the "Can't happen" is no longer true. ] [Do not delete platform independent pre-processed sources during sdist Duncan Coutts **20070501142419 Since only platform independent pre-processed sources are now left in the src dirs we don't have to delete any pre-processed sources and can just inlcude them all into the src tarball. Ideally we'd track this slightly better in future, it's not nice to be keeping any generates sources in the src dirs, they should be considered read-only. ] [Leave platform independent pre-processed sources in the src dir Duncan Coutts **20070501142323 Only put platform dependent ones into dist/build ] [Record if pre-processors are platform independent Duncan Coutts **20070501142147 PreProcessor is now a record with a couple fields. Quite a few knock-on changes due to changing this data type. ] [call c2hs using the more detailed info Duncan Coutts **20070422102617 we use --output-dir=dist/base and --output=.hs This actually depends on a patch in c2hs to make it treat --output-dir in the way we want. That patch will be forthcomming soonish. But the point is: c2hs --output-dir=dist/base --output=Foo/Bar.hs src/Foo/Bar.chs will generate dist/base/Foo/Bar.hs and also dist/base/Foo/Bar.h but inside the .hs file it'll reference Foo/Bar.h so when we compile the .hs file we have to -Idist/base Clear as mud? ] [Generalise PreProcessors to take more detailed args Duncan Coutts **20070422100558 Most pre-processors just need the full source file and target file names. More complicated ones where the generated files have to embed links to each other need more information. For example c2hs generates .hs file that reference generated .h files. These links should be relative to the dist/build dir and not to the top of the source tree, since we do not want to add -I. to the includes search path. We only want to use -Idist/build, hence the embeded links must be relative to that. Therefor c2hs needs to know the base output directory as well as the name of the file relative to that. So we add a new type PreProcessorFull that has this extra info and a function simplePP :: :: PreProcessor -> PreProcessorFull for the common case of most existing pre-processors that do not need this extra info. This patch doesn't actually change the c2hs stuff, that comes next. ] [Put pre-processed source into the dist/build dir rather than src dirs Duncan Coutts **20070422095631 This is generally just a nicer thing to do, we should probably aim to not write any files into the source tree at all. The main change is in the preprocessModule function. It now takes an extra arg which is the destination directory. For now I'm passing the buildDir, but we could consider putting pre-processed files into a separate fir from where the .o and .hi files end up. To work out the correct destination file we need to know not only the source file but which of the search dirs it was found in, since the relative file name will be the name of the source file relative to the search dir it was found in, not the name relative to the top of the source tree. This is so that we will be able to find the pre-processed .hs file just by adding dist/build to the sources search path when we compile (eg with -i for ghc). This almost certainly breaks the sdist thing where pre-processed files get included into the tarball. So that'll need looking at. ] [update documentation for install-headers: field Bertram Felgenhauer **20070420131524] [install headers for all compilers Bertram Felgenhauer **20070420123527 This patch moves the installation of header files from Distribution.Simple.GHC to Distribution.Simple.Install. This is required for the header files to be usable for preprocessing Haskell code in other packages. ] [don't automatically include install-include: headers into compilations via C Bertram Felgenhauer **20070420123418 This way it's possible to install header files that are meant for preprocessing Haskell code, or header files that are meant to be indirectly included by others. ] [Don't overwrite existing makefiles Duncan Coutts **20070430203552 Patch contributed by Bryan O'Sullivan ] [Fix openTempFile so it works on windows with ghc at least Duncan Coutts **20070430185744 It's still a hack. The right solution is to proerly implement openTempFile in base for all Haskell impls, not just GHC. ] [Use rawSystem not system for capturing output of commands Duncan Coutts **20070430184046 For example we were using a wrapper around 'system' to find the haddock version. This invokes the system command interpreter and passes the command to run as an argument. If the command has spaces in it and is not properly escaped then everything goes wrong. This happens for example on windows when haddock and other programs are kept under "Program Files". So the right thing to do is never to use system, but always rawSystem since then there are no escaping issues. This patch replaces a couple function systemCaptureStdout and systemGetStdout with rawSystemStdout which now lives in Distribution.Simple.Utils. This also uses some rather nasty code to get the output of a command. It really really should not be this hard to do portably. To work around the fact that we cannot use runInteractiveProcess we instead have to create a temporary file. This also turns out to be a hack because the 'standard' openTempFile is not implemented except by GHC, so we now have a hacky version living in Distribution.Compat.TempFile just waiting for the standard openTempFile to be made properly portable, or for us to get some System.Process function that does what we want. ] [Fix the verbosity level for printing executed commands Duncan Coutts **20070430155054 Since 1 is the default verbosity level we should only print commands at level 2 and above. ] [initialBuildSteps should not actually build. Bryan O'Sullivan **20070424183841] [pretend that Cabal can build with nhc98 Malcolm.Wallace@cs.york.ac.uk**20070424104244] [minor tweaks to nhc98 branches of case distinctions Malcolm.Wallace@cs.york.ac.uk**20070212171419] [minor clarifications in doc of package descriptions Ross Paterson **20070423093806] [Fix for older GHCs, which exported a System.IO.try Ian Lynagh **20070419002443] [work around missing Control.Exception for nhc98 Malcolm.Wallace@cs.york.ac.uk**20070418230821] [Remove unnecessary import Ian Lynagh **20070418114407] [Fix imports Ian Lynagh **20070418110139] [Change variable name to match type change Ian Lynagh **20070418104811] [Fix Cabal's Setup.lhs after Maybe UserHooks / UserHooks change Duncan Coutts **20070418034619] [Behave the same on Windows and non-Windows Ian Lynagh **20070417230311] [Stop having hooks return an ExitCode that we then ignore Ian Lynagh **20070417225657] [Small tidyup Ian Lynagh **20070417225031] [Stop pretending we might not have any UserHooks Ian Lynagh **20070417224220] [Be better about exiting if a command we run fails Ian Lynagh **20070417222257] [Suggest that missing deps need to be downloaded and installed from hackage Ian Lynagh **20070417210158] [Make contents of SrcDist more useful to outside users. Bryan O'Sullivan **20070415060916 This change simply splits sdist into three functions. The normal sdist function remains unchanged from the caller's perspective, but it now consists of two phases, each an exported function. The source tree is prepared by prepareTree, and the archive is created by createArchive. This lets the cabal-rpm tool prepare a source tree and insert a few extra files into it before generating a tarball. ] [setup makefile: handle hs-source-dirs Simon Marlow **20070416140205 but only if there's a single entry for now. ] [setup makefile: use -p option to mkdir when making object directories Simon Marlow **20070416134720 I had a feeble attempt to avoid needing this originally, using $(sort ...) to create parents before children, but sometimes the parents aren't in the list, so it doesn't work. mkdir's -p option is POSIX, and I found it on all the platforms I checked (Linux, Solaris, Darwin, FreeBSD). ] [a couple of fixes to 'setup makefile' Simon Marlow **20070416133307 Put the -package-name flag at the beginning of GHC_OPTS, allowing it to be overriden later (as we do in the base package, for example). Also, add -split-objs if necessary. ] [remove illegal literal tabs in strings (again) Malcolm.Wallace@cs.york.ac.uk**20070416101220] [add missing support for .hs-boot/.lhs-boot with 'setup makefile' Simon Marlow **20070413152244] [Pass all the Cc/Ld flags to hsc2hs Ian Lynagh **20070413131318] [REINSTATE: Fix C/Haskell type mismatches Malcolm.Wallace@cs.york.ac.uk**20070412130607 This patch was previously applied and then rolled back. This new version imports System.Posix.Types.CPid correctly for nhc98. ] [Fix -Wall warnings Ian Lynagh **20070411004954] [-Wall fixes Ian Lynagh **20070411003509] [Remove duplicate import Ian Lynagh **20070410170930] [remove illegal tab chars in string literals Malcolm.Wallace@cs.york.ac.uk**20070410085626] [Use Distribution.Compat.FilePath.pathSeparator in Distribution.SetupWrapper, instead of having a local copy. bjorn@bringert.net**20070409165203] [Fix C/Haskell type mismatches Ian Lynagh *-20070404003510] [Rejig the adjacent checking in the unlitter Ian Lynagh **20070407173415 We were rejecting # 1 "foo" > ... in the HUnit package, claiming that it had a comment next to a program line. Now we treat anything cpp inserts as being blank. ] [parse (but don't pass on) options for ./configure Ian Lynagh **20070406153622] [Remove cabal-{builder,install,setup,upload} (now in separate repos) Ian Lynagh **20070405194729] [Add 'setup makefile' command Simon Marlow **20070309155022 'setup makefile' generates a Makefile that performs the steps necessary to compile the Haskell sources to object code. This only works for libraries, and only with GHC right now. Instead of simply 'setup build', you can do this: $ ./setup makefile $ make $ ./setup build where './setup makefile' does the preprocessing and generates a Makefile tailored to the current package. 'make' will build all the Haskell code to object files, and 'setup build' will build any C code and the library archives. The reason for all this is that you can say 'make -j' and get a parallel build, or you can say make dist/build/Foo.o EXTRA_HC_OPTS=-keep-s-file to compile a single file with extra options. ] [make Setup suitable for building the libraries with GHC Ian Lynagh **20061112214536] [Expose Distribution.Compat.ReadP Ian Lynagh **20061112214447] [Fix C/Haskell type mismatches Ian Lynagh **20070404003510] [Use rawSystemPath for calling tar rather than system Duncan Coutts **20070327110606 Means we get -v verboe output and better error messages if the command is not found. ] [Check the return value of tar Bryan O'Sullivan **20070326234148] [Fixed and improved Haddock comments sven.panne@aedion.de**20070322164427] [If we export ParseResult, we should export PError and PWarning, too sven.panne@aedion.de**20070322164340] [remove Makefile.inc (only affects nhc98) Malcolm.Wallace@cs.york.ac.uk**20070320120844] [Fixes compiling an executable for profiling with template haskell. Judah Jacobson **20070314012802] [rejig handling of continuation lines (fixes Cabal #118) Ross Paterson **20070311154610 Also avoids quadratic behaviour on long fields. ] [add Distribution.SetupWrapper to exposed-modules Simon Marlow **20070309122146] [Tweaks to make Cabal play nicer with haddock Ian Lynagh **20070308155718 The path for the html docs now includes the package name at the end, which works nicer for multiple packages sharing a contents/index. Use --ghc-pkg when available (in haddock darcs only currently) to tell haddock which ghc-pkg to use. Use --allow-missing-html when available (in haddock darcs only currently) to tell haddock not to worry if it can't find the HTML for packages we depend on. This is necessary when haddocking a group of packages before moving them all into place. ] [Cope with ghc-pkg telling us packages are broken Ian Lynagh **20070307193131] [Tell GHC to use .hs mode when we want it to cpp something for us Ian Lynagh **20070307143612] [Add parentheses so expressions are parsed correctly Ian Lynagh **20070307131941] [minor refactoring Ross Paterson **20070301002731] [fix \begin{code typo Ross Paterson **20070301002557] [document the --with-compiler / --with-hc inconsistency Ross Paterson **20070225115601] [Clarify documentation on --with-compiler and --with-hc-pkg simonpj@microsoft.com**20070221110452] [minor markup tweaks Ross Paterson **20070218104622] [This usePackages stuff is haddock-specific so name it as such Duncan Coutts **20070213201434] [{en,dis}able-use-packages, -optP-P only if haddock<0.8 Conal Elliott **20070204061106] [cabal-upload: Added command-line options for username, password, checking instead of uploading. Added ability to get login from file, and to get password from the terminal. Added still unused verbosity options. Bumped version number to 0.2. bjorn@bringert.net**20070212232920] [exclude Setup.lhs Ross Paterson **20070212193608 This was generating a useless Main entry in the lib doc index. (good for STABLE) ] [Add recent Cabal modules to nhc98 build system. Malcolm.Wallace@cs.york.ac.uk**20070212171106] [Compatibility with Haskell'98. Malcolm.Wallace@cs.york.ac.uk**20070212170804 Import Distribution.Compat.Exception instead of Control.Exception. Fix illegal indentation of cascaded do-blocks. ] [add --enable-optimization/--disable-optimization config options (on by default) Ross Paterson **20070212004513] [cabal-upload: nicer output. bjorn@bringert.net**20070206154619] [Send Accept header. bjorn@bringert.net**20070206153521] [Allow uploading multiple packages. bjorn@bringert.net**20070206153406] [Changed HTTP dependency to >= 1.0. bjorn@bringert.net**20070206153054] [cabal-upload: Removed build-simple since hackage doesn't seem to accept it for non-lib packages. bjorn@bringert.net**20070206133616] [Added URL for cabal-upload wiki page. bjorn@bringert.net**20070206132142] [Added usage message to cabal-upload. bjorn@bringert.net**20070206131408] [Added a small hacky first version of cabal-upload. bjorn@bringert.net**20070206112237] [cabal-setup doesn't need -cpp Ross Paterson **20070115154724] [Refactorings only Simon Marlow **20070114203741 Here are a batch of refactorings to clean up parsing and parts of the simple build system. This patch originated in a patch sent to cabal-devel@haskell.org with an intial implementation of configurations. Since then we decided to go a different route with configurations, so I have separated the refactoring from the configurations patch. At this point, 2 tests fail for me, but I get the same 2 failures without this patch. ] [pass arguments through when performing the setup actions ourselves Ross Paterson **20070113133211] [separate option for the compiler for Setup.hs Ross Paterson **20070113133000 This need not be the same compiler as used to build the package ] [Ignoring user packages when installing locally doesn't make sense. Lemmih **20070112150318] [cabal-install now caches downloaded packages in the directory for the package, and with .tar.gz extension. bjorn@bringert.net**20070112143527] [cabal-install.cabal: Added build-type field. Change hs-source-dir to hs-source-dirs (hs-source-dir has been deprecated for some time). bjorn@bringert.net**20070112131959] [cabal-install --user now keeps package cache and package list in ~/.cabal-install bjorn@bringert.net**20070112131301] [fix ghc-options (not a listField) bjorn@bringert.net**20070112124938] [add a Build-Type field, and use it in setupWrapper Ross Paterson **20070111233018 As discussed on the libraries list (Nov 2006), add a field Build-Type which can be used to declare that this package uses one of the boilerplate setup scripts. This allows setupWrapper (used by cabal-setup and cabal-install) to bypass the setup script in this case and perform the setup actions itself. ] [remove a use of null+head Ross Paterson **20070111182430] [remove two fromJust's Ross Paterson **20070111182401] [pass CABAL_VERSION to Hugs Ross Paterson **20070111182216] [cabal-install now puts the package list in /var/lib/cabal-install and the tarballs in /var/cache/cabal-install by default. Added command-line options for changing those. bjorn@bringert.net**20070111190452] [Track verbosity argument changes Ian Lynagh **20070111180601] [Testsuite quietening Ian Lynagh **20070111175329] [cabal-install: Output usage info for the right command when pasrsing the package name arguments fails. bjorn@bringert.net**20070111164924] [SetupWrapper now passes verbosity to other functions, as required by Igloo's patch. bjorn@bringert.net**20070111161651] [Make cabal-install use setupWrapper (the library version of cabal-setup). bjorn@bringert.net**20070111160535] [Moved the cabal-setup code to Distribution.SetupWrapper, so that cabal-install can use it. CabalSetup.hs now just calls the setupWrapper function. bjorn@bringert.net**20070111130506] [Quieten the testsuite more Ian Lynagh **20070111155957] [Pass verbosity info down to warn Ian Lynagh **20070111154526] [Derive Show on various datatypes Ian Lynagh **20070111140220] [Give feedback in runTests.sh Ian Lynagh **20070111132654] [Be less verbose at verbosity level 1 Ian Lynagh **20070111131228] [Fix warning Ian Lynagh **20070111130928] [No need for -fno-warn-unused-matches any more Ian Lynagh **20070111130824] [Always pass Hooks around, not Maybe Hooks Ian Lynagh **20070111124234] [Make Makefile use the right ghc/ghc-pkg Ian Lynagh **20070111122833] [Add -Wall to GHCFLAGS Ian Lynagh **20070111102742] [Updated cabal-install test scripts to use the main Cabal repo. bjorn@bringert.net**20070111111727] [Added cabal-install test scripts. bjorn@bringert.net**20070110184835] [Added cabal-install Makefile. bjorn@bringert.net**20070110184754] [Added HTTP package code used by cabal-install. bjorn@bringert.net**20070110184545] [Imported all the cabal-install sources. bjorn@bringert.net**20070110183142] [Added cabal-install dep on regex-compat. bjorn@bringert.net**20070110180020] [Removed old CabalInstall.hs (it has moved to cabal-install/src in one of the pataches I pulled in). bjorn@bringert.net**20070110174435] [Pulling in cabal-install: changed default Hackage DB URL. bjorn@bringert.net**20070110173825] [Pulling cabal-with-install into Cabal: cabal-install.cabal changes. bjorn@bringert.net**20070110172811] [Pulling changes from cabal-with-install: Multiple repositories. bjorn@bringert.net**20070110164852 Original patch: Sat Sep 2 00:13:40 CEST 2006 Paolo Martini * Multiple repositories. ] [Pulling changes from cabal-with-install: Stripping off the dependencies, only HTTP left bjorn@bringert.net**20070110164556 Original patch: Sun Aug 20 19:01:03 CEST 2006 Paolo Martini * Stripping off the dependencies, only HTTP left ] [Resolve Makefile conflict from importing Cabal-with-install patches. bjorn@bringert.net**20070110163852] [a program to test download & install a bunch of cabal packages ijones@syntaxpolice.org**20061114063409] [added --inplace trick to cabal build so that cabal-install can build on machines without cabal. ijones@syntaxpolice.org**20060922034620] [First attempt to make a new repository (url in the configuration) Paolo Martini **20060820180342] [Tarball index format support Paolo Martini **20060816223509] [Quieten a test Ian Lynagh **20070110175223] [Pass 0 verbosity on to GHC when building Ian Lynagh **20070110174050] [More verbosity tweaking Ian Lynagh **20070110172956] [Rejig verbosity levels a bit; 1 is now the default (was 0) Ian Lynagh **20070110165149] [Make system tweaks to avoid cabal thinking it isn't bootstrapped when running the testsuite Ian Lynagh **20070110162940] [Typo Ian Lynagh **20070110154617] [Refer to the right variables Ian Lynagh **20070110151326] [Give unrecognised flags more clearly Ian Lynagh **20070110144650] [Beautify Ian Lynagh **20070110143711] [Retab Ian Lynagh **20070110143103] [Remove some chatter from the test scripts Ian Lynagh **20070110142756] [Eliminate more warnings Ian Lynagh **20070110142114] [More -Wall clean fixes Ian Lynagh **20070110135838] [Improve cleaning Ian Lynagh **20070110134230] [-Wall clean fixes Ian Lynagh **20070110125523 This patch is sponsored by Hac 07. Have you hacked a lambda today? ] [Fix non-fatal problem with 'setup haddock' for an exe package Simon Marlow **20070109133751 For some unknown reason, we were passing --use-package=P to haddock, where P is the name of the current executable package. This can never work, since P is not a library and will not be installed. Fortunately Haddock ignores the error and continues anyway. ] [Set the Cabal version when building via the fptools build system sven.panne@aedion.de**20070106152814 Without this patch, Cabal is effectively "version-less" and all .cabal files with a version requirement are unusable. Therefore I think that this patch (or at least something equivalent) should be pushed to the 6.6.1 branch, too. ] [added --save-configure flag to clean. got some complaints that there was no way to avoid reconfiguring after a clean. now if you use --save-configure, you should be able to. ijones@syntaxpolice.org**20061219152204] [tiny mod to License comments ijones@syntaxpolice.org**20061219060021] [improving help output ijones@syntaxpolice.org**20061219055849 As suggested by Claus Reinke in this ticket: http://hackage.haskell.org/trac/hackage/ticket/105 ] [fix ./Setup unregister --help, which was giving the help for register Simon Marlow **20061215165000] [Fix the links in the user guide to the API docs Duncan Coutts *-20061129131633] [Fix the links in the user guide to the API docs Duncan Coutts **20061129131633] [haddock comments for SrcDist.hs ijones@syntaxpolice.org**20061127041303] [some haddock comments for LocalBuildInfo.hs ijones@syntaxpolice.org**20061127040916] [a little comment for JHC.hs ijones@syntaxpolice.org**20061127040026] [some comments for Install.hs ijones@syntaxpolice.org**20061127035919] [some comments for Hugs.hs ijones@syntaxpolice.org**20061127035310] [haddock comments for GHC and GHCPackageConig ijones@syntaxpolice.org**20061127034617] [some comments for Configure.hs ijones@syntaxpolice.org**20061127033157] [some comments for Build.hs ijones@syntaxpolice.org**20061127032409] [minor comments and cleanup for Setup.hs ijones@syntaxpolice.org**20061127031744] [some haddock explanation of preprocessors ijones@syntaxpolice.org**20061127031055] [some comments for Package.hs ijones@syntaxpolice.org**20061127025108] [haddockizing some comments from Make.hs ijones@syntaxpolice.org**20061127024142] [adding comments to Program.hs ijones@syntaxpolice.org**20061127022353] [comments for the Program module ijones@syntaxpolice.org**20061127002749] [don't return an error code just because there's no library to register ijones@syntaxpolice.org**20061124144831] [Purely cosmetic; have '---args' use ARGS on their RHS rather than PATH in usage output sof@galois.com**20061121195844] [parse executable field as a token (as documented), rather than free text Ross Paterson **20061120093400] [trim trailing spaces (including CRs) from all input lines Ross Paterson **20061120092526] [help nhc98 find the import of programLocation Malcolm.Wallace@cs.york.ac.uk**20061117144001] [sdist: make it work on Windows platforms by simplifying 'tar' invocation. Hopefully not at the cost of other plats (i.e., as-yet untested there..)" sof@galois.com**20061117014832] [build: consult and use any user-provided settings for 'ld' and 'ar' sof@galois.com**20061117014622] [defaultUserHooks.sDistHook: pass in optional LBI to SrcDist.sdist sof@galois.com**20061117014448] [defaultProgramConfiguration: add 'ld' and 'tar' entries sof@galois.com**20061117014318] [revise Paths module for the Hugs target Ross Paterson **20061108223349 When targetting Hugs, the Paths module now uses prefix-independent paths relative to the location of the Main module of the program, on all platforms. For the Hugs target, this replaces the code using GetModuleFileNameA(), which never worked. Behaviour under GHC should be unchanged. ] [Hugs: fix location of installed package info Ross Paterson **20061021144613] [Fix escaping of ' chars in register.sh script. Duncan Coutts **20061016215459] [Tidy up command comments Duncan Coutts **20061013211158] [Fix getDataDir etc. when bindir=$prefix Simon Marlow **20061013100941] [Update text on the front page: packages can now overlap in GHC 6.6 Simon Marlow **20061012114601 ] [New unlit code "ported" from cpphs-1.2 Lennart Kolmodin **20061009192609] [Share one more place where the cabal version is defined. Duncan Coutts **20061010140027] [Fix spelling error in error message. Duncan Coutts **20061010140013] [Centeralise the places that know that Cabal version number Duncan Coutts **20061010135918] [Remove spurious debug message. Duncan Coutts **20061010125643] [Bump to next unstable development version Duncan Coutts **20061010125602] [Make cabal know it's own version number correctly Duncan Coutts **20061010130939 This is an unpleasent way of doing it. Will have to fix once and for all in the next version. ] [TAG 1.1.6 Duncan Coutts **20061009123801] Patch bundle hash: e544b45f668aa347a05d6e21e5a277ea19ed0ae1