{-# LANGUAGE PatternSynonyms #-}
module Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram) where
import Prelude(Char, Either, String, ($), (*>), Bool(False, True), (<$>), (<*>), (.), (<$), flip, fmap, filter, not, pure)
import Data.Maybe(Maybe(Just, Nothing))
import Graphics.Implicit.ExtOpenScad.Definitions (Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)), Expr(LamE), StatementI(StatementI), Symbol(Symbol), SourcePosition)
import qualified Graphics.Implicit.ExtOpenScad.Definitions as GIED (Pattern(Name))
import Graphics.Implicit.ExtOpenScad.Parser.Util ((*<|>), patternMatcher, sourcePosition)
import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0)
import Graphics.Implicit.ExtOpenScad.Parser.Lexer (whiteSpace, matchFunction, matchInclude, matchUse, matchIf, matchElse, matchModule, matchTok, matchComma, matchSemi, surroundedBy, matchIdentifier)
import Text.Parsec (SourceName, (<?>), sepBy, oneOf, getPosition, parse, eof, ParseError, many, noneOf, option, between, char, optionMaybe)
import Text.Parsec.String (GenParser)
import Control.Applicative ((<*), (<|>))
import Data.Functor (($>))
import Data.Text.Lazy (Text, pack)
pattern Name :: Text -> GIED.Pattern
pattern $bName :: Text -> Pattern
$mName :: forall {r}. Pattern -> (Text -> r) -> ((# #) -> r) -> r
Name n = GIED.Name (Symbol n)
data CompIdx = A1 | A2
parseProgram :: SourceName -> String -> Either ParseError [StatementI]
parseProgram :: String -> String -> Either ParseError [StatementI]
parseProgram = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse forall st. GenParser Char st [StatementI]
program where
program :: GenParser Char st [StatementI]
program :: forall st. GenParser Char st [StatementI]
program = [StatementI] -> [StatementI]
removeNoOps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st. GenParser Char st ()
whiteSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
computation :: CompIdx -> GenParser Char st StatementI
computation :: forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1 =
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A2
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall st. GenParser Char st StatementI
throwAway
computation CompIdx
A2 =
forall st. GenParser Char st StatementI
userModule
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall st. GenParser Char st StatementI
ifStatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall st. GenParser Char st StatementI
userModuleDeclaration
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
( forall st. GenParser Char st StatementI
include
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall st. GenParser Char st StatementI
function
) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall st. GenParser Char st Text
matchSemi
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
forall st. GenParser Char st StatementI
assignment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall st. GenParser Char st Text
matchSemi
{-# ANN suite "HLint: ignore Functor law" #-}
suite :: GenParser Char st [StatementI]
suite :: forall st. GenParser Char st [StatementI]
suite = (
[StatementI] -> [StatementI]
removeNoOps forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
[StatementI] -> [StatementI]
removeNoOps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'{' (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1)) Char
'}'
) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"suite"
statementI :: GenParser Char st (Statement StatementI) -> GenParser Char st StatementI
statementI :: forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
p = SourcePosition -> Statement StatementI -> StatementI
StatementI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st SourcePosition
sourcePos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenParser Char st (Statement StatementI)
p
throwAway :: GenParser Char st StatementI
throwAway :: forall st. GenParser Char st StatementI
throwAway = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall a b. (a -> b) -> a -> b
$ forall st. Statement st
DoNothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"%*" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall st. GenParser Char st ()
whiteSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A2
include :: GenParser Char st StatementI
include :: forall st. GenParser Char st StatementI
include = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"include/use"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall st. Text -> Bool -> Statement st
Include
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st. GenParser Char st ()
matchInclude forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall st. GenParser Char st ()
matchUse forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<') (forall st. Char -> GenParser Char st Char
matchTok Char
'>') (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"<> "))
assignment :: GenParser Char st StatementI
assignment :: forall st. GenParser Char st StatementI
assignment = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"assignment"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall st. Pattern -> Expr -> Statement st
(:=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st Pattern
patternMatcher forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall st. Char -> GenParser Char st Char
matchTok Char
'=' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st Expr
expr0
function :: GenParser Char st StatementI
function :: forall st. GenParser Char st StatementI
function = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"function"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall st. Pattern -> Expr -> Statement st
(:=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st Pattern
lval forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st Expr
rval
lval :: GenParser Char st GIED.Pattern
lval :: forall st. GenParser Char st Pattern
lval = Text -> Pattern
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st. GenParser Char st ()
matchFunction forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st String
matchIdentifier)
rval :: GenParser Char st Expr
rval :: forall st. GenParser Char st Expr
rval = [Pattern] -> Expr -> Expr
LamE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy forall st. GenParser Char st Pattern
patternMatcher forall st. GenParser Char st Text
matchComma) Char
')' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall st. Char -> GenParser Char st Char
matchTok Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st Expr
expr0)
ifStatementI :: GenParser Char st StatementI
ifStatementI :: forall st. GenParser Char st StatementI
ifStatementI = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"if"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall st. Expr -> [st] -> [st] -> Statement st
If forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st. GenParser Char st ()
matchIf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' forall st. GenParser Char st Expr
expr0 Char
')') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st [StatementI]
suite forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (forall st. GenParser Char st ()
matchElse forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st [StatementI]
suite)
userModule :: GenParser Char st StatementI
userModule :: forall st. GenParser Char st StatementI
userModule = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"module call"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall st. Symbol -> [(Maybe Symbol, Expr)] -> [st] -> Statement st
ModuleCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Symbol
Symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall st. GenParser Char st String
matchIdentifier forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall st. GenParser Char st [StatementI]
suite forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> (forall st. GenParser Char st Text
matchSemi forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))
userModuleDeclaration :: GenParser Char st StatementI
userModuleDeclaration :: forall st. GenParser Char st StatementI
userModuleDeclaration = forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI forall st. GenParser Char st (Statement StatementI)
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"module declaration"
where
p :: GenParser Char st (Statement StatementI)
p :: forall st. GenParser Char st (Statement StatementI)
p = forall st. Symbol -> [(Symbol, Maybe Expr)] -> [st] -> Statement st
NewModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Symbol
Symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (forall st. GenParser Char st ()
matchModule forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st String
matchIdentifier) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st. GenParser Char st [StatementI]
suite
moduleArgsUnit :: GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit :: forall st. GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit =
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'('
(forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (
do
String
symb <- forall st. GenParser Char st String
matchIdentifier
Expr
expr <- forall st. Char -> GenParser Char st Char
matchTok Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st Expr
expr0
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Text -> Symbol
Symbol forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
symb), Expr
expr)
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> do
String
symb <- forall st. GenParser Char st String
matchIdentifier
[String]
argVars <- forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy forall st. GenParser Char st String
matchIdentifier forall st. GenParser Char st Text
matchComma) Char
')'
Expr
expr <- forall st. Char -> GenParser Char st Char
matchTok Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st Expr
expr0
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Text -> Symbol
Symbol forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
symb), [Pattern] -> Expr -> Expr
LamE (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pattern
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) [String]
argVars) Expr
expr)
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> do
Expr
expr <- forall st. GenParser Char st Expr
expr0
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, Expr
expr)
) forall st. GenParser Char st Text
matchComma)
Char
')'
moduleArgsUnitDecl :: GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl :: forall st. GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl =
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'('
(forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (
do
String
symb <- forall st. GenParser Char st String
matchIdentifier
Maybe Expr
expr <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall st. Char -> GenParser Char st Char
matchTok Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall st. GenParser Char st Expr
expr0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Symbol
Symbol forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
symb, Maybe Expr
expr)
) forall st. GenParser Char st Text
matchComma)
Char
')'
sourcePos :: GenParser Char st SourcePosition
sourcePos :: forall st. GenParser Char st SourcePosition
sourcePos = SourcePos -> SourcePosition
sourcePosition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
isNoOp :: StatementI -> Bool
isNoOp :: StatementI -> Bool
isNoOp (StatementI SourcePosition
_ Statement StatementI
DoNothing) = Bool
True
isNoOp StatementI
_ = Bool
False
removeNoOps :: [StatementI] -> [StatementI]
removeNoOps :: [StatementI] -> [StatementI]
removeNoOps = forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatementI -> Bool
isNoOp