syfco-1.1.0.0: src/Arguments.hs
-----------------------------------------------------------------------------
-- |
-- Module : Arguments
-- License : MIT (see the LICENSE file)
-- Maintainer : Felix Klein (klein@react.uni-saarland.de)
--
-- Argument parser.
--
-----------------------------------------------------------------------------
{-# LANGUAGE
LambdaCase
, RecordWildCards
#-}
-----------------------------------------------------------------------------
module Arguments
( parseArguments
) where
-----------------------------------------------------------------------------
import Syfco
( Configuration(..)
, WriteMode(..)
, defaultCfg
, verify
, update
)
import Data.Convertible
( safeConvert
)
import Info
( prError
)
import System.Directory
( doesFileExist
)
import Control.Monad
( void
, unless
)
import Text.Parsec.String
( Parser
)
import Text.Parsec
( parse
)
import Text.Parsec
( (<|>)
, (<?>)
, char
, oneOf
, many
, many1
, digit
, alphaNum
, eof
)
import Text.Parsec.Token
( LanguageDef
, GenLanguageDef(..)
, makeTokenParser
, stringLiteral
, identifier
, reserved
, reservedOp
, whiteSpace
)
import Reader.Parser.Data
( globalDef
)
-----------------------------------------------------------------------------
data Args a = None a | Single a
-----------------------------------------------------------------------------
-- | Argument parser, which reads the given command line arguments to
-- the internal configuration and checks whether the given
-- combinations are realizable.
parseArguments
:: [String] -> IO Configuration
parseArguments args = do
c <- traverse defaultCfg args
case verify c of
Left err -> prError $ show err
_ -> return c
where
traverse c = \case
x:y:xr -> do
r <- parseArgument c x (Just y)
case r of
Single c'-> traverse c' xr
None c' -> traverse c' (y:xr)
[x] -> do
r <- parseArgument c x Nothing
case r of
None c' -> return c'
Single c' -> return c'
[] -> return c
parseArgument c arg next = case arg of
"-o" -> case next of
Just x -> return $ Single $ c { outputFile = Just x }
Nothing -> argsError "\"-o\": No output file"
"--output" -> case next of
Nothing -> argsError "\"--output\": No output file"
_ -> parseArgument c "-o" next
"-r" -> case next of
Just file -> do
exists <- doesFileExist file
unless exists $ argsError $ "File does not exist: " ++ file
fmap (update c) (readFile file) >>= \case
Left err -> prError $ show err
Right c' -> return $ Single c'
Nothing -> argsError "\"-r\": No configuration file"
"--read-config" -> case next of
Nothing -> argsError "\"--read-config\": No configuration file"
_ -> parseArgument c "-r" next
"-w" -> case next of
Just file ->
return $ Single $ c { saveConfig = file : saveConfig c }
Nothing -> argsError "\"-w\": Missing file path"
"--write-config" -> case next of
Nothing -> argsError "\"--write-config\": Missing file path"
_ -> parseArgument c "-w" next
"-f" -> case next of
Just x -> case safeConvert x of
Left err -> prError $ show err
Right y -> return $ Single $ c { outputFormat = y }
Nothing ->
argsError "\"-f\": No format given"
"--format" -> case next of
Nothing -> argsError "\"--format\": No format given"
_ -> parseArgument c "-f" next
"-m" -> case next of
Just "pretty" -> return $ Single $ c { outputMode = Pretty }
Just "fully" -> return $ Single $ c { outputMode = Fully }
Just x -> argsError ("Unknown mode: " ++ x)
Nothing -> argsError "\"-m\": No mode given"
"--mode" -> case next of
Nothing -> argsError "\"--mode\": no mode given"
_ -> parseArgument c "-m" next
"-pf" -> case next of
Just x -> return $ Single $ c { partFile = Just x }
Nothing -> argsError "\"-pf\": No partition file"
"-bd" -> case next of
Just x -> return $ Single $ c { busDelimiter = x }
Nothing -> argsError "\"-bd\": No delimiter given"
"--bus-delimiter" -> case next of
Nothing -> argsError "\"--bus-delimiter\": No delimiter given"
_ -> parseArgument c "-bd" next
"-ps" -> case next of
Just x -> return $ Single $ c { primeSymbol = x }
Nothing -> argsError "\"-ps\": No symbol replacement given"
"--prime-symbol" -> case next of
Just x -> return $ Single $ c { primeSymbol = x }
Nothing -> argsError "\"--prime-symbol\": No symbol replacement given"
"-as" -> case next of
Just x -> return $ Single $ c { atSymbol = x }
Nothing -> argsError "\"-as\": No symbol replacement given"
"--at-symbol" -> case next of
Just x -> return $ Single $ c { atSymbol = x }
Nothing -> argsError "\"--at-symbol\": No symbol replacement given"
"-in" -> return $ None $ c { fromStdin = True }
"-os" -> case next of
Just x -> case safeConvert x of
Left err -> prError $ show err
Right y -> return $ Single $ c { owSemantics = Just y }
Nothing -> argsError "\"-os\": No semantics given"
"--overwrite-semantics" -> case next of
Nothing -> argsError "\"--overwrite-semantics\": No semantics given"
_ -> parseArgument c "-os" next
"-ot" -> case next of
Just x -> case safeConvert x of
Left err -> prError $ show err
Right y -> return $ Single $ c { owTarget = Just y }
Nothing -> argsError "\"-ot\": No target given"
"--overwrite-target" -> case next of
Nothing -> argsError "\"--overwrite-target\": No target given"
_ -> parseArgument c "-ot" next
"-op" -> case next of
Just x -> case parse parameterParser "Overwrite Parameter Error" x of
Left err -> prError $ show err
Right y -> return $ Single $ c { owParameter = y : owParameter c }
Nothing -> argsError "\"-op\": No parameter given"
"--overwrite-parameter" -> case next of
Nothing -> argsError "\"--overwrite-parameter\": No parameter given"
_ -> parseArgument c "-op" next
"-s0" -> simple $ c { simplifyWeak = True }
"-s1" -> simple $ c { simplifyStrong = True }
"-nnf" -> simple $ c { negNormalForm = True }
"-pgi" -> simple $ c { pushGlobally = True }
"-pfi" -> simple $ c { pushFinally = True }
"-pxi" -> simple $ c { pushNext = True }
"-pgo" -> simple $ c { pullGlobally = True }
"-pfo" -> simple $ c { pullFinally = True }
"-pxo" -> simple $ c { pullNext = True }
"-nw" -> simple $ c { noWeak = True }
"-nr" -> simple $ c { noRelease = True }
"-nf" -> simple $ c { noFinally = True }
"-ng" -> simple $ c { noGlobally = True }
"-nd" -> simple $ c { noDerived = True }
"-gr" -> simple $ (clean c) { cGR = True }
"-c" -> simple $ (clean c) { check = True }
"-t" -> simple $ (clean c) { pTitle = True }
"-d" -> simple $ (clean c) { pDesc = True }
"-s" -> simple $ (clean c) { pSemantics = True }
"-g" -> simple $ (clean c) { pTarget = True }
"-a" -> simple $ (clean c) { pTags = True }
"-p" -> simple $ (clean c) { pParameters = True }
"-ins" -> simple $ (clean c) { pInputs = True }
"-outs" -> simple $ (clean c) { pOutputs = True }
"-i" -> simple $ (clean c) { pInfo = True }
"-v" -> simple $ (clean c) { pVersion = True }
"-h" -> simple $ (clean c) { pHelp = True }
"--readme" -> simple $ (clean c) { pReadme = True }
"--readme.md" -> simple $ (clean c) { pReadmeMd = True }
"--part-file" -> parseArgument c "-pf" next
"--stdin" -> parseArgument c "-in" next
"--weak-simplify" -> parseArgument c "-s0" next
"--strong-simplify" -> parseArgument c "-s1" next
"--negation-normal-form" -> parseArgument c "-nnf" next
"--push-globally-inwards" -> parseArgument c "-pgi" next
"--push-finally-inwards" -> parseArgument c "-pfi" next
"--push-next-inwards" -> parseArgument c "-pni" next
"--pull-globally-outwards" -> parseArgument c "-pgo" next
"--pull-finally-outwards" -> parseArgument c "-pfo" next
"--pull-next-outwards" -> parseArgument c "-pxo" next
"--no-weak-until" -> parseArgument c "-nw" next
"--no-realease" -> parseArgument c "-nr" next
"--no-finally" -> parseArgument c "-nf" next
"--no-globally" -> parseArgument c "-ng" next
"--no-derived" -> parseArgument c "-nd" next
"--generalized-reactivity" -> parseArgument c "-gr" next
"--check" -> parseArgument c "-c" next
"--print-title" -> parseArgument c "-t" next
"--print-description" -> parseArgument c "-d" next
"--print-semantics" -> parseArgument c "-s" next
"--print-target" -> parseArgument c "-g" next
"--print-tags" -> parseArgument c "-a" next
"--print-parameters" -> parseArgument c "-p" next
"--print-input-signals" -> parseArgument c "-ins" next
"--print-output-signals" -> parseArgument c "-outs" next
"--print-info" -> parseArgument c "-i" next
"--version" -> parseArgument c "-v" next
"--help" -> parseArgument c "-h" next
_ -> return $ None $ c {
inputFiles = arg : inputFiles c
}
argsError str = do
prError $ "\"Error\" " ++ str
clean a = a {
check = False,
pTitle = False,
pDesc = False,
pSemantics = False,
pTarget = False,
pParameters = False,
pInfo = False,
pVersion = False,
pHelp = False,
pReadme = False,
pReadmeMd = False
}
simple = return . None
-----------------------------------------------------------------------------
parameterParser
:: Parser (String, Int)
parameterParser = do
name <- identifier $ makeTokenParser globalDef
void $ char '='
x <- many1 digit
eof
return (name, read x)
-----------------------------------------------------------------------------