{- 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, messages),
                                                  SourcePosition(SourcePosition),
                                                  OVal(OUndefined),
                                                  varUnion
                                                 )

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.State (liftIO, runStateT, (>>=))

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 :: [String] -> Bool -> IO (VarLookup, [Message])
addConstants [String]
constants Bool
withCSG = do
  String
path <- IO String
getCurrentDirectory
  (Fastℕ
_, CompState
s) <- IO (Fastℕ, CompState) -> IO (Fastℕ, CompState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fastℕ, CompState) -> IO (Fastℕ, CompState))
-> (CompState -> IO (Fastℕ, CompState))
-> CompState
-> IO (Fastℕ, CompState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT CompState IO Fastℕ -> CompState -> IO (Fastℕ, CompState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([String] -> StateT CompState IO Fastℕ
execAssignments [String]
constants) (CompState -> IO (Fastℕ, CompState))
-> CompState -> IO (Fastℕ, CompState)
forall a b. (a -> b) -> a -> b
$ VarLookup -> [OVal] -> String -> [Message] -> ScadOpts -> CompState
CompState (Bool -> VarLookup
defaultObjects Bool
withCSG) [] String
path [] ScadOpts
opts
  (VarLookup, [Message]) -> IO (VarLookup, [Message])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompState -> VarLookup
scadVars CompState
s, CompState -> [Message]
messages CompState
s)
  where
    opts :: ScadOpts
opts = Bool -> Bool -> ScadOpts
ScadOpts Bool
False Bool
False
    show' :: ParseError -> String
show' = String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input" ([Message] -> String)
-> (ParseError -> [Message]) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
    execAssignments :: [String] -> StateC Fastℕ
    execAssignments :: [String] -> StateT CompState IO Fastℕ
execAssignments = (Fastℕ -> String -> StateT CompState IO Fastℕ)
-> Fastℕ -> [String] -> StateT CompState IO Fastℕ
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Fastℕ -> String -> StateT CompState IO Fastℕ
execAssignment Fastℕ
0
    execAssignment :: Fastℕ -> String -> StateC Fastℕ
    execAssignment :: Fastℕ -> String -> StateT CompState IO Fastℕ
execAssignment Fastℕ
count String
assignment = do
      let pos :: SourcePosition
pos = Fastℕ -> Fastℕ -> String -> SourcePosition
SourcePosition Fastℕ
count Fastℕ
1 String
"cmdline_constants"
          err :: ParseError -> StateC ()
err = MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
SyntaxError SourcePosition
pos (Text -> StateC ())
-> (ParseError -> Text) -> ParseError -> StateC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (ParseError -> String) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
show'
          run :: (Pattern, Expr) -> StateC ()
run (Pattern
k, Expr
e) = SourcePosition -> Expr -> StateC OVal
evalExpr SourcePosition
pos Expr
e StateC OVal -> (OVal -> StateC ()) -> StateC ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (VarLookup -> StateC ()) -> Maybe VarLookup -> StateC ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((VarLookup -> VarLookup) -> StateC ()
modifyVarLookup ((VarLookup -> VarLookup) -> StateC ())
-> (VarLookup -> VarLookup -> VarLookup) -> VarLookup -> StateC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarLookup -> VarLookup -> VarLookup
varUnion) (Maybe VarLookup -> StateC ())
-> (OVal -> Maybe VarLookup) -> OVal -> StateC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> OVal -> Maybe VarLookup
matchPat Pattern
k
      (ParseError -> StateC ())
-> ((Pattern, Expr) -> StateC ())
-> Either ParseError (Pattern, Expr)
-> StateC ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> StateC ()
err (Pattern, Expr) -> StateC ()
run (Either ParseError (Pattern, Expr) -> StateC ())
-> Either ParseError (Pattern, Expr) -> StateC ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Either ParseError (Pattern, Expr)
parseAssignment String
"cmdline_constant" String
assignment
      Fastℕ -> StateT CompState IO Fastℕ
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fastℕ -> StateT CompState IO Fastℕ)
-> Fastℕ -> StateT CompState IO Fastℕ
forall a b. (a -> b) -> a -> b
$ Fastℕ
count Fastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
+ Fastℕ
1
    parseAssignment :: SourceName -> String -> Either ParseError (Pattern, Expr)
    parseAssignment :: String -> String -> Either ParseError (Pattern, Expr)
parseAssignment = Parsec String () (Pattern, Expr)
-> String -> String -> Either ParseError (Pattern, Expr)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec String () (Pattern, Expr)
 -> String -> String -> Either ParseError (Pattern, Expr))
-> Parsec String () (Pattern, Expr)
-> String
-> String
-> Either ParseError (Pattern, Expr)
forall a b. (a -> b) -> a -> b
$ (,) (Pattern -> Expr -> (Pattern, Expr))
-> ParsecT String () Identity Pattern
-> ParsecT String () Identity (Expr -> (Pattern, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Pattern
forall st. GenParser Char st Pattern
patternMatcher ParsecT String () Identity (Expr -> (Pattern, Expr))
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Expr -> (Pattern, Expr))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' ParsecT String () Identity (Expr -> (Pattern, Expr))
-> ParsecT String () Identity Expr
-> Parsec String () (Pattern, Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Expr
forall st. GenParser Char st Expr
expr0

-- | Evaluate an expression.
runExpr :: String -> Bool -> (OVal, [Message])
runExpr :: String -> Bool -> (OVal, [Message])
runExpr String
expression Bool
withCSG = do
  (ParseError -> (OVal, [Message]))
-> (Expr -> (OVal, [Message]))
-> Either ParseError Expr
-> (OVal, [Message])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> (OVal, [Message])
oUndefined Expr -> (OVal, [Message])
run (Either ParseError Expr -> (OVal, [Message]))
-> Either ParseError Expr -> (OVal, [Message])
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Expr
-> String -> String -> Either ParseError Expr
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse ParsecT String () Identity Expr
forall st. GenParser Char st Expr
expr0 String
"raw_expression" String
expression
    where
      run :: Expr -> (OVal, [Message])
run Expr
expr = SourcePosition -> VarLookup -> Expr -> (OVal, [Message])
rawRunExpr SourcePosition
initPos (Bool -> VarLookup
defaultObjects Bool
withCSG) Expr
expr
      initPos :: SourcePosition
initPos = Fastℕ -> Fastℕ -> String -> SourcePosition
SourcePosition Fastℕ
1 Fastℕ
1 String
"raw_expression"
      show' :: ParseError -> String
show' = String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input" ([Message] -> String)
-> (ParseError -> [Message]) -> ParseError -> String
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 (Text -> Message) -> Text -> Message
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
show' ParseError
e])