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)
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