diff --git a/src/Copar/Coalgebra/Parser.hs b/src/Copar/Coalgebra/Parser.hs
index f639ead87be0ee1b03266248e899c03bbd6d620d..8fbc40d885e1ac59c63bd5e7c86cad4943c1b37c 100644
--- a/src/Copar/Coalgebra/Parser.hs
+++ b/src/Copar/Coalgebra/Parser.hs
@@ -110,6 +110,7 @@ finalizeState state =
, bimap (mkDesortedLabel @f) id (Encoding.new f1Vec edges)
)
+-- | Whether or not to do sanity checks on the input.
data SanityChecks = EnableSanityChecks | DisableSanityChecks
morphismsParser :: forall f.
diff --git a/src/Copar/Parser.hs b/src/Copar/Parser.hs
index f89e8b9cf0292808226250e527c5680568be5d58..83e9c0d79c0e11749d60bfc6092cbf5887c7dab7 100644
--- a/src/Copar/Parser.hs
+++ b/src/Copar/Parser.hs
@@ -1,15 +1,26 @@
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
+-- | High-level API for the various parsers.
+--
+-- This module combines the different parsers (functor, coalgebra) and exposes a
+-- high level API to parse the complete input for CoPaR. This is the parser API
+-- that should be used in the main function and high-level tests.
module Copar.Parser
- ( parseCoalgebra
+ ( -- * IO Parsers
+ readFile
+ , readStdin
+ -- * Pure Parsers
+ , parseCoalgebra
, parseFunctor
- , readCoalgebraFromFile
- , readCoalgebraFromStdin
+ -- * Parser Configuration
+ , Config(..)
+ , defaultConfig
, ApplyFunctorTransformations(..)
, SanityChecks(..)
) where
+import Prelude hiding ( readFile )
import Data.Bifunctor
import Data.Proxy
import qualified Data.List.NonEmpty as E
@@ -47,7 +58,9 @@ functorExpressionParser varReplacement functors = do
replaceVar other = other
--- wether to apply transformations stored in the AST
+-- | Whether to apply transformations on the parsed functor expression. These
+-- transformations can e.g replace certain functors with more efficient ones or
+-- optimize the expression in other ways.
data ApplyFunctorTransformations = ApplyTransformations | DontApplyTransformations
@@ -80,7 +93,17 @@ coalgebraParser functor transPolicy sanity = do
-- TODO: Needs better name
type TheFunctor = Desorted SomeFunctor
-parseFunctor :: String -> Text -> Either String (FunctorExpression SomeFunctor Sort)
+-- | Parse functor expression from text.
+--
+-- The functor expression contains 'SomeFunctor's, which in turn can wrap any of
+-- the registered functors.
+--
+-- It returns either an error message or the resulting (sorted) functor
+-- expression.
+parseFunctor
+ :: String -- ^ Name of the input (filename, etc)
+ -> Text -- ^ Input text
+ -> Either String (FunctorExpression SomeFunctor Sort)
parseFunctor name input =
let identity =
Functor
@@ -96,34 +119,81 @@ parseFunctor name input =
functorParsers = map (map functorExprParser) registeredFunctors
-parseCoalgebra ::
- Maybe (FunctorExpression SomeFunctor Sort)
- -> ApplyFunctorTransformations
- -> SanityChecks
- -> String
- -> Text
- -> Either String ( Proxy TheFunctor
- , (SymbolTable, Encoding (Label TheFunctor) (F1 TheFunctor)))
-parseCoalgebra functor transPolicy sanity name input =
- let identity =
- Functor
- (Precedence 0)
- (SomeFunctor
- (Polynomial
- (Sum (E.fromList [Product (E.fromList [Identity Variable])]))))
- eitherFunctor = maybe (Left (identity, functorParsers)) Right functor
- in bimap
+-- | Options for coalgebra parsing.
+data Config = Config
+ { -- | Controls whether to apply functor transformations. See
+ -- 'ApplyTransformations' for details.
+ functorTransforms :: ApplyFunctorTransformations
+ -- | Controls sanity checks during parsing. Disabling them can make the
+ -- parser faster but fail horribly if the input is not correct.
+ , sanityChecks :: SanityChecks
+ -- | The functor for the coalgebra. If this is @Nothing@ (the default), the
+ -- functor expression will be read from the first non-comment line of the
+ -- input.
+ , functor :: Maybe (FunctorExpression SomeFunctor Sort)
+ }
+
+
+-- | Default config: Apply functor transforms, enable sanity checks and read
+-- functor from input file.
+defaultConfig :: Config
+defaultConfig = Config
+ { functorTransforms = ApplyTransformations
+ , sanityChecks = EnableSanityChecks
+ , functor = Nothing
+ }
+
+
+-- | Parse a coalgebra from text.
+--
+-- If the parser configuration specifies a functor expression, this functor is
+-- used to parse the coalgebra. Otherwise, a functor expression is read from the
+-- first non-comment line in the input.
+--
+-- The returned value is either an error message, or as follows:
+--
+-- - A proxy for the type of the functor. This is always @Desorted
+-- SomeFunctor@ but can be used to conveniently pass the proxy to functions
+-- that require the type as input.
+-- - A symbol table, mapping the names of all states in sort 1 to their
+-- numerical id.
+-- - The coalgebra encoding.
+parseCoalgebra
+ :: Config -- ^ Parser configuration
+ -> String -- ^ Name of the input (filename, etc)
+ -> Text -- ^ Input text
+ -> Either
+ String
+ ( Proxy TheFunctor
+ , (SymbolTable, Encoding (Label TheFunctor) (F1 TheFunctor))
+ )
+parseCoalgebra config name input =
+ let identity = Functor
+ (Precedence 0)
+ (SomeFunctor
+ (Polynomial
+ (Sum (E.fromList [Product (E.fromList [Identity Variable])]))
+ )
+ )
+ eitherFunctor =
+ maybe (Left (identity, functorParsers)) Right (functor config)
+ in bimap
errorBundlePretty
(Proxy, )
- (parse (coalgebraParser eitherFunctor transPolicy sanity) name input)
- where
- functorParsers = map (map functorExprParser) registeredFunctors
-
-
-readCoalgebraFromFile
- :: Maybe (FunctorExpression SomeFunctor Sort)
- -> ApplyFunctorTransformations
- -> SanityChecks
+ (parse
+ (coalgebraParser eitherFunctor
+ (functorTransforms config)
+ (sanityChecks config)
+ )
+ name
+ input
+ )
+ where functorParsers = map (map functorExprParser) registeredFunctors
+
+
+-- | Read coalgebra from file. See 'parseCoalgebra' for details.
+readFile
+ :: Config
-> FilePath
-> IO
( Either
@@ -132,15 +202,14 @@ readCoalgebraFromFile
, (SymbolTable, Encoding (Label TheFunctor) (F1 TheFunctor))
)
)
-readCoalgebraFromFile functor transPolicy sanity filename = do
+readFile config filename = do
content <- T.readFile filename
- return $ parseCoalgebra functor transPolicy sanity filename content
+ return $ parseCoalgebra config filename content
-readCoalgebraFromStdin
- :: Maybe (FunctorExpression SomeFunctor Sort)
- -> ApplyFunctorTransformations
- -> SanityChecks
+-- | Read coalgebra from stdin. See 'parseCoalgebra' for details.
+readStdin
+ :: Config
-> IO
( Either
String
@@ -148,6 +217,6 @@ readCoalgebraFromStdin
, (SymbolTable, Encoding (Label TheFunctor) (F1 TheFunctor))
)
)
-readCoalgebraFromStdin functor transPolicy sanity = do
+readStdin config = do
content <- T.getContents
- return $ parseCoalgebra functor transPolicy sanity "(stdin)" content
+ return $ parseCoalgebra config "(stdin)" content
diff --git a/src/main/Main.hs b/src/main/Main.hs
index 8de38a00dd255c8d4c29bde4febeb0d2a0706bd3..92725aff4b7312abb83cccc04b27e76770d8e268 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -37,7 +37,7 @@ import Text.JSON
import Text.Show.Pretty (pPrint)
import Copar.Algorithm
-import Copar.Parser
+import qualified Copar.Parser as P
import Copar.PartitionPrinter
import Copar.Functors
import Copar.FunctorDescription
@@ -264,7 +264,7 @@ graphOptions = do
pure GraphOptions { .. }
functorReader :: ReadM (FunctorExpression SomeFunctor Sort)
-functorReader = eitherReader (\input -> parseFunctor input (T.pack input))
+functorReader = eitherReader (\input -> P.parseFunctor input (T.pack input))
data HelpCommand = HelpListFunctors
@@ -343,18 +343,10 @@ finalizeStats stats =
-- File handling
----------------------------------------------------------------------
-readCoalgebra
- :: Maybe (FunctorExpression SomeFunctor Sort)
- -> ApplyFunctorTransformations
- -> SanityChecks
- -> Maybe FilePath
- -> IO _
-readCoalgebra functor transPolicy sanity Nothing =
- readCoalgebraFromStdin functor transPolicy sanity
-readCoalgebra functor transPolicy sanity (Just "-") =
- readCoalgebraFromStdin functor transPolicy sanity
-readCoalgebra functor transPolicy sanity (Just file) =
- readCoalgebraFromFile functor transPolicy sanity file
+readCoalgebra :: P.Config -> Maybe FilePath -> IO _
+readCoalgebra config Nothing = P.readStdin config
+readCoalgebra config (Just "-" ) = P.readStdin config
+readCoalgebra config (Just file) = P.readFile config file
outputPartition :: Maybe FilePath -> _
outputPartition Nothing = printPartition
@@ -399,14 +391,20 @@ main = do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
let transPolicy = if (refineApplyTransformations r)
- then ApplyTransformations
- else DontApplyTransformations
+ then P.ApplyTransformations
+ else P.DontApplyTransformations
let sanity = if (refineEnableSanity r)
- then EnableSanityChecks
- else DisableSanityChecks
+ then P.EnableSanityChecks
+ else P.DisableSanityChecks
- readCoalgebra (refineFunctor r) transPolicy sanity (refineInputFile r)
+ let parserConfig = P.Config
+ { functorTransforms = transPolicy
+ , sanityChecks = sanity
+ , functor = (refineFunctor r)
+ }
+
+ readCoalgebra parserConfig (refineInputFile r)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate $ res
@@ -460,10 +458,15 @@ main = do
(GraphCommand r) -> do
(f, (symbolTable, encoding)) <- do
let transPolicy = if (graphApplyTransformations r)
- then ApplyTransformations
- else DontApplyTransformations
+ then P.ApplyTransformations
+ else P.DontApplyTransformations
+
+ let parserConfig = P.defaultConfig
+ { P.functorTransforms = transPolicy
+ , P.functor = graphFunctor r
+ }
- readCoalgebra (graphFunctor r) transPolicy EnableSanityChecks (graphInputFile r) >>= \case
+ readCoalgebra parserConfig (graphInputFile r) >>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate $ res
diff --git a/tests/Examples.hs b/tests/Examples.hs
index 19deb67be0f239382aec505dd10e2ece98b15fdd..de13d56f94c988a22e58ff53009a82f41666f1a3 100644
--- a/tests/Examples.hs
+++ b/tests/Examples.hs
@@ -11,7 +11,7 @@ import System.Directory
import Test.Hspec
import Copar.Algorithm
-import Copar.Parser
+import qualified Copar.Parser as P
import Copar.PartitionPrinter
main :: IO ()
@@ -39,7 +39,7 @@ testFile outfile =
-- | FIXME: Run each example twice, once with and once without transformations.
process :: FilePath -> IO String
process file =
- readCoalgebraFromFile Nothing ApplyTransformations EnableSanityChecks file
+ P.readFile P.defaultConfig file
>>= \case
Left err -> return err
Right (f, (symTab, enc)) -> do