module Graphics.Implicit.ExtOpenScad.Eval.Constant (addConstants, runExpr) where
import Prelude (String, IO, ($), pure, (+), Either, Bool(False), (.), either, (<$>), (<*), (<*>))
import Data.Foldable (traverse_, foldlM)
import Graphics.Implicit.Definitions (Fastℕ)
import Graphics.Implicit.ExtOpenScad.Definitions (
Pattern,
Expr,
VarLookup,
Message(Message),
MessageType(SyntaxError),
StateC,
ScadOpts(ScadOpts),
CompState(CompState, scadVars),
SourcePosition(SourcePosition),
OVal(OUndefined),
varUnion, runImplicitCadM
)
import Graphics.Implicit.ExtOpenScad.Util.StateC (modifyVarLookup, addMessage)
import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0)
import Graphics.Implicit.ExtOpenScad.Eval.Expr (evalExpr, matchPat, rawRunExpr)
import Graphics.Implicit.ExtOpenScad.Default (defaultObjects)
import Control.Monad ((>>=))
import Control.Monad.IO.Class (liftIO)
import System.Directory (getCurrentDirectory)
import Text.Parsec (SourceName, parse, ParseError)
import Text.Parsec.Error (errorMessages, showErrorMessages)
import Data.Text.Lazy (pack)
import Graphics.Implicit.ExtOpenScad.Parser.Util (patternMatcher)
import Graphics.Implicit.ExtOpenScad.Parser.Lexer (matchTok)
addConstants :: [String] -> Bool -> IO (VarLookup, [Message])
addConstants :: [[Char]] -> Bool -> IO (VarLookup, [Message])
addConstants [[Char]]
constants Bool
withCSG = do
[Char]
path <- IO [Char]
getCurrentDirectory
let initState :: CompState
initState = VarLookup -> [OVal] -> [Char] -> CompState
CompState (Bool -> VarLookup
defaultObjects Bool
withCSG) [] [Char]
path
(Fastℕ
_, [Message]
messages, CompState
s) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) r s w a.
Monad m =>
r -> s -> ImplicitCadM r w s m a -> m (a, w, s)
runImplicitCadM ScadOpts
opts CompState
initState forall a b. (a -> b) -> a -> b
$ [[Char]] -> StateC Fastℕ
execAssignments [[Char]]
constants
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompState -> VarLookup
scadVars CompState
s, [Message]
messages)
where
opts :: ScadOpts
opts = Bool -> Bool -> ScadOpts
ScadOpts Bool
False Bool
False
show' :: ParseError -> [Char]
show' = [Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
showErrorMessages [Char]
"or" [Char]
"unknown parse error" [Char]
"expecting" [Char]
"unexpected" [Char]
"end of input" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
execAssignments :: [String] -> StateC Fastℕ
execAssignments :: [[Char]] -> StateC Fastℕ
execAssignments = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Fastℕ -> [Char] -> StateC Fastℕ
execAssignment Fastℕ
0
execAssignment :: Fastℕ -> String -> StateC Fastℕ
execAssignment :: Fastℕ -> [Char] -> StateC Fastℕ
execAssignment Fastℕ
count [Char]
assignment = do
let pos :: SourcePosition
pos = Fastℕ -> Fastℕ -> [Char] -> SourcePosition
SourcePosition Fastℕ
count Fastℕ
1 [Char]
"cmdline_constants"
err :: ParseError -> StateC ()
err = MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
SyntaxError SourcePosition
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
show'
run :: (Pattern, Expr) -> StateC ()
run (Pattern
k, Expr
e) = SourcePosition -> Expr -> StateC OVal
evalExpr SourcePosition
pos Expr
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((VarLookup -> VarLookup) -> StateC ()
modifyVarLookup forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarLookup -> VarLookup -> VarLookup
varUnion) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> OVal -> Maybe VarLookup
matchPat Pattern
k
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> StateC ()
err (Pattern, Expr) -> StateC ()
run forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Either ParseError (Pattern, Expr)
parseAssignment [Char]
"cmdline_constant" [Char]
assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Fastℕ
count forall a. Num a => a -> a -> a
+ Fastℕ
1
parseAssignment :: SourceName -> String -> Either ParseError (Pattern, Expr)
parseAssignment :: [Char] -> [Char] -> Either ParseError (Pattern, Expr)
parseAssignment = forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse forall a b. (a -> b) -> a -> b
$ (,) 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
runExpr :: String -> Bool -> (OVal, [Message])
runExpr :: [Char] -> Bool -> (OVal, [Message])
runExpr [Char]
expression Bool
withCSG = do
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> (OVal, [Message])
oUndefined Expr -> (OVal, [Message])
run forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse forall st. GenParser Char st Expr
expr0 [Char]
"raw_expression" [Char]
expression
where
run :: Expr -> (OVal, [Message])
run = SourcePosition -> VarLookup -> Expr -> (OVal, [Message])
rawRunExpr SourcePosition
initPos (Bool -> VarLookup
defaultObjects Bool
withCSG)
initPos :: SourcePosition
initPos = Fastℕ -> Fastℕ -> [Char] -> SourcePosition
SourcePosition Fastℕ
1 Fastℕ
1 [Char]
"raw_expression"
show' :: ParseError -> [Char]
show' = [Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
showErrorMessages [Char]
"or" [Char]
"unknown parse error" [Char]
"expecting" [Char]
"unexpected" [Char]
"end of input" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
oUndefined :: ParseError -> (OVal, [Message])
oUndefined ParseError
e = (OVal
OUndefined, [MessageType -> SourcePosition -> Text -> Message
Message MessageType
SyntaxError SourcePosition
initPos forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
show' ParseError
e])