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

-- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE DeriveFunctor #-}

module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFail, APExample),
                                                  Symbol(Symbol),
                                                  Pattern(Wild, Name, ListP),
                                                  Expr(LitE, Var, ListE, LamE, (:$)),
                                                  StatementI(StatementI),
                                                  Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)),
                                                  OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3),
                                                  TestInvariant(EulerCharacteristic),
                                                  SourcePosition(SourcePosition),
                                                  StateC,
                                                  CompState(CompState, scadVars, oVals, sourceDir, messages, scadOpts),
                                                  VarLookup(VarLookup),
                                                  Message(Message),
                                                  MessageType(TextOut, Warning, Error, SyntaxError, Compatibility, Unimplemented),
                                                  ScadOpts(ScadOpts, openScadCompatibility, importsAllowed),
                                                  lookupVarIn,
                                                  varUnion
                                                  ) where

import Prelude(Eq, Show, Ord, Maybe(Just), Bool(True, False), IO, FilePath, (==), show, ($), (<>), and, zipWith, Int, (<$>))

-- Resolution of the world, Integer type, and symbolic languages for 2D and 3D objects.
import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, SymbolicObj2, SymbolicObj3, fromFastℕ)

import Control.Applicative (Applicative, Alternative((<|>), empty), pure, (<*>))

import Control.Monad (Functor, Monad, (>>=), mzero, mplus, MonadPlus, ap, (>=>))

import Data.Default.Class (Default(def))

import Data.Map (Map, lookup, union)

import Data.Maybe (fromMaybe)

import Data.Text.Lazy (Text, unpack, intercalate)

import Control.Monad.State (StateT)

-- | The state of computation.
data CompState = CompState
  { CompState -> VarLookup
scadVars  :: VarLookup -- ^ A hash of variables and functions.
  , CompState -> [OVal]
oVals     :: [OVal]    -- ^ The result of geometry generating functions.
  , CompState -> FilePath
sourceDir :: FilePath  -- ^ The path we are looking for includes in.
  , CompState -> [Message]
messages  :: [Message] -- ^ Output strings, warnings, and errors generated during execution.
  , CompState -> ScadOpts
scadOpts  :: ScadOpts  -- ^ Options controlling the execution of scad code.
  } deriving (Int -> CompState -> ShowS
[CompState] -> ShowS
CompState -> FilePath
(Int -> CompState -> ShowS)
-> (CompState -> FilePath)
-> ([CompState] -> ShowS)
-> Show CompState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompState] -> ShowS
$cshowList :: [CompState] -> ShowS
show :: CompState -> FilePath
$cshow :: CompState -> FilePath
showsPrec :: Int -> CompState -> ShowS
$cshowsPrec :: Int -> CompState -> ShowS
Show)

type StateC = StateT CompState IO

-- | Handles parsing arguments to built-in modules
data ArgParser a
                 = AP Symbol (Maybe OVal) Text (OVal -> ArgParser a)
                 -- ^ For actual argument entries: @AP (argument name) (default) (doc) (next Argparser...)@
                 | APTerminator a
                 -- ^ For returns: @APTerminator (return value)@
                 | APFail Text
                 -- ^ For failure: @APFail (error message)@
                 | APExample Text (ArgParser a)
                 -- ^ An example, then next
                 | APTest Text [TestInvariant] (ArgParser a)
                 -- ^ A string to run as a test, then invariants for the results, then next
                 | APBranch [ArgParser a]
                 -- ^ A branch where there are a number of possibilities for the parser underneath
  deriving a -> ArgParser b -> ArgParser a
(a -> b) -> ArgParser a -> ArgParser b
(forall a b. (a -> b) -> ArgParser a -> ArgParser b)
-> (forall a b. a -> ArgParser b -> ArgParser a)
-> Functor ArgParser
forall a b. a -> ArgParser b -> ArgParser a
forall a b. (a -> b) -> ArgParser a -> ArgParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ArgParser b -> ArgParser a
$c<$ :: forall a b. a -> ArgParser b -> ArgParser a
fmap :: (a -> b) -> ArgParser a -> ArgParser b
$cfmap :: forall a b. (a -> b) -> ArgParser a -> ArgParser b
Functor

