-
-
Notifications
You must be signed in to change notification settings - Fork 141
/
OVal.hs
141 lines (113 loc) · 4.41 KB
/
OVal.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances -#}
#endif
{-# LANGUAGE ViewPatterns, RankNTypes, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
module Graphics.Implicit.ExtOpenScad.Util.OVal where
import Graphics.Implicit.Definitions
import Graphics.Implicit.ExtOpenScad.Definitions
import qualified Control.Monad as Monad
import Data.Maybe (isJust)
-- | We'd like to be able to turn OVals into a given Haskell type
class OTypeMirror a where
fromOObj :: OVal -> Maybe a
toOObj :: a -> OVal
instance OTypeMirror OVal where
fromOObj a = Just a
toOObj a = a
instance OTypeMirror ℝ where
fromOObj (ONum n) = Just n
fromOObj _ = Nothing
toOObj n = ONum n
instance OTypeMirror ℕ where
fromOObj (ONum n) = if n == fromIntegral (floor n) then Just (floor n) else Nothing
fromOObj _ = Nothing
toOObj n = ONum $ fromIntegral n
instance OTypeMirror Bool where
fromOObj (OBool b) = Just b
fromOObj _ = Nothing
toOObj b = OBool b
instance {-# Overlapping #-} OTypeMirror String where
fromOObj (OString str) = Just str
fromOObj _ = Nothing
toOObj str = OString str
instance forall a. (OTypeMirror a) => OTypeMirror (Maybe a) where
fromOObj a = Just $ fromOObj a
toOObj (Just a) = toOObj a
toOObj Nothing = OUndefined
instance {-# Overlappable #-} forall a. (OTypeMirror a) => OTypeMirror [a] where
fromOObj (OList list) = Monad.sequence . map fromOObj $ list
fromOObj _ = Nothing
toOObj list = OList $ map toOObj list
instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (a,b) where
fromOObj (OList ((fromOObj -> Just a):(fromOObj -> Just b):[])) = Just (a,b)
fromOObj _ = Nothing
toOObj (a,b) = OList [toOObj a, toOObj b]
instance forall a b c. (OTypeMirror a, OTypeMirror b, OTypeMirror c) => OTypeMirror (a,b,c) where
fromOObj (OList ((fromOObj -> Just a):(fromOObj -> Just b):(fromOObj -> Just c):[])) =
Just (a,b,c)
fromOObj _ = Nothing
toOObj (a,b,c) = OList [toOObj a, toOObj b, toOObj c]
instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (a -> b) where
fromOObj (OFunc f) = Just $ \input ->
let
oInput = toOObj input
oOutput = f oInput
output = fromOObj oOutput :: Maybe b
in case output of
Just out -> out
Nothing -> error $ "coercing OVal to a -> b isn't always safe; use a -> Maybe b"
++ " (trace: " ++ show oInput ++ " -> " ++ show oOutput ++ " )"
fromOObj _ = Nothing
toOObj f = OFunc $ \oObj ->
case fromOObj oObj :: Maybe a of
Nothing -> OError ["bad input type"]
Just obj -> toOObj $ f obj
instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (Either a b) where
fromOObj (fromOObj -> Just (x :: a)) = Just $ Left x
fromOObj (fromOObj -> Just (x :: b)) = Just $ Right x
fromOObj _ = Nothing
toOObj (Right x) = toOObj x
toOObj (Left x) = toOObj x
oTypeStr :: OVal -> [Char]
oTypeStr (OUndefined) = "Undefined"
oTypeStr (OBool _ ) = "Bool"
oTypeStr (ONum _ ) = "Number"
oTypeStr (OList _ ) = "List"
oTypeStr (OString _ ) = "String"
oTypeStr (OFunc _ ) = "Function"
oTypeStr (OModule _ ) = "Module"
oTypeStr (OError _ ) = "Error"
getErrors :: OVal -> Maybe String
getErrors (OError er) = Just $ head er
getErrors (OList l) = Monad.msum $ map getErrors l
getErrors _ = Nothing
type Any = OVal
caseOType = flip ($)
infixr 2 <||>
(<||>) :: forall desiredType out. (OTypeMirror desiredType)
=> (desiredType -> out)
-> (OVal -> out)
-> (OVal -> out)
(<||>) f g = \input ->
let
coerceAttempt = fromOObj input :: Maybe desiredType
in
if isJust coerceAttempt -- ≅ (/= Nothing) but no Eq req
then f $ (\(Just a) -> a) coerceAttempt
else g input
divideObjs :: [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs children =
(map fromOObj2 . filter isOObj2 $ children,
map fromOObj3 . filter isOObj3 $ children,
filter (not . isOObj) $ children)
where
isOObj2 (OObj2 _) = True
isOObj2 _ = False
isOObj3 (OObj3 _) = True
isOObj3 _ = False
isOObj (OObj2 _) = True
isOObj (OObj3 _) = True
isOObj _ = False
fromOObj2 (OObj2 x) = x
fromOObj3 (OObj3 x) = x