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

-- FIXME: required. why?
{-# LANGUAGE ViewPatterns #-}

{-# LANGUAGE ScopedTypeVariables #-}

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

module Graphics.Implicit.ExtOpenScad.Util.OVal(OTypeMirror, (<||>), fromOObj, toOObj, divideObjs, caseOType, oTypeStr, getErrors) where

import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return, IO)

import Graphics.Implicit.Definitions(V2, ℝ, ℝ2, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1, C2, Fn), fromℕtoℝ)

import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3, OIO))

import Control.Monad (msum)

import Data.Maybe (fromMaybe, maybe)

import Data.Traversable (traverse)

import Data.Text.Lazy (Text)

-- for some minimal paralellism.
import Control.Parallel.Strategies (runEval, rpar, rseq)

-- To build vectors of ℝs.
import Linear (V2(V2), V3(V3), V4(V4))

-- Convert OVals (and Lists of OVals) into a given Haskell type
class OTypeMirror a where
    fromOObj :: OVal -> Maybe a
    fromOObjList :: OVal -> Maybe [a]
    fromOObjList (OList [OVal]
list) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. OTypeMirror a => OVal -> Maybe a
fromOObj [OVal]
list
    fromOObjList OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObjList #-}
    toOObj :: a -> OVal

instance OTypeMirror (IO OVal) where
    fromOObj :: OVal -> Maybe (IO OVal)
fromOObj (OIO IO OVal
m) = forall a. a -> Maybe a
Just IO OVal
m
    fromOObj OVal
_       = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: IO OVal -> OVal
toOObj = IO OVal -> OVal
OIO

instance OTypeMirror OVal where
    fromOObj :: OVal -> Maybe OVal
fromOObj = forall a. a -> Maybe a
Just
    {-# INLINABLE fromOObj #-}
    toOObj :: OVal -> OVal
toOObj OVal
a = OVal
a

instance OTypeMirror ℝ where
    fromOObj :: OVal -> Maybe ℝ
fromOObj (ONum ℝ
n) = forall a. a -> Maybe a
Just ℝ
n
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: ℝ -> OVal
toOObj = ℝ -> OVal
ONum

instance OTypeMirror ℕ where
    fromOObj :: OVal -> Maybe ℕ
fromOObj (ONum ℝ
n) = if ℝ
n forall a. Eq a => a -> a -> Bool
== forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
n) then forall a. a -> Maybe a
Just (forall a b. (RealFrac a, Integral b) => a -> b
floor ℝ
n) else forall a. Maybe a
Nothing
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: ℕ -> OVal
toOObj = ℝ -> OVal
ONum forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℕ -> ℝ
fromℕtoℝ

instance OTypeMirror Bool where
    fromOObj :: OVal -> Maybe Bool
fromOObj (OBool Bool
b) = forall a. a -> Maybe a
Just Bool
b
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: Bool -> OVal
toOObj = Bool -> OVal
OBool

instance (OTypeMirror a) => OTypeMirror [a] where
    fromOObj :: OVal -> Maybe [a]
fromOObj = forall a. OTypeMirror a => OVal -> Maybe [a]
fromOObjList
    {-# INLINABLE fromOObj #-}
    toOObj :: [a] -> OVal
toOObj [a]
list = [OVal] -> OVal
OList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. OTypeMirror a => a -> OVal
toOObj [a]
list

instance OTypeMirror Text where
    fromOObj :: OVal -> Maybe Text
fromOObj (OString Text
str) = forall a. a -> Maybe a
Just Text
str
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    toOObj :: Text -> OVal
    toOObj :: Text -> OVal
toOObj = Text -> OVal
OString

instance (OTypeMirror a) => OTypeMirror (Maybe a) where
    fromOObj :: OVal -> Maybe (Maybe a)
fromOObj OVal
a = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. OTypeMirror a => OVal -> Maybe a
fromOObj OVal
a
    {-# INLINABLE fromOObj #-}
    toOObj :: Maybe a -> OVal
toOObj (Just a
a) = forall a. OTypeMirror a => a -> OVal
toOObj a
a
    toOObj Maybe a
Nothing  = OVal
OUndefined

instance (OTypeMirror a, OTypeMirror b) => OTypeMirror (a,b) where
    fromOObj :: OVal -> Maybe (a, b)
fromOObj (OList [forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
a,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just b
b]) = forall a. a -> Maybe a
Just (a
a,b
b)
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: (a, b) -> OVal
toOObj (a
a,b
b) = [OVal] -> OVal
OList [forall a. OTypeMirror a => a -> OVal
toOObj a
a, forall a. OTypeMirror a => a -> OVal
toOObj b
b]

instance (OTypeMirror a) => OTypeMirror (V2 a) where
    fromOObj :: OVal -> Maybe (V2 a)
fromOObj (OList [forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
a,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
b]) = forall a. a -> Maybe a
Just (forall a. a -> a -> V2 a
V2 a
a a
b)
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: V2 a -> OVal
toOObj (V2 a
a a
b) = [OVal] -> OVal
OList [forall a. OTypeMirror a => a -> OVal
toOObj a
a, forall a. OTypeMirror a => a -> OVal
toOObj a
b]

instance (OTypeMirror a, OTypeMirror b, OTypeMirror c) => OTypeMirror (a,b,c) where
    fromOObj :: OVal -> Maybe (a, b, c)
fromOObj (OList [forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
a,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just b
b,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just c
c]) =
        forall a. a -> Maybe a
Just (a
a,b
b,c
c)
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: (a, b, c) -> OVal
toOObj (a
a,b
b,c
c) = [OVal] -> OVal
OList [forall a. OTypeMirror a => a -> OVal
toOObj a
a, forall a. OTypeMirror a => a -> OVal
toOObj b
b, forall a. OTypeMirror a => a -> OVal
toOObj c
c]

instance (OTypeMirror a) => OTypeMirror (V3 a) where
    fromOObj :: OVal -> Maybe (V3 a)
fromOObj (OList [forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
a,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
b,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
c]) =
        forall a. a -> Maybe a
Just (forall a. a -> a -> a -> V3 a
V3 a
a a
b a
c)
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: V3 a -> OVal
toOObj (V3 a
a a
b a
c) = [OVal] -> OVal
OList [forall a. OTypeMirror a => a -> OVal
toOObj a
a, forall a. OTypeMirror a => a -> OVal
toOObj a
b, forall a. OTypeMirror a => a -> OVal
toOObj a
c]

instance (OTypeMirror a) => OTypeMirror (V4 a) where
    fromOObj :: OVal -> Maybe (V4 a)
fromOObj (OList [forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
a,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
b,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
c,forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just a
d]) =
        forall a. a -> Maybe a
Just (forall a. a -> a -> a -> a -> V4 a
V4 a
a a
b a
c a
d)
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: V4 a -> OVal
toOObj (V4 a
a a
b a
c a
d) = [OVal] -> OVal
OList [forall a. OTypeMirror a => a -> OVal
toOObj a
a, forall a. OTypeMirror a => a -> OVal
toOObj a
b, forall a. OTypeMirror a => a -> OVal
toOObj a
c, forall a. OTypeMirror a => a -> OVal
toOObj a
d]

instance (OTypeMirror a, OTypeMirror b) => OTypeMirror (a -> b) where
    fromOObj :: OVal -> Maybe (a -> b)
fromOObj (OFunc OVal -> OVal
f) =  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \a
input ->
        let
            oInput :: OVal
oInput = forall a. OTypeMirror a => a -> OVal
toOObj a
input
            oOutput :: OVal
oOutput = OVal -> OVal
f OVal
oInput
            output :: Maybe b
            output :: Maybe b
output = forall a. OTypeMirror a => OVal -> Maybe a
fromOObj OVal
oOutput
        in
          forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"coercing OVal to a -> b isn't always safe; use a -> Maybe b"
                               forall a. Semigroup a => a -> a -> a
<> [Char]
" (trace: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show OVal
oInput forall a. Semigroup a => a -> a -> a
<> [Char]
" -> " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show OVal
oOutput forall a. Semigroup a => a -> a -> a
<> [Char]
" )") Maybe b
output
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}
    toOObj :: (a -> b) -> OVal
toOObj a -> b
f = (OVal -> OVal) -> OVal
OFunc forall a b. (a -> b) -> a -> b
$ \OVal
oObj ->
        case forall a. OTypeMirror a => OVal -> Maybe a
fromOObj OVal
oObj :: Maybe a of
            Maybe a
Nothing  -> Text -> OVal
OError Text
"bad input type"
            Just a
obj -> forall a. OTypeMirror a => a -> OVal
toOObj forall a b. (a -> b) -> a -> b
$ a -> b
f a
obj

instance (OTypeMirror a, OTypeMirror b) => OTypeMirror (Either a b) where
    fromOObj :: OVal -> Maybe (Either a b)
fromOObj (forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just (a
x :: a)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left  a
x
    fromOObj (forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just (b
x :: b)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
x
    fromOObj OVal
_ = forall a. Maybe a
Nothing
    {-# INLINABLE fromOObj #-}

    toOObj :: Either a b -> OVal
toOObj (Right b
x) = forall a. OTypeMirror a => a -> OVal
toOObj b
x
    toOObj (Left  a
x) = forall a. OTypeMirror a => a -> OVal
toOObj a
x

instance OTypeMirror ExtrudeMScale where
    fromOObj :: OVal -> Maybe ExtrudeMScale
fromOObj (forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just (ℝ
x :: ℝ)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ℝ -> ExtrudeMScale
C1 ℝ
x
    fromOObj (forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just (ℝ2
x :: ℝ2)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ℝ2 -> ExtrudeMScale
C2 ℝ2
x
    fromOObj (forall a. OTypeMirror a => OVal -> Maybe a
fromOObj -> Just (ℝ -> Either ℝ ℝ2
x :: (ℝ -> Either ℝ ℝ2))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (ℝ -> Either ℝ ℝ2) -> ExtrudeMScale
Fn ℝ -> Either ℝ ℝ2
x
    fromOObj OVal
_ = forall a. Maybe a
Nothing

    toOObj :: ExtrudeMScale -> OVal
toOObj (C1 ℝ
x) = forall a. OTypeMirror a => a -> OVal
toOObj ℝ
x
    toOObj (C2 ℝ2
x) = forall a. OTypeMirror a => a -> OVal
toOObj ℝ2
x
    toOObj (Fn ℝ -> Either ℝ ℝ2
x) = forall a. OTypeMirror a => a -> OVal
toOObj ℝ -> Either ℝ ℝ2
x

-- A string representing each type.
oTypeStr :: OVal -> Text
oTypeStr :: OVal -> Text
oTypeStr OVal
OUndefined         = Text
"Undefined"
oTypeStr (OBool          Bool
_ ) = Text
"Bool"
oTypeStr (ONum           ℝ
_ ) = Text
"Number"
oTypeStr (OList          [OVal]
_ ) = Text
"List"
oTypeStr (OString        Text
_ ) = Text
"String"
oTypeStr (OFunc          OVal -> OVal
_ ) = Text
"Function"
oTypeStr (OIO            IO OVal
_ ) = Text
"IO"
oTypeStr (OUModule {}      ) = Text
"User Defined Module"
oTypeStr (ONModule {}      ) = Text
"Built-in Module"
oTypeStr (OVargsModule Symbol
_ Symbol
-> SourcePosition
-> [(Maybe Symbol, OVal)]
-> [StatementI]
-> ([StatementI] -> StateC ())
-> StateC ()
_ ) = Text
"VargsModule"
oTypeStr (OError         Text
_ ) = Text
"Error"
oTypeStr (OObj2          SymbolicObj2
_ ) = Text
"2D Object"
oTypeStr (OObj3          SymbolicObj3
_ ) = Text
"3D Object"

getErrors :: OVal -> Maybe Text
getErrors :: OVal -> Maybe Text
getErrors (OError Text
er) = forall a. a -> Maybe a
Just Text
er
getErrors (OList [OVal]
l)   = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OVal -> Maybe Text
getErrors [OVal]
l
getErrors OVal
_           = forall a. Maybe a
Nothing

caseOType :: a -> (a -> c) -> c
caseOType :: forall a c. a -> (a -> c) -> c
caseOType = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)

infixr 2 <||>
(<||>) :: OTypeMirror desiredType
    => (desiredType -> out)
    -> (OVal -> out)
    -> (OVal -> out)
<||> :: forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
(<||>) desiredType -> out
f OVal -> out
g OVal
input =
    let
        coerceAttempt :: OTypeMirror desiredType => Maybe desiredType
        coerceAttempt :: forall desiredType. OTypeMirror desiredType => Maybe desiredType
coerceAttempt = forall a. OTypeMirror a => OVal -> Maybe a
fromOObj OVal
input
    in
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (OVal -> out
g OVal
input) desiredType -> out
f forall desiredType. OTypeMirror desiredType => Maybe desiredType
coerceAttempt

-- separate 2d and 3d objects from a set of OVals.
divideObjs :: [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs :: [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs [OVal]
children =
    forall a. Eval a -> a
runEval forall a b. (a -> b) -> a -> b
$ do
    [SymbolicObj2]
obj2s <- forall a. Strategy a
rseq [ SymbolicObj2
x | OObj2 SymbolicObj2
x <- [OVal]
children ]
    [SymbolicObj3]
obj3s <- forall a. Strategy a
rseq [ SymbolicObj3
x | OObj3 SymbolicObj3
x <- [OVal]
children ]
    [OVal]
objs <- forall a. Strategy a
rpar (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. OVal -> Bool
isOObj) [OVal]
children)
    forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
objs)
      where
        isOObj :: OVal -> Bool
isOObj  (OObj2 SymbolicObj2
_) = Bool
True
        isOObj  (OObj3 SymbolicObj3
_) = Bool
True
        isOObj  OVal
_         = Bool
False