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

-- An executor, which parses openscad code, and executes it.
module Graphics.Implicit.ExtOpenScad (runOpenscad) where

import Prelude(String, IO, ($), (<$>), pure, either, (.), Applicative, Bool(True))

import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3)

import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, ScadOpts, Message(Message), MessageType(SyntaxError), CompState(CompState, scadVars, oVals), StatementI, runImplicitCadM)

import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram)

import Graphics.Implicit.ExtOpenScad.Parser.Util (sourcePosition)

import Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI)

import Graphics.Implicit.ExtOpenScad.Eval.Constant (addConstants)

import Graphics.Implicit.ExtOpenScad.Util.OVal (divideObjs)

import Text.Parsec.Error (errorPos, errorMessages, showErrorMessages, ParseError)

import System.Directory (getCurrentDirectory)

import Data.Foldable (traverse_)

import Data.Text.Lazy (pack)

-- | Small wrapper of our parser to handle parse errors, etc.
runOpenscad :: ScadOpts -> [String] -> String -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
runOpenscad :: ScadOpts
-> [String]
-> String
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
runOpenscad ScadOpts
scadOpts [String]
constants String
source = do
  (VarLookup
initialObjects, [Message]
initialMessages) <- [String] -> Bool -> IO (VarLookup, [Message])
addConstants [String]
constants Bool
True
  let
    err :: Applicative f => ParseError -> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
    err :: forall (f :: * -> *).
Applicative f =>
ParseError
-> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
err ParseError
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarLookup
initialObjects, [], [], ParseError -> Message
mesg ParseError
e forall a. a -> [a] -> [a]
: [Message]
initialMessages)
    run :: [StatementI] -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
    run :: [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
run [StatementI]
sts = ([Message], CompState)
-> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
rearrange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let sts' :: ImplicitCadM ScadOpts [Message] CompState IO ()
sts' = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ StatementI -> ImplicitCadM ScadOpts [Message] CompState IO ()
runStatementI [StatementI]
sts
      String
path <- IO String
getCurrentDirectory
      let initState :: CompState
initState = VarLookup -> [OVal] -> String -> CompState
CompState VarLookup
initialObjects [] String
path
      (()
_, [Message]
w, CompState
s') <- forall (m :: * -> *) r s w a.
Monad m =>
r -> s -> ImplicitCadM r w s m a -> m (a, w, s)
runImplicitCadM ScadOpts
scadOpts CompState
initState ImplicitCadM ScadOpts [Message] CompState IO ()
sts'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Message]
w, CompState
s')

  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *).
Applicative f =>
ParseError
-> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
err [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
run forall a b. (a -> b) -> a -> b
$ String -> String -> Either ParseError [StatementI]
parseProgram String
"" String
source
  where
    rearrange :: ([Message], CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
    rearrange :: ([Message], CompState)
-> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
rearrange ([Message]
messages,  CompState
s) =
      let ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
_) = [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs forall a b. (a -> b) -> a -> b
$ CompState -> [OVal]
oVals CompState
s
      in (CompState -> VarLookup
scadVars CompState
s, [SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [Message]
messages)
    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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
    mesg :: ParseError -> Message
mesg ParseError
e = MessageType -> SourcePosition -> Text -> Message
Message MessageType
SyntaxError (SourcePos -> SourcePosition
sourcePosition forall a b. (a -> b) -> a -> b
$ ParseError -> SourcePos
errorPos ParseError
e) forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ ParseError -> String
show' ParseError
e