instance Applicative ArgParser where
    pure :: a -> ArgParser a
pure = a -> ArgParser a
forall a. a -> ArgParser a
APTerminator
    <*> :: ArgParser (a -> b) -> ArgParser a -> ArgParser b
(<*>) = ArgParser (a -> b) -> ArgParser a -> ArgParser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad ArgParser where
    -- We need to describe how (>>=) works.
    -- Let's get the hard ones out of the way first.
    -- ArgParser actually
    (AP Symbol
str Maybe OVal
fallback Text
d OVal -> ArgParser a
f) >>= :: ArgParser a -> (a -> ArgParser b) -> ArgParser b
>>= a -> ArgParser b
g = Symbol
-> Maybe OVal -> Text -> (OVal -> ArgParser b) -> ArgParser b
forall a.
Symbol
-> Maybe OVal -> Text -> (OVal -> ArgParser a) -> ArgParser a
AP Symbol
str Maybe OVal
fallback Text
d (OVal -> ArgParser a
f (OVal -> ArgParser a) -> (a -> ArgParser b) -> OVal -> ArgParser b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> ArgParser b
g)
    (APFail Text
errmsg) >>= a -> ArgParser b
_ = Text -> ArgParser b
forall a. Text -> ArgParser a
APFail Text
errmsg
    -- These next two are easy, they just pass the work along to their child
    (APExample Text
str ArgParser a
child) >>= a -> ArgParser b
g = Text -> ArgParser b -> ArgParser b
forall a. Text -> ArgParser a -> ArgParser a
APExample Text
str (ArgParser a
child ArgParser a -> (a -> ArgParser b) -> ArgParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ArgParser b
g)
    (APTest Text
str [TestInvariant]
tests ArgParser a
child) >>= a -> ArgParser b
g = Text -> [TestInvariant] -> ArgParser b -> ArgParser b
forall a. Text -> [TestInvariant] -> ArgParser a -> ArgParser a
APTest Text
str [TestInvariant]
tests (ArgParser a
child ArgParser a -> (a -> ArgParser b) -> ArgParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ArgParser b
g)
    -- And an ArgParserTerminator happily gives away the value it contains
    (APTerminator a
a) >>= a -> ArgParser b
g = a -> ArgParser b
g a
a
    (APBranch [ArgParser a]
bs) >>= a -> ArgParser b
g = [ArgParser b] -> ArgParser b
forall a. [ArgParser a] -> ArgParser a
APBranch ([ArgParser b] -> ArgParser b) -> [ArgParser b] -> ArgParser b
forall a b. (a -> b) -> a -> b
$ (ArgParser a -> (a -> ArgParser b) -> ArgParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ArgParser b
g) (ArgParser a -> ArgParser b) -> [ArgParser a] -> [ArgParser b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ArgParser a]
bs

instance MonadPlus ArgParser where
    mzero :: ArgParser a
mzero = Text -> ArgParser a
forall a. Text -> ArgParser a
APFail Text
""
    mplus :: ArgParser a -> ArgParser a -> ArgParser a
mplus (APBranch [ArgParser a]
as) (APBranch [ArgParser a]
bs) = [ArgParser a] -> ArgParser a
forall a. [ArgParser a] -> ArgParser a
APBranch ( [ArgParser a]
as  [ArgParser a] -> [ArgParser a] -> [ArgParser a]
forall a. Semigroup a => a -> a -> a
<>  [ArgParser a]
bs )
    mplus (APBranch [ArgParser a]
as) ArgParser a
b             = [ArgParser a] -> ArgParser a
forall a. [ArgParser a] -> ArgParser a
APBranch ( [ArgParser a]
as  [ArgParser a] -> [ArgParser a] -> [ArgParser a]
forall a. Semigroup a => a -> a -> a
<> [ArgParser a
b] )
    mplus ArgParser a
a             (APBranch [ArgParser a]
bs) = [ArgParser a] -> ArgParser a
forall a. [ArgParser a] -> ArgParser a
APBranch ( ArgParser a
a   ArgParser a -> [ArgParser a] -> [ArgParser a]
forall a. a -> [a] -> [a]
:   [ArgParser a]
bs )
    mplus ArgParser a
