module Hpp.CmdLine (runWithArgs) where
import Control.Monad (unless)
import Hpp
import Hpp.Config
import Hpp.Env (deleteKey, emptyEnv, insertPair)
import Hpp.Tokens
import Hpp.Types (Env, Error(..))
import System.Directory (doesFileExist, makeAbsolute)
breakEqs :: String -> [String]
breakEqs = aux . break (== '=')
where aux (h,[]) = [h]
aux (h,'=':t) = [h,"=",t]
aux _ = error "breakEqs broke"
splitSwitches :: String -> [String]
splitSwitches ('-':'I':t@(_:_)) = ["-I",t]
splitSwitches ('-':'D':t@(_:_)) = ["-D",t]
splitSwitches ('-':'U':t@(_:_)) = ["-U",t]
splitSwitches ('-':'o':t@(_:_)) = ["-o",t]
splitSwitches ('-':'i':'n':'c':'l':'u':'d':'e':t@(_:_)) = ["-include",t]
splitSwitches x = [x]
parseArgs :: ConfigF Maybe -> [String]
-> IO (Either Error (Env, [String], Config, Maybe FilePath))
parseArgs cfg0 = go emptyEnv id cfg0 Nothing . concatMap breakEqs
where go env acc cfg out [] =
case realizeConfig cfg of
Just cfg' -> return (Right (env, acc [], cfg', out))
Nothing -> return (Left NoInputFile)
go env acc cfg out ("-D":name:"=":body:rst) =
case parseDefinition (Important name : Other " " : tokenize body) of
Nothing -> return . Left $ BadMacroDefinition 0
Just def -> go (insertPair def env) acc cfg out rst
go env acc cfg out ("-D":name:rst) =
case parseDefinition ([Important name, Other " ", Important "1"]) of
Nothing -> return . Left $ BadMacroDefinition 0
Just def -> go (insertPair def env) acc cfg out rst
go env acc cfg out ("-U":name:rst) =
go (deleteKey name env) acc cfg out rst
go env acc cfg out ("-I":dir:rst) =
let cfg' = cfg { includePathsF = fmap (++[dir]) (includePathsF cfg) }
in go env acc cfg' out rst
go env acc cfg out ("-include":file:rst) =
let ln = "#include \"" ++ file ++ "\""
in go env (acc . (ln:)) cfg out rst
go env acc cfg out ("-P":rst) =
let cfg' = cfg { inhibitLinemarkersF = Just True }
in go env acc cfg' out rst
go env acc cfg out ("--cpp":rst) =
let cfg' = cfg { spliceLongLinesF = Just True
, eraseCCommentsF = Just True }
defs = concatMap ("-D":)
[ ["__STDC__"]
, ["__STDC_VERSION__","=","199409L"]
, ["_POSIX_C_SOURCE","=","200112L"] ]
in go env acc cfg' out (defs ++ rst)
go env acc cfg out ("--fline-splice":rst) =
go env acc (cfg { spliceLongLinesF = Just True }) out rst
go env acc cfg out ("--ferase-comments":rst) =
go env acc (cfg { eraseCCommentsF = Just True }) out rst
go env acc cfg _ ("-o":file:rst) =
go env acc cfg (Just file) rst
go env acc cfg out ("-x":_lang:rst) =
go env acc cfg out rst
go env acc cfg Nothing (file:rst) =
case curFileNameF cfg of
Nothing -> go env acc (cfg { curFileNameF = Just file }) Nothing rst
Just _ -> go env acc cfg (Just file) rst
go _ _ _ (Just _) _ =
return . Left $ BadCommandLine "Multiple output files given"
runWithArgs :: [String] -> IO ()
runWithArgs args =
do cfgNow <- defaultConfigFNow
let args' = concatMap splitSwitches args
(env,lns,cfg,outPath) <- fmap (either (error . show) id)
(parseArgs cfgNow args')
exists <- doesFileExist (curFileName cfg)
unless exists . error $
"Couldn't open input file: "++curFileName cfg
let fileName = curFileName cfg
cfg' = cfg { curFileNameF = pure fileName }
snk <- case outPath of
Nothing -> pure sinkToStdOut
Just f -> fmap (\f' -> sinkToFile hppRegisterCleanup f')
(makeAbsolute f)
_ <- hppIO cfg' env
(preprocess (before (source lns) (streamHpp fileName)))
snk
return ()