git.iko.soy/elk
on 2f5d445 help sign in
elk/elm/src/Types/Hints.hs
257 lines 11 kB history raw
2module Types.Hints (hints) where
4import Control.Monad (liftM,mapM)
5import Control.Arrow (first)
6import Types
7import Types.Substitutions (rescheme)
10-------- Text and Elements --------
12str2elem = hasType (string ==> element) [ "image","video","plainText" ]
14textToText = [ "header", "italic", "bold", "underline"
15 , "overline", "strikeThrough", "monospace" ]
17textAttrs = [ "toText" -: string ==> text
18 , "link" -: string ==> text ==> text
19 , numScheme (\t -> t ==> text ==> text) "Text.height"
20 ] ++ hasType (text ==> text) textToText
22elements = let iee = int ==> element ==> element in
23 [ "flow" -: direction ==> listOf element ==> element
24 , "layers" -: listOf element ==> element
25 , "text" -: text ==> element
26 , "opacity" -: float ==> element ==> element
27 , "width" -: iee
28 , "height" -: iee
29 , "size" -: int ==> iee
30 , "color" -: color ==> element ==> element
31 , "box" -: iee
32 , "rectangle" -: int ==> int ==> element
33 , "rightedText" -: text ==> element
34 , "centeredText" -: text ==> element
35 , "justifiedText" -: text ==> element
36 , "asText" -:: a ==> element
37 , "show" -:: a ==> text
38 , "collage" -: int ==> int ==> listOf form ==> element
39 ]
41directions = hasType direction ["up","down","left","right","inward","outward"]
42colors = [ numScheme (\n -> n ==> n ==> n ==> color) "rgb"
43 , numScheme (\n -> n ==> n ==> n ==> n ==> color) "rgba"
44 ] ++ hasType color ["red","green","blue","black","white"
45 ,"yellow","cyan","magenta","grey","gray"]
47lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"
48 , "customLine" -: listOf int ==> color ==> line ==> form
49 ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]
51shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"
52 , "filled" -: color ==> shape ==> form
53 , "outlined" -: color ==> shape ==> form
54 , "customOutline" -: listOf int ==> color ==> shape ==> form
55 , scheme2 number transformable (\n t -> n ==> n ==> t ==> t) "move"
56 , scheme2 number transformable (\n t -> n ==> t ==> t) "rotate"
57 , scheme2 number transformable (\n t -> n ==> t ==> t) "scale"
58 ] ++ map (twoNums (\n m -> n ==> n ==> pairOf m ==> shape)) [ "ngon"
59 , "rect"
60 , "oval" ]
63-------- Foreign --------
65casts =
66 [ "castJSBoolToBool" -: jsBool ==> bool
67 , "castBoolToJSBool" -: bool ==> jsBool
68 , "castJSNumberToInt" -: jsNumber ==> int
69 , "castIntToJSNumber" -: int ==> jsNumber
70 , "castJSElementToElement" -: int ==> int ==> jsElement ==> element
71 , "castElementToJSElement" -: element ==> jsElement
72 , "castJSStringToString" -: jsString ==> string
73 , "castStringToJSString" -: string ==> jsString
74 , "castJSNumberToFloat" -: jsNumber ==> float
75 , "castFloatToJSNumber" -: float ==> jsNumber
76 ]
78castToTuple n = (,) name $ Forall [1..n] [] (jsTuple vs ==> tupleOf vs)
79 where vs = map VarT [1..n]
80 name = "castJSTupleToTuple" ++ show n
81castToJSTuple n = (,) name $ Forall [1..n] [] (tupleOf vs ==> jsTuple vs)
82 where vs = map VarT [1..n]
83 name = "castTupleToJSTuple" ++ show n
85polyCasts =
86 map castToTuple [2..5] ++ map castToJSTuple [2..5] ++
87 [ "castJSArrayToList" -:: jsArray a ==> listOf a
88 , "castListToJSArray" -:: listOf a ==> jsArray a
89 ]
91json =
92 [ "JsonString" -: string ==> jsonValue
93 , "JsonBool" -: bool ==> jsonValue
94 , "JsonNull" -: jsonValue
95 , "JsonArray" -: listOf jsonValue ==> jsonValue
96 , "JsonObject" -: jsonObject ==> jsonValue
97 , numScheme (\n -> n ==> jsonValue) "JsonNumber"
98 , "toPrettyString" -: string ==> jsonObject ==> string
99 , "toPrettyJSString" -: string ==> jsonObject ==> jsString
100 , "toJSString" -: jsonObject ==> jsString
101 ]
104-------- Signals --------
106sig n name = (,) name $ Forall [1..n] [] (fn ts ==> fn (map signalOf ts))
107 where fn = foldr1 (==>)
108 ts = map VarT [1..n]
110signals =
111 [ sig 1 "constant"
112 , sig 2 "lift"
113 , sig 3 "lift2"
114 , sig 4 "lift3"
115 , sig 5 "lift4"
116 , "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
117 , "randomize" -:: int ==> int ==> signalOf a ==> signalOf int
118 , "count" -:: signalOf a ==> signalOf int
119 , "keepIf" -:: (a==>bool) ==> a ==> signalOf a ==> signalOf a
120 , "dropIf" -:: (a==>bool) ==> a ==> signalOf a ==> signalOf a
121 , "keepWhen" -:: signalOf bool ==>a==> signalOf a ==> signalOf a
122 , "dropWhen" -:: signalOf bool ==>a==> signalOf a ==> signalOf a
123 , "dropRepeats" -:: signalOf a ==> signalOf a
124 , "sampleOn" -:: signalOf a ==> signalOf b ==> signalOf b
125 ]
127concreteSignals =
128 [ "keysDown" -: signalOf (listOf int)
129 , "charPressed" -: signalOf (maybeOf int)
130 , "inRange" -: int ==> int ==> signalOf int
131 , timeScheme "every" (\t -> t ==> signalOf t)
132 , timeScheme "before" (\t -> t ==> signalOf bool)
133 , timeScheme "after" (\t -> t ==> signalOf bool)
134 , "dimensions" -: signalOf point
135 , "position" -: signalOf point
136 , "x" -: signalOf int
137 , "y" -: signalOf int
138 , "isDown" -: signalOf bool
139 , "isClicked" -: signalOf bool
140 , "textField" -: string ==> tupleOf [element, signalOf string]
141 , "password" -: string ==> tupleOf [element, signalOf string]
142 , "textArea" -: int ==> int ==> tupleOf [element, signalOf string]
143 , "checkBox" -: bool ==> tupleOf [element, signalOf bool]
144 , "button" -: string ==> tupleOf [element, signalOf bool]
145 , "stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
146 ]
148-------- Math and Binops --------
150binop t = t ==> t ==> t
151scheme1 super t name =
152 (name, Forall [0] [ Context ("`" ++ name ++ "'") $ VarT 0 :<: super
153 ] (t (VarT 0)))
154scheme2 s1 s2 t name =
155 (name, Forall [0,1] [ Context ("`" ++ name ++ "'") $ VarT 0 :<: s1
156 , Context ("`" ++ name ++ "'") $ VarT 1 :<: s2
157 ] (t (VarT 0) (VarT 1)))
158numScheme t name = scheme1 number t name
159timeScheme name t = scheme1 time t name
160twoNums f name = scheme2 number number f name
162math =
163 map (numScheme (\t -> t ==> binop t)) ["clamp"] ++
164 map (numScheme (\t -> binop t)) ["+","-","*","max","min"] ++
165 [ numScheme (\t -> t ==> t) "abs" ] ++
166 hasType (binop float) [ "/", "logBase" ] ++
167 hasType (binop int) ["rem","div","mod"] ++
168 hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"] ++
169 hasType float ["pi","e"] ++
170 hasType (int ==> float) ["toFloat","castIntToFloat"] ++
171 hasType (float ==> int) ["round","floor","ceiling","truncate"]
173bools =
174 [ "not" -: bool ==> bool ] ++
175 hasType (binop bool) ["&&","||"] ++
176 map (scheme1 comparable (\t -> t ==> t ==> bool)) ["<",">","<=",">="] ++
177 [ ( "compare"
178 , Forall [0,1] [ Context "`compare'" $ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) )
179 ]
181-------- Polymorphic Functions --------
183[a,b,c] = map VarT [1,2,3]
185infix 8 -::
186name -:: tipe = (name, Forall [1,2,3] [] tipe)
188funcs =
189 [ "id" -:: a ==> a
190 , "==" -:: a ==> a ==> bool
191 , "/=" -:: a ==> a ==> bool
192 , "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
193 , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
194 , "$" -:: (a ==> b) ==> a ==> b
195 , ":" -:: a ==> listOf a ==> listOf a
196 , (,) "++" . Forall [0,1] [ Context "`++'" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0
197 , "Cons" -:: a ==> listOf a ==> listOf a
198 , "Nil" -:: listOf a
199 , "Just" -:: a ==> maybeOf a
200 , "Nothing" -:: maybeOf a
201 , "curry" -:: (tupleOf [a,b] ==> c) ==> a ==> b ==> c
202 , "uncurry" -:: (a ==> b ==> c) ==> tupleOf [a,b] ==> c
203 ] ++ map tuple [0..8]
205tuple n = ("Tuple" ++ show n, Forall [1..n] [] $ foldr (==>) (tupleOf vs) vs)
206 where vs = map VarT [1..n]
208lists =
209 [ "and" -:: listOf bool ==> bool
210 , "or" -:: listOf bool ==> bool
211 , numScheme (\n -> listOf n ==> listOf n) "sort"
212 , "head" -:: listOf a ==> a
213 , "tail" -:: listOf a ==> listOf a
214 , "length" -:: listOf a ==> int
215 , "filter" -:: (a ==> bool) ==> listOf a ==> listOf a
216 , "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
217 , "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
218 , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
219 , "forall" -:: (a ==> bool) ==> listOf a ==> bool
220 , "exists" -:: (a ==> bool) ==> listOf a ==> bool
221 , "reverse" -:: listOf a ==> listOf a
222 , "take" -:: int ==> listOf a ==> listOf a
223 , "drop" -:: int ==> listOf a ==> listOf a
224 , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]
225 , "intersperse" -:: a ==> listOf a ==> listOf a
226 , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
227 , "map" -:: (a ==> b) ==> listOf a ==> listOf b
228 , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
229 , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
230 , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b
231 , (,) "concat" . Forall [0,1] [ Context "`concat'" $ VarT 0 :<: appendable (VarT 1) ] $
232 listOf (VarT 0) ==> VarT 0
233 , (,) "concatMap" . Forall [0,1,2] [ Context "`concatMap'" $ VarT 0 :<: appendable (VarT 1) ] $
234 (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0
235 , (,) "intercalate" . Forall [0,1] [ Context "`intercalate'" $ VarT 0 :<: appendable (VarT 1) ] $
236 VarT 0 ==> listOf (VarT 0) ==> VarT 0
237 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
238 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
239 , "maximum", "minimum" ]
241maybeFuncs =
242 [ "maybe" -:: b ==> (a ==> b) ==> maybeOf a ==> b
243 , "isJust" -:: maybeOf a ==> bool
244 , "isNothing" -:: maybeOf a ==> bool
245 , "fromMaybe" -:: a ==> maybeOf a ==> a
246 , "consMaybe" -:: maybeOf a ==> listOf a ==> listOf a
247 , "catMaybes" -:: listOf (maybeOf a) ==> listOf a
248 , "catMaybes" -:: (a ==> maybeOf b) ==> listOf a ==> listOf b
249 ]
251-------- Everything --------
253hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) hs
254 where hs = concat [ funcs, lists, signals, math, bools, str2elem, textAttrs
255 , elements, directions, colors, lineTypes, shapes
256 , concreteSignals, casts, polyCasts, json, maybeFuncs
257 ]