a             ArgParser a
b             = [ArgParser a] -> ArgParser a
forall a. [ArgParser a] -> ArgParser a
APBranch [ ArgParser a
a   ,   ArgParser a
b  ]

instance Alternative ArgParser where
        <|> :: ArgParser a -> ArgParser a -> ArgParser a
(<|>) = ArgParser a -> ArgParser a -> ArgParser a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
        empty :: ArgParser a
empty = ArgParser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

newtype Symbol = Symbol Text
  deriving (Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> FilePath
(Int -> Symbol -> ShowS)
-> (Symbol -> FilePath) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> FilePath
$cshow :: Symbol -> FilePath
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show, Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Eq Symbol
-> (Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmax :: Symbol -> Symbol -> Symbol
>= :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c< :: Symbol -> Symbol -> Bool
compare :: Symbol -> Symbol -> Ordering
$ccompare :: Symbol -> Symbol -> Ordering
$cp1Ord :: Eq Symbol
Ord)

newtype VarLookup = VarLookup (Map Symbol OVal)
  deriving (Int -> VarLookup -> ShowS
[VarLookup] -> ShowS
VarLookup -> FilePath
(Int -> VarLookup -> ShowS)
-> (VarLookup -> FilePath)
-> ([VarLookup] -> ShowS)
-> Show VarLookup
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [VarLookup] -> ShowS
$cshowList :: [VarLookup] -> ShowS
show :: VarLookup -> FilePath
$cshow :: VarLookup -> FilePath
showsPrec :: Int -> VarLookup -> ShowS
$cshowsPrec :: Int -> VarLookup -> ShowS
Show, VarLookup -> VarLookup -> Bool
(VarLookup -> VarLookup -> Bool)
-> (VarLookup -> VarLookup -> Bool) -> Eq VarLookup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarLookup -> VarLookup -> Bool
$c/= :: VarLookup -> VarLookup -> Bool
== :: VarLookup -> VarLookup -> Bool
$c== :: VarLookup -> VarLookup -> Bool
Eq)

data Pattern = Name Symbol
             | ListP [Pattern]
             | Wild
    deriving (Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> FilePath
(Int -> Pattern -> ShowS)
-> (Pattern -> FilePath) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> FilePath
$cshow :: Pattern -> FilePath
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show, Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq)

-- | An expression.
data Expr = Var Symbol
          | LitE OVal -- A literal value.
          | ListE [Expr] -- A list of expressions.
          | LamE [Pattern] Expr -- A lambda expression.
          | Expr :$ [Expr] -- application of a function.
    deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> FilePath
(Int -> Expr -> ShowS)
-> (Expr -> FilePath) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> FilePath
$cshow :: Expr -> FilePath
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq)

-- | A statement, along with the line, column number, and file it is found at.
data StatementI = StatementI SourcePosition (Statement StatementI)
    deriving (Int -> StatementI -> ShowS
[StatementI] -> ShowS
StatementI -> FilePath
(Int -> StatementI -> ShowS)
-> (StatementI -> FilePath)
-> ([StatementI] -> ShowS)
-> Show StatementI
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StatementI] -> ShowS
$cshowList :: [StatementI] -> ShowS
show :: StatementI -> FilePath
$cshow :: StatementI -> FilePath
showsPrec :: Int -> StatementI -> ShowS
$cshowsPrec :: Int -> StatementI -> ShowS
Show, StatementI -> StatementI -> Bool
(StatementI -> StatementI -> Bool)
-> (StatementI -> StatementI -> Bool) -> Eq StatementI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatementI -> StatementI -> Bool
$c/= :: StatementI -> StatementI -> Bool
== :: StatementI -> StatementI -> Bool
$c== :: StatementI -> StatementI -> Bool
Eq)

