-
Notifications
You must be signed in to change notification settings - Fork 5
/
Type.hs
215 lines (161 loc) · 5.97 KB
/
Type.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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
{-# LANGUAGE OverloadedStrings, GADTs, NoImplicitPrelude, ExistentialQuantification, FlexibleInstances, Rank2Types #-}
module D3JS.Type where
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding ((.),id)
import Control.Category
import Data.String
-- * Types
-- |This represents a method chain with an initial type of `a` and a final type of `b`
-- Chains are composable by functions in "Control.Category" module.
-- See "D3JS.Chart" for examples.
data Chain a b where
Val :: Var -> Chain () b
Val' :: (Reifiable b) => b -> Chain () b
Val'' :: Var' b -> Chain () b
-- Func :: JSFunc params b -> Chain a b
Concat :: Chain c b -> Chain a c -> Chain a b
Nil :: Chain a a
-- ChainField :: Text -> Chain a b
Refine :: JSObjClass a => Text -> Chain a b
Apply :: forall a b params. [JSParam] -> Chain a (JSFunc params b) -> Chain a b
class JSObjClass a
instance JSObjClass JSObj
instance JSObjClass Force
instance JSObjClass Histogram
instance JSObjClass Selection
instance JSObjClass Transition
instance JSObjClass Scale
type ChainValue r = Chain () r
type IsoChain r = Chain r r
type RefineFunc = forall params r. Chain JSObj (JSFunc params r)
-- | Chain a b behaves just like (a -> b).
-- Val Var is the starting point of chain (= constant),
-- and Nil is the termination of chain.
instance Category Chain where
id = Nil
(.) = Concat
type Var = Text
type Selector = Text
-- data D3Root = D3Root
data Data1D = Data1D [Double] deriving (Show)
data Data2D = Data2D [(Double,Double)] deriving (Show)
-- Selection with associated data
data SelData a = SelData
instance JSObjClass (SelData a)
-- Various objects
data Force = Force
data Scale = Scale
data Color = Color
data D3Func = D3Func -- functions returned by d3, e.g. d3.format, etc.
data Histogram = Histogram
-- The following types are just used as a tag for chaining functions with a type.
data Selection = Selection
data Transition = Transition
-- |Instances of Reifiable can generate a JavaScript code fragment.
class Reifiable a where
reify :: a -> Text
-- |Used just as a tag for typing method chains. Used in "D3JS.Func".
class JSObjClass a => Sel a
instance Sel Selection
instance Sel (SelData a)
class JSArrayClass a
instance JSArrayClass Data1D
instance JSArrayClass Data2D
instance JSArrayClass JSObjArray
-- |Used just as a tag for typing method chains. Used in "D3JS.Func".
class JSObjClass a => Sel2 a
instance Sel2 Selection
instance Sel2 (SelData a)
instance (JSObjClass b) => Sel2 (Chain () b)
instance (JSObjClass a) => Sel2 (Var' a)
instance Sel2 Transition
instance JSObjClass JSObjArray
instance (JSObjClass a) => JSObjClass (Chain () a)
instance (JSObjClass a) => JSObjClass (Var' a)
-- * For internal use
-- | Function call for method chaining
data JSFunc params r = JSFunc FuncName [JSParam] -- name and params
type FuncName = Text
-- | Parameter for a function call
data JSParam =
ParamVar Var | PText Text | PDouble Double | PInt Int | PFunc FuncDef | forall r. PFunc' (NumFunc r)
| PArray [JSParam] | PCompositeNum NumOp JSParam JSParam | forall r. PChainValue (ChainValue r)
data NumOp = forall a. Num a => NumOp (a -> a -> a) | NumOpAdd | NumOpSubt | NumOpMult | NumOpFromInteger -- stub
instance Num JSParam where
a + b = PCompositeNum (NumOp (+)) a b
a - b = PCompositeNum (NumOp (-)) a b
a * b = PCompositeNum (NumOp (*)) a b
fromInteger a = PInt (fromIntegral a)
instance Fractional JSParam where
fromRational n = PDouble (fromRational n)
-- | Function definition used for a callback.
data FuncDef = FuncTxt Text | forall r. FuncExp (NumFunc r)
instance IsString FuncDef where
fromString = FuncTxt . T.pack
funcTxt :: Text -> JSParam
funcTxt = PFunc . FuncTxt
funcExp = PFunc . FuncExp
return_ :: NumFunc r -> FuncDef
return_ = FuncExp
-- | Representation of JavaScript function
-- Should be renamed to JSExp or something
data NumFunc r where
NInt :: Int -> NumFunc Int
NDouble :: Double -> NumFunc Double
Add :: NumFunc r -> NumFunc r -> NumFunc r
Subt :: NumFunc r -> NumFunc r -> NumFunc r
Mult :: NumFunc r -> NumFunc r -> NumFunc r
Div :: NumFunc r -> NumFunc r -> NumFunc r
Mod :: NumFunc r -> NumFunc r -> NumFunc r
Index :: NumFunc Int -> NumFunc [r] -> NumFunc r
Field :: Text -> NumFunc JSObj -> NumFunc r
Ternary :: NumFunc a -> NumFunc r -> NumFunc r -> NumFunc r
NVar :: Var -> NumFunc r
NVar' :: Var' r -> NumFunc r
ChainVal :: ChainValue r -> NumFunc r
DataParam :: NumFunc r
DataIndex :: NumFunc Int
DataIndexD :: NumFunc Double -- ad hoc?
ApplyFunc :: Var' a -> [JSParam] -> NumFunc r -- different from JSFunc, because this is not a method chain.
ApplyFunc' :: FuncName -> [JSParam] -> NumFunc r -- different from JSFunc, because this is not a method chain.
MkObject :: [(Text,NumFunc r)] -> NumFunc JSObject
mkObj = MkObject
data JSObj = JSObj
fieldd :: Text -> NumFunc JSObj -> NumFunc Double
fieldd = Field
infixl 7 ..>
(..>) :: NumFunc JSObj -> Text -> NumFunc a
a ..> b = Field b a
data JSObject = forall r. JSObject [(Text,NumFunc r)]
data JSObjArray = JSObjArray JSObject | JSObjArrayRaw Text -- internal representation is same as object.
class NumFuncVal a
instance NumFuncVal Int
instance NumFuncVal Double
instance Num (NumFunc Int) where
fromInteger = NInt . (fromIntegral :: Integer -> Int)
(+) = Add
(-) = Subt
(*) = Mult
abs a = ApplyFunc' "abs" [funcExp a]
signum a = ApplyFunc' "abs" [funcExp a]
instance Num (NumFunc Double) where
fromInteger = NDouble . (fromIntegral :: Integer -> Double)
(+) = Add
(-) = Subt
(*) = Mult
abs a = ApplyFunc' "abs" [funcExp a]
instance Fractional (NumFunc Double) where
(/) = Div
fromRational = NDouble . fromRational
(%) :: NumFunc r -> NumFunc r -> NumFunc r
(%) = Mod
-- |This should not be used directly by users. Users should use 'assign' to get a variable instead.
data Var' dat = Var' {unVar' :: Var} -- typed variables
data SvgElement = Svg | Rect | Circle | Path | G | SvgOther Text
instance Show SvgElement where
show Svg = "svg"
show Rect = "rect"
show Circle = "circle"
show G = "g"
show _ = "Unknown yet"