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, messages), StatementI)
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 Control.Monad.State.Lazy (runStateT)
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 :: ParseError
-> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
err ParseError
e = (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
-> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarLookup
initialObjects, [], [], ParseError -> Message
mesg ParseError
e Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: [Message]
initialMessages)
run :: [StatementI] -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
run :: [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
run [StatementI]
sts = ((), CompState)
-> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
rearrange (((), CompState)
-> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]))
-> IO ((), CompState)
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let sts' :: StateT CompState IO ()
sts' = (StatementI -> StateT CompState IO ())
-> [StatementI] -> StateT CompState IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ StatementI -> StateT CompState IO ()
runStatementI [StatementI]
sts
String
path <- IO String
getCurrentDirectory
StateT CompState IO () -> CompState -> IO ((), CompState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT CompState IO ()
sts' (CompState -> IO ((), CompState))
-> CompState -> IO ((), CompState)
forall a b. (a -> b) -> a -> b
$ VarLookup -> [OVal] -> String -> [Message] -> ScadOpts -> CompState
CompState VarLookup
initialObjects [] String
path [Message]
initialMessages ScadOpts
scadOpts
(ParseError
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]))
-> ([StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]))
-> Either ParseError [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
forall (f :: * -> *).
Applicative f =>
ParseError
-> f (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
err [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
run (Either ParseError [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]))
-> Either ParseError [StatementI]
-> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
forall a b. (a -> b) -> a -> b
$ String -> String -> Either ParseError [StatementI]
parseProgram String
"" String
source
where
rearrange :: ((), CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
rearrange :: ((), CompState)
-> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
rearrange (()
_, CompState
s) =
let ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
_) = [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs ([OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal]))
-> [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
forall a b. (a -> b) -> a -> b
$ CompState -> [OVal]
oVals CompState
s
in (CompState -> VarLookup
scadVars CompState
s, [SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, CompState -> [Message]
messages CompState
s)
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
mesg :: ParseError -> Message
mesg ParseError
e = MessageType -> SourcePosition -> Text -> Message
Message MessageType
SyntaxError (SourcePos -> SourcePosition
sourcePosition (SourcePos -> SourcePosition) -> SourcePos -> SourcePosition
forall a b. (a -> b) -> a -> b
$ ParseError -> SourcePos
errorPos ParseError
e) (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