data Statement st = Include Text Bool
               | Pattern :=  Expr
               | If Expr [st] [st]
               | NewModule  Symbol [(Symbol, Maybe Expr)] [st]
               | ModuleCall Symbol [(Maybe Symbol, Expr)] [st]
               | DoNothing
    deriving (Int -> Statement st -> ShowS
[Statement st] -> ShowS
Statement st -> FilePath
(Int -> Statement st -> ShowS)
-> (Statement st -> FilePath)
-> ([Statement st] -> ShowS)
-> Show (Statement st)
forall st. Show st => Int -> Statement st -> ShowS
forall st. Show st => [Statement st] -> ShowS
forall st. Show st => Statement st -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Statement st] -> ShowS
$cshowList :: forall st. Show st => [Statement st] -> ShowS
show :: Statement st -> FilePath
$cshow :: forall st. Show st => Statement st -> FilePath
showsPrec :: Int -> Statement st -> ShowS
$cshowsPrec :: forall st. Show st => Int -> Statement st -> ShowS
Show, Statement st -> Statement st -> Bool
(Statement st -> Statement st -> Bool)
-> (Statement st -> Statement st -> Bool) -> Eq (Statement st)
forall st. Eq st => Statement st -> Statement st -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement st -> Statement st -> Bool
$c/= :: forall st. Eq st => Statement st -> Statement st -> Bool
== :: Statement st -> Statement st -> Bool
$c== :: forall st. Eq st => Statement st -> Statement st -> Bool
Eq)

-- | Objects for our OpenSCAD-like language
data OVal = OUndefined
         | OError Text
         | OBool Bool
         | ONum ℝ
         | OList [OVal]
         | OString Text
         | OFunc (OVal -> OVal)
         -- Name, arguments, argument parsers.
         | OUModule Symbol (Maybe [(Symbol, Bool)]) (VarLookup -> ArgParser (StateC [OVal]))
         -- Name, implementation, arguments, whether the module accepts/requires a suite.
         | ONModule Symbol (SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) [([(Symbol, Bool)],  Maybe Bool)]
         | OVargsModule Symbol (Symbol -> SourcePosition -> [(Maybe Symbol, OVal)] -> [StatementI] -> ([StatementI] -> StateC ()) -> StateC ())
         | OObj3 SymbolicObj3
         | OObj2 SymbolicObj2

instance Eq OVal where
    (OBool Bool
a) == :: OVal -> OVal -> Bool
== (OBool Bool
b) = Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b
    (ONum  ℝ
a) == (ONum  ℝ
b) = ℝ
a ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
b
    (OList [OVal]
a) == (OList [OVal]
b) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (OVal -> OVal -> Bool) -> [OVal] -> [OVal] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OVal -> OVal -> Bool
forall a. Eq a => a -> a -> Bool
(==) [OVal]
a [OVal]
b
    (OString Text
a) == (OString Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
    OVal
OUndefined == OVal
OUndefined = Bool
True
    OVal
_ == OVal
_ = Bool
False

instance Show OVal where
    show :: OVal -> FilePath
show OVal
OUndefined = FilePath
"Undefined"
    show (OBool Bool
b) = Bool -> FilePath
forall a. Show a => a -> FilePath
show Bool
b
    show (ONum ℝ
n) = ℝ -> FilePath
forall a. Show a => a -> FilePath
show ℝ
n
    show (OList [OVal]
l) = [OVal] -> FilePath
forall a. Show a => a -> FilePath
show [OVal]
l
    show (OString Text
s) = Text -> FilePath
forall a. Show a => a -> FilePath
show Text
s
    show (OFunc OVal -> OVal
_) = FilePath
"<function>"
    show (OUModule (Symbol Text
name) Maybe [(Symbol, Bool)]
arguments VarLookup -> ArgParser (StateC [OVal])
_) = FilePath
"module " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
name FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" (" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack (Text -> [Text] -> Text
intercalate Text
", " ((Symbol, Bool) -> Text
showArg ((Symbol, Bool) -> Text) -> [(Symbol, Bool)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, Bool)] -> Maybe [(Symbol, Bool)] -> [(Symbol, Bool)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(Symbol, Bool)]
arguments)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
") {}"
      where
        showArg :: (Symbol, Bool) -> Text
        showArg :: (Symbol, Bool) -> Text
showArg (Symbol Text
a, Bool
hasDefault) = if Bool
hasDefault
                                         then Text
a
                                         else Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=..."
    show (ONModule (Symbol Text
name) SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
_ [([(Symbol, Bool)], Maybe Bool)]
instances) = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [([(Symbol, Bool)], Maybe Bool)] -> Text
showInstances [([(Symbol, Bool)], Maybe Bool)]
instances
      where
        showArg :: (Symbol, Bool) -> Text
showArg (Symbol Text
a, Bool
hasDefault) = if Bool
hasDefault
                                         then Text
a
                                         else Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=..."
        showInstances :: [([(Symbol, Bool)], Maybe Bool)] -> Text
        showInstances :: [([(Symbol, Bool)], Maybe Bool)] -> Text
showInstances [] = Text
""
        showInstances [([(Symbol, Bool)], Maybe Bool)
oneInstance] = Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([(Symbol, Bool)], Maybe Bool) -> Text
showInstance ([(Symbol, Bool)], Maybe Bool)
oneInstance
        showInstances [([(Symbol, Bool)], Maybe Bool)]
multipleInstances = Text
"Module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (([(Symbol, Bool)], Maybe Bool) -> Text
showInstance (([(Symbol, Bool)], Maybe Bool) -> Text)
-> [([(Symbol, Bool)], Maybe Bool)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(Symbol, Bool)], Maybe Bool)]
multipleInstances) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ]"
        showInstance :: ([(Symbol, Bool)], Maybe Bool) -> Text
        showInstance :: ([(Symbol, Bool)], Maybe Bool) -> Text
showInstance ([(Symbol, Bool)]
arguments, Maybe Bool
suiteInfo) = Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((Symbol, Bool) -> Text
showArg ((Symbol, Bool) -> Text) -> [(Symbol, Bool)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, Bool)]
arguments) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") {}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> Text
showSuiteInfo Maybe Bool
suiteInfo
        showSuiteInfo :: Maybe Bool -> Text
        showSuiteInfo :: Maybe Bool -> Text
showSuiteInfo Maybe Bool
suiteInfo = case Maybe Bool
suiteInfo of
                          Just Bool
requiresSuite -> if Bool
requiresSuite
                                                then Text
" requiring suite {}"
                                                else Text
" accepting suite {}"
                          Maybe Bool
_ -> Text
""
    show (OVargsModule (Symbol Text
name) Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
_) = FilePath
"varargs module " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
name
    show (OError Text
msg) = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Execution Error:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    show (OObj2 SymbolicObj2
obj) = FilePath
"<obj2: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SymbolicObj2 -> FilePath
forall a. Show a => a -> FilePath
show SymbolicObj2
obj FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
">"
    show (OObj3 SymbolicObj3
obj) = FilePath
"<obj3: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SymbolicObj3 -> FilePath
forall a. Show a => a -> FilePath
show SymbolicObj3
obj FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
">"

-- | In order to not propagate Parsec or other modules around, create our own source position type for the AST.
data SourcePosition = SourcePosition
    Fastℕ -- sourceLine
    Fastℕ -- sourceColumn
    FilePath -- sourceName
    deriving (SourcePosition -> SourcePosition -> Bool
(SourcePosition -> SourcePosition -> Bool)
-> (SourcePosition -> SourcePosition -> Bool) -> Eq SourcePosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePosition -> SourcePosition -> Bool
$c/= :: SourcePosition -> SourcePosition -> Bool
== :: SourcePosition -> SourcePosition -> Bool
$c== :: SourcePosition -> SourcePosition -> Bool
Eq)

instance Show SourcePosition where
    show :: SourcePosition -> FilePath
show (SourcePosition Fastℕ
line Fastℕ
col []) = FilePath
"line " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (Fastℕ -> Int
forall n. FastN n => Fastℕ -> n
fromFastℕ Fastℕ
line :: Int) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", column " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (Fastℕ -> Int
forall n. FastN n => Fastℕ -> n
fromFastℕ Fastℕ
col :: Int)
    show (SourcePosition Fastℕ
line Fastℕ
col FilePath
filePath) = FilePath
"line " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (Fastℕ -> Int
forall n. FastN n => Fastℕ -> n
fromFastℕ Fastℕ
line :: Int) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", column " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (Fastℕ -> Int
forall n. FastN n => Fastℕ -> n
fromFastℕ Fastℕ
col :: Int) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", file " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
filePath

