{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

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)

-- | Define variables used during the extOpenScad run.
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

-- | Evaluate an expression.
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])