-----------------------------------------------------------------------------
-- |
-- Module : Argv
-- Copyright : Thomas Hallgren and Malcolm Wallace
--
-- Maintainer : Malcolm Wallace <[email protected]>
-- 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
]
|
