Commit b5ababb8 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Refactor and document Copar.Parser module

parent d448a4cf
......@@ -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.
......
{-# 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
......@@ -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
......
......@@ -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
......
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