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