Skip to content
GitLab
Commit 9666b024 authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

deduplicate parse config

parent a3e27144
Hide whitespace changes
Inline Side-by-side
src/main/Main.hs
View file @ 9666b024
......@@ -116,12 +116,50 @@ subcommand =
)
)
parseConfig :: Parser P.Config
parseConfig = do
functor <- optional
(option
functorReader
( long "functor"
<> short 'f'
<> metavar "FUNCTOR_EXPR"
<> help
"Functor for the input coalgebra. This is normally the first line of \
\the input, but can also alternatively be given here."
)
)
initStateName <- optional
(option
str
( long "initial-state"
<> short 'i'
<> metavar "SYMBOL"
<> help "Name of the initial state of the coalgebra."
)
)
functorTransforms <- select P.DontApplyTransformations P.ApplyTransformations $ switch
( long "no-functor-transforms"
<> help
"Don't try to optimize functor expression. \
\This flag can drastically *reduce* performace."
)
sanityChecks <- select P.DisableSanityChecks P.EnableSanityChecks $ switch
( long "no-sanity-checks"
<> help
"Disable sanity checks in the parser. Do not use this lightly. It \
\might speed up the parser but require the input to be absolutely \
\correct. Otherwise, nasal demons might be created."
)
pure P.Config { .. }
where
select :: (Functor f) => a -> a -> f Bool -> f a
select tru fals f = (\b -> if b then tru else fals) <$> f
data RefineOptions = RefineOptions
{ refineStats :: Bool
, refineStatsJson :: Bool
, refineFunctor :: Maybe (FunctorExpression SomeFunctor Sort)
, refineApplyTransformations :: Bool
, refineEnableSanity :: Bool
, refineParseConfig :: P.Config
, refineEnableOpt :: Bool
, refineInputFile :: Maybe FilePath
-- , refineInputFormat :: InputFormat
......@@ -179,30 +217,7 @@ refineOptions = do
<> help
"Same as --stats, but in json format, suitable for parsing in other programs."
)
refineFunctor <- optional
(option
functorReader
( long "functor"
<> short 'f'
<> metavar "FUNCTOR_EXPR"
<> help
"Functor for the input coalgebra. This is normally the first line of \
\the input, but can also alternatively be given here."
)
)
refineApplyTransformations <- not <$> switch
( long "no-functor-transforms"
<> help
"Don't try to optimize functor expression. \
\This flag can drastically *reduce* performace."
)
refineEnableSanity <- not <$> switch
( long "no-sanity-checks"
<> help
"Disable sanity checks in the parser. Do not use this lightly. It \
\might speed up the parser but require the input to be absolutely \
\correct. Otherwise, nasal demons might be created."
)
refineParseConfig <- parseConfig
refineEnableOpt <- not <$> switch
( long "disable-optimizations"
<> help "Disable some optimizations. Currently, this is just the \
......@@ -214,10 +229,7 @@ refineOptions = do
data MinimizeOptions = MinimizeOptions
{ minimizeStats :: Bool
, minimizeStatsJson :: Bool
, minimizeApplyTransformations :: Bool
, minimizeEnableSanity :: Bool
, minimizeFunctor :: Maybe (FunctorExpression SomeFunctor Sort)
, minimizeInitState :: Maybe Text
, minimizeParseConfig :: P.Config
, minimizeEnableOpt :: Bool
, minimizeInputFile :: Maybe FilePath
}
......@@ -243,26 +255,7 @@ minimizeOptions = do
<> showDefault
)
)
minimizeFunctor <- optional
(option
functorReader
( long "functor"
<> short 'f'
<> metavar "FUNCTOR_EXPR"
<> help
"Functor for the input coalgebra. This is normally the first line of \
\the input, but can also alternatively be given here."
)
)
minimizeInitState <- optional
(option
str
( long "initial-state"
<> short 'i'
<> metavar "SYMBOL"
<> help "Name of the initial state of the coalgebra."
)
)
minimizeParseConfig <- parseConfig
minimizeStats <- switch
( long "stats"
<> help
......@@ -273,19 +266,6 @@ minimizeOptions = do
<> help
"Same as --stats, but in json format, suitable for parsing in other programs."
)
minimizeApplyTransformations <- not <$> switch
( long "no-functor-transforms"
<> help
"Don't try to optimize functor expression. \
\This flag can drastically *reduce* performace."
)
minimizeEnableSanity <- not <$> switch
( long "no-sanity-checks"
<> help
"Disable sanity checks in the parser. Do not use this lightly. It \
\might speed up the parser but require the input to be absolutely \
\correct. Otherwise, nasal demons might be created."
)
minimizeEnableOpt <- not <$> switch
( long "disable-optimizations"
<> help "Disable some optimizations. Currently, this is just the \
......@@ -297,8 +277,7 @@ minimizeOptions = do
data GraphOptions = GraphOptions
{ graphInputFile :: Maybe FilePath
, graphOutputFile :: Maybe FilePath
, graphFunctor :: Maybe (FunctorExpression SomeFunctor Sort)
, graphApplyTransformations :: Bool
, graphParseConfig :: P.Config
, graphDrawPartition :: Bool
, graphDrawNodeLabels :: Bool
, graphDrawEdgeLabels :: Bool
......@@ -338,17 +317,7 @@ graphOptions = do
<> showDefault
)
)
graphFunctor <- optional
(option
functorReader
( long "functor"
<> short 'f'
<> metavar "FUNCTOR_EXPR"
<> help
"Functor for the input coalgebra. This is normally the first line of \
\the input, but can also alternatively be given here."
)
)
graphParseConfig <- parseConfig
graphDrawPartition <- switch
(long "draw-partition" <> short 'P' <> help
"Calculate partition (see refine) and group nodes accordingly."
......@@ -363,10 +332,6 @@ graphOptions = do
(long "no-edge-labels" <> help
"Don't include edge labels. This can make larger graphs more readable."
)
graphApplyTransformations <- not <$> switch
( long "no-functor-transforms"
<> help "Don't try to optimize functor expression."
)
pure GraphOptions { .. }
functorReader :: ReadM (FunctorExpression SomeFunctor Sort)
......@@ -388,11 +353,8 @@ data DebugCommand = DebugFunctor Bool (FunctorExpression SomeFunctor Sort)
data DebugCoalgebraOptions = DebugCoalgebraOptions
{ debugCoalgebraApplyTransformations :: Bool
, debugCoalgebraEnableSanity :: Bool
, debugCoalgebraFunctor :: Maybe (FunctorExpression SomeFunctor Sort)
, debugCoalgebraInitState :: Maybe Text
, debugCoalgebraInputFile :: Maybe FilePath
{ debugCoalgebraInputFile :: Maybe FilePath
, debugCoalgebraParseConfig :: P.Config
}
debugCoalgebraOptions :: Parser DebugCoalgebraOptions
......@@ -408,37 +370,7 @@ debugCoalgebraOptions = do
<> showDefault
)
)
debugCoalgebraFunctor <- optional
(option
functorReader
( long "functor"
<> short 'f'
<> metavar "FUNCTOR_EXPR"
<> help
"Functor for the input coalgebra. This is normally the first line of \
\the input, but can also alternatively be given here."
)
)
debugCoalgebraInitState <- optional
(option
str
( long "initial-state"
<> short 'i'
<> metavar "SYMBOL"
<> help "Name of the initial state of the coalgebra."
)
)
debugCoalgebraApplyTransformations <- not <$> switch
( long "no-functor-transforms"
<> help "Don't try to optimize functor expression."
)
debugCoalgebraEnableSanity <- not <$> switch
( long "no-sanity-checks"
<> help
"Disable sanity checks in the parser. Do not use this lightly. It \
\might speed up the parser but require the input to be absolutely \
\correct. Otherwise, nasal demons might be created."
)
debugCoalgebraParseConfig <- parseConfig
pure DebugCoalgebraOptions { .. }
......@@ -514,23 +446,7 @@ main = do
withTimeStat stats "overall-duration" $ do
(_, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
let transPolicy = if refineApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
let sanity = if refineEnableSanity r
then P.EnableSanityChecks
else P.DisableSanityChecks
let parserConfig = P.Config
{ functorTransforms = transPolicy
, sanityChecks = sanity
, functor = refineFunctor r
, initStateName = Nothing
}
readCoalgebra parserConfig (refineInputFile r)
readCoalgebra (refineParseConfig r) (refineInputFile r)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
......@@ -588,22 +504,7 @@ main = do
withTimeStat stats "overall-duration" $ do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
let transPolicy = if minimizeApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
let sanity = if minimizeEnableSanity r
then P.EnableSanityChecks
else P.DisableSanityChecks
let parserConfig = P.Config
{ functorTransforms = transPolicy
, sanityChecks = sanity
, functor = minimizeFunctor r
, initStateName = minimizeInitState r
}
readCoalgebra parserConfig (minimizeInputFile r)
readCoalgebra (minimizeParseConfig r) (minimizeInputFile r)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
......@@ -659,16 +560,7 @@ main = do
finalizeStats stats
(GraphCommand r) -> do
(_, (symbolTable, encoding)) <- do
let transPolicy = if graphApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
let parserConfig = P.defaultConfig
{ P.functorTransforms = transPolicy
, P.functor = graphFunctor r
}
readCoalgebra parserConfig (graphInputFile r) >>= \case
readCoalgebra (graphParseConfig r) (graphInputFile r) >>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
......@@ -691,22 +583,7 @@ main = do
DebugCommand (DebugCoalgebra r) -> do
(f, (symbolTable, encoding)) <- do
let transPolicy = if debugCoalgebraApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
let sanity = if debugCoalgebraEnableSanity r
then P.EnableSanityChecks
else P.DisableSanityChecks
let parserConfig = P.Config
{ functorTransforms = transPolicy
, sanityChecks = sanity
, functor = debugCoalgebraFunctor r
, initStateName = debugCoalgebraInitState r
}
readCoalgebra parserConfig (debugCoalgebraInputFile r)
readCoalgebra (debugCoalgebraParseConfig r) (debugCoalgebraInputFile r)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment