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