----------------------------------------------------------------------------- -- | -- Module : Argv -- Copyright : Thomas Hallgren and Malcolm Wallace -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- Command-line parsing for hmake. ----------------------------------------------------------------------------- module Argv(Goal(..),DecodedArgs(..),decode,stripGoal) where import ListUtil (lconcatMap) import Compiler import Config import PackageConfig (packageDirs) import Platform (unsafePerformIO) import List (isPrefixOf) import IO (hPutStrLn,stderr) -- | Target modules. Either a program or an "Object", which is the -- filename and its extension (suffix). data Goal = Object String String | Program String instance Show Goal where showsPrec n (Object name suf) = showString (name++'.':suf) showsPrec n (Program name) = showString name -- | Get the filename out of this Goal. In the case of an "Object", -- this does not include the extension. stripGoal :: Goal -> String stripGoal (Object name suf) = name stripGoal (Program name) = name -- /decode/ originally returned a 12-tuple of arguments. The structure -- /DecodedArgs/ is hopefully rather more meaningful. (Apart from -- anything else, nhc98 didn't do 13-tuples at the time, so this was -- needed in order to make extensions to the return value!) -- | The decoded command-line arguments. data DecodedArgs = Decoded { modules :: [Goal] -- ^ specified target modules , pathSrc :: [String] -- ^ paths to compilable sources , pathPrel :: [String] -- ^ paths to prelude .hi files , zdefs :: [String] -- ^ cpp options beginning -Z , defs :: [String] -- ^ cpp options beginning -D , ignoreHi :: [String] -- ^ .hi files to ignore , dflag :: Bool -- ^ does compiler have a -d option? , quiet :: Bool -- ^ option -q for quiet , keepPrel :: Bool -- ^ option -keepPrelude , isUnix :: Bool -- ^ Unix or RiscOS (!) , hat :: Bool -- ^ do we perform hat transformation? , debug :: (String->IO ()) -- ^ debugging printf function , ifnotopt :: ([String]->String->String) -- ^ is option unset? , ifopt :: ([String]->String->String) -- ^ is option set? , goalDir :: Maybe String -- ^ goal Directory for .o files , hiDir :: Maybe String -- ^ separate directory for .hi files , hiSuffix :: String -- ^ .hi / .T.hi , oSuffix :: String -- ^ .o / .T.o / .p.o / .z.o , config :: PersonalConfig -- ^ from file (via optional -ffile) , compiler :: CompilerConfig -- ^ chosen compiler } -- | Given the list of program arguments, decode them. decode :: [String] -> IO DecodedArgs decode progArgs = let d = Decoded { modules = (map wrapGoal . filter (not . isflag)) progArgs , pathSrc = error "pathSrc not known yet" , pathPrel = error "pathPrel not known yet" , zdefs = error "zdefs not known yet" -- , pathSrc = (map tail . filter (\v -> head v == 'I')) flags ++ -- (map tail . filter (\v -> head v == 'i')) flags ++ -- if isopt "keepPrelude" then pathPrel d else [] -- , pathPrel = (map tail . filter (\v -> head v == 'P')) flags ++ -- includePaths (compiler d) ++ -- packageDirs (compiler d) -- (map (drop 8) $ -- filter ("package="`isPrefixOf`) flags) -- , zdefs = (map tail . filter (\v -> head v == 'Z')) flags ++ -- cppSymbols (compiler d) ++ (if isHaskell98 (compiler d) then haskell98SymsForCpp else []) , defs = (map tail . filter (\v -> head v == 'D')) flags , ignoreHi = (map tail . filter (\v -> head v == 'N')) flags , dflag = False -- isopt "od" , quiet = isopt "q" , keepPrel = isopt "keepPrelude" , isUnix = True -- not (isopt "RiscOS") , hat = isopt "hat" , debug = if isopt "watch" then (\s->hPutStrLn stderr s) else (\s->return ()) , ifnotopt = \opts s -> if not (or (map isopt opts)) then s else "" , ifopt = \opts s -> if any isopt opts then s else "" , goalDir = case filter (\v-> head v == 'd') flags of [] -> Nothing [x] -> Just (tail x) _ -> error "hmake: only one -dobjdir option allowed\n" , hiDir = (withDefault Nothing (Just . drop 6 . last) . filter ("hidir=" `isPrefixOf`)) flags , hiSuffix = (withDefault "hi" (drop 10 . last) . filter ("hi-suffix=" `isPrefixOf`)) flags , oSuffix = (withDefault "o" (drop 9 . last) . filter ("o-suffix=" `isPrefixOf`)) flags , config = case filter (\v-> head v == 'f') flags of [] -> unsafePerformIO (readPersonalConfig (defaultConfigLocation False)) [x] -> PersonalConfig { globalConfig = readConfig (tail x) , localConfig = Nothing } _ -> error "hmake: only one -fconfigfile option allowed\n" , compiler = error "compiler not known yet" -- , compiler = case filter (\v-> "hc=" `isPrefixOf` v) flags of -- [] -> usualCompiler (config d) -- [x] -> matchCompiler (drop 3 x) (config d) -- _ -> error "hmake: only one -hc=compiler option allowed\n" } in do cc <- unDyn $ case filter (\v-> "hc=" `isPrefixOf` v) flags of [] -> usualCompiler (config d) [x] -> matchCompiler (drop 3 x) (config d) _ -> error "hmake: only one -hc=compiler option allowed\n" let d' = d { pathSrc = (map tail . filter (\v -> head v == 'I')) flags ++ (map tail . filter (\v -> head v == 'i')) flags ++ if isopt "keepPrelude" then pathPrel d' else [] , pathPrel = (map tail . filter (\v -> head v == 'P')) flags ++ includePaths (compiler d') ++ packageDirs (compiler d') (map (drop 8) $ filter ("package="`isPrefixOf`) flags) , zdefs = (map tail . filter (\v -> head v == 'Z')) flags ++ cppSymbols (compiler d') ++ (if isHaskell98 (compiler d') then haskell98SymsForCpp else []) , compiler = cc } return d' where flags = (map tail . filter isflag) progArgs isflag [] = False isflag (c : _) = c == '+' || c == '-' isopt opt = opt `elem` flags -- Look at the file argument, including the suffix, and decide -- whether it's a 'Program' or an 'Object'. wrapGoal :: String -> Goal wrapGoal file = let (s,n) = break (=='.') (reverse file) in findFirst (\suf -> if s == reverse suf then Just (Object (reverse (tail n)) suf) else Nothing) (Program file) suffixes findFirst :: (a->Maybe b) -> b -> [a] -> b findFirst f z [] = z findFirst f z (x:xs) = case f x of Just y -> y Nothing -> findFirst f z xs withDefault :: a -> ([b]->a) -> ([b]->a) withDefault s f [] = s withDefault s f xs = f xs suffixes = [ "lhs" -- literate Haskell , "gc" -- GreenCard , "hsc" -- hsc2hs , "hs" -- Haskell , "o" -- object file , "hi" -- interface file , "T.o" -- tracing object file , "p.o" -- heap-profiling object file , "z.o" -- time-profiling object file , "T.hi" -- tracing interface file ]