-- | The types of messages the execution engine can send back to the application.
data MessageType = TextOut -- text intentionally output by the ExtOpenScad program.
                 | Warning
                 | Error
                 | SyntaxError
                 | Compatibility
                 | Unimplemented
  deriving (Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> FilePath
(Int -> MessageType -> ShowS)
-> (MessageType -> FilePath)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MessageType] -> ShowS
$cshowList :: [MessageType] -> ShowS
show :: MessageType -> FilePath
$cshow :: MessageType -> FilePath
showsPrec :: Int -> MessageType -> ShowS
$cshowsPrec :: Int -> MessageType -> ShowS
Show, MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c== :: MessageType -> MessageType -> Bool
Eq)

-- | An individual message.
data Message = Message MessageType SourcePosition Text
  deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)

instance Show Message where
  show :: Message -> FilePath
show (Message MessageType
mtype SourcePosition
pos Text
text) = MessageType -> FilePath
forall a. Show a => a -> FilePath
show MessageType
mtype FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" at " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SourcePosition -> FilePath
forall a. Show a => a -> FilePath
show SourcePosition
pos FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
text

-- | Options changing the behavior of the extended OpenScad engine.
data ScadOpts = ScadOpts
  { ScadOpts -> Bool
openScadCompatibility :: Bool
  , ScadOpts -> Bool
importsAllowed        :: Bool
  } deriving (Int -> ScadOpts -> ShowS
[ScadOpts] -> ShowS
ScadOpts -> FilePath
(Int -> ScadOpts -> ShowS)
-> (ScadOpts -> FilePath) -> ([ScadOpts] -> ShowS) -> Show ScadOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScadOpts] -> ShowS
$cshowList :: [ScadOpts] -> ShowS
show :: ScadOpts -> FilePath
$cshow :: ScadOpts -> FilePath
showsPrec :: Int -> ScadOpts -> ShowS
$cshowsPrec :: Int -> ScadOpts -> ShowS
Show, ScadOpts -> ScadOpts -> Bool
(ScadOpts -> ScadOpts -> Bool)
-> (ScadOpts -> ScadOpts -> Bool) -> Eq ScadOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScadOpts -> ScadOpts -> Bool
$c/= :: ScadOpts -> ScadOpts -> Bool
== :: ScadOpts -> ScadOpts -> Bool
$c== :: ScadOpts -> ScadOpts -> Bool
Eq)

instance Default ScadOpts where
  def :: ScadOpts
def = ScadOpts :: Bool -> Bool -> ScadOpts
ScadOpts
    { openScadCompatibility :: Bool
openScadCompatibility = Bool
False
    , importsAllowed :: Bool
importsAllowed        = Bool
True
    }

-- helper, to use union on VarLookups.
varUnion :: VarLookup -> VarLookup -> VarLookup
varUnion :: VarLookup -> VarLookup -> VarLookup
varUnion (VarLookup Map Symbol OVal
a) (VarLookup Map Symbol OVal
b) = Map Symbol OVal -> VarLookup
VarLookup (Map Symbol OVal -> VarLookup) -> Map Symbol OVal -> VarLookup
forall a b. (a -> b) -> a -> b
$ Map Symbol OVal -> Map Symbol OVal -> Map Symbol OVal
forall k a. Ord k => Map k a -> Map k a -> Map k a
union Map Symbol OVal
a Map Symbol OVal
b

-- | For programs using this API to perform variable lookups, after execution of an escad has completed.
lookupVarIn :: Text -> VarLookup -> Maybe OVal
lookupVarIn :: Text -> VarLookup -> Maybe OVal
lookupVarIn Text
target (VarLookup Map Symbol OVal
vars) = Symbol -> Map Symbol OVal -> Maybe OVal
forall k a. Ord k => k -> Map k a -> Maybe a
lookup (Text -> Symbol
Symbol Text
target) Map Symbol OVal
vars

newtype TestInvariant = EulerCharacteristic ℕ
    deriving (Int -> TestInvariant -> ShowS
[TestInvariant] -> ShowS
TestInvariant -> FilePath
(Int -> TestInvariant -> ShowS)
-> (TestInvariant -> FilePath)
-> ([TestInvariant] -> ShowS)
-> Show TestInvariant
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TestInvariant] -> ShowS
$cshowList :: [TestInvariant] -> ShowS
show :: TestInvariant -> FilePath
$cshow :: TestInvariant -> FilePath
showsPrec :: Int -> TestInvariant -> ShowS
$cshowsPrec :: Int -> TestInvariant -> ShowS
Show)