module ReadSolidExpressionExample ( readSolidExpressionExample ) where import qualified Waterfall.Solids as Solids import qualified Waterfall.Booleans as Booleans import qualified Waterfall.IO import Control.Applicative (liftA2) import Text.Parsec import Control.Monad.Combinators.Expr type Parser a = Parsec String () a atomParser :: Parser (IO Solids.Solid) atomParser :: Parser (IO Solid) atomParser = let filenameParser :: ParsecT String u Identity String filenameParser = Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '{' ParsecT String u Identity Char -> ParsecT String u Identity String -> ParsecT String u Identity String forall a b. ParsecT String u Identity a -> ParsecT String u Identity b -> ParsecT String u Identity b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (ParsecT String u Identity Char -> ParsecT String u Identity Char -> ParsecT String u Identity String forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char anyChar (ParsecT String u Identity Char -> ParsecT String u Identity Char forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a try (ParsecT String u Identity Char -> ParsecT String u Identity Char) -> ParsecT String u Identity Char -> ParsecT String u Identity Char forall a b. (a -> b) -> a -> b $ Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '}')) ParsecT String u Identity String -> String -> ParsecT String u Identity String forall s u (m :: * -> *) a. ParsecT s u m a -> String -> ParsecT s u m a <?> String "filename" in String -> IO Solid Waterfall.IO.readSolid (String -> IO Solid) -> ParsecT String () Identity String -> Parser (IO Solid) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT String () Identity String forall {u}. ParsecT String u Identity String filenameParser termParser :: Parser (IO Solids.Solid) termParser :: Parser (IO Solid) termParser = let brackets :: ParsecT String u Identity a -> ParsecT String u Identity a brackets = ParsecT String u Identity Char -> ParsecT String u Identity Char -> ParsecT String u Identity a -> ParsecT String u Identity a forall s (m :: * -> *) t u open close a. Stream s m t => ParsecT s u m open -> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a between (Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '(') (Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char ')') in Parser (IO Solid) -> Parser (IO Solid) forall {u} {a}. ParsecT String u Identity a -> ParsecT String u Identity a brackets Parser (IO Solid) exprParser Parser (IO Solid) -> Parser (IO Solid) -> Parser (IO Solid) forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a <|> Parser (IO Solid) atomParser Parser (IO Solid) -> String -> Parser (IO Solid) forall s u (m :: * -> *) a. ParsecT s u m a -> String -> ParsecT s u m a <?> String "term" exprParser :: Parser (IO Solids.Solid) exprParser :: Parser (IO Solid) exprParser = let binary :: m b -> (a -> a -> a) -> Operator m a binary m b name a -> a -> a f = m (a -> a -> a) -> Operator m a forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a InfixL (a -> a -> a f (a -> a -> a) -> m b -> m (a -> a -> a) forall a b. a -> m b -> m a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ m b name) table :: [[Operator (ParsecT String u Identity) (IO Solid)]] table = [ [ ParsecT String u Identity Char -> (IO Solid -> IO Solid -> IO Solid) -> Operator (ParsecT String u Identity) (IO Solid) forall {m :: * -> *} {b} {a}. Functor m => m b -> (a -> a -> a) -> Operator m a binary (Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '*') ((Solid -> Solid -> Solid) -> IO Solid -> IO Solid -> IO Solid forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 Solid -> Solid -> Solid Booleans.intersection)] , [ ParsecT String u Identity Char -> (IO Solid -> IO Solid -> IO Solid) -> Operator (ParsecT String u Identity) (IO Solid) forall {m :: * -> *} {b} {a}. Functor m => m b -> (a -> a -> a) -> Operator m a binary (Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '+') ((Solid -> Solid -> Solid) -> IO Solid -> IO Solid -> IO Solid forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 Solid -> Solid -> Solid Booleans.union) , ParsecT String u Identity Char -> (IO Solid -> IO Solid -> IO Solid) -> Operator (ParsecT String u Identity) (IO Solid) forall {m :: * -> *} {b} {a}. Functor m => m b -> (a -> a -> a) -> Operator m a binary (Char -> ParsecT String u Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '-') ((Solid -> Solid -> Solid) -> IO Solid -> IO Solid -> IO Solid forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 Solid -> Solid -> Solid Booleans.difference) ] ] in Parser (IO Solid) -> [[Operator (ParsecT String () Identity) (IO Solid)]] -> Parser (IO Solid) forall (m :: * -> *) a. MonadPlus m => m a -> [[Operator m a]] -> m a makeExprParser Parser (IO Solid) termParser [[Operator (ParsecT String () Identity) (IO Solid)]] forall {u}. [[Operator (ParsecT String u Identity) (IO Solid)]] table readSolidExpressionExample :: String -> IO Solids.Solid readSolidExpressionExample :: String -> IO Solid readSolidExpressionExample String expression = case Parser (IO Solid) -> () -> String -> String -> Either ParseError (IO Solid) forall s t u a. Stream s Identity t => Parsec s u a -> u -> String -> s -> Either ParseError a runParser Parser (IO Solid) exprParser () String "expression" String expression of Left ParseError err -> do ParseError -> IO () forall a. Show a => a -> IO () print ParseError err String -> IO Solid forall a. String -> IO a forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Error when parsing expression" Right IO Solid action -> IO Solid action