git.iko.soy/elk
on 45f834e help sign in
elk/elm/src/Types/Hints.hs
223 lines 8.8 kB history raw
2module Hints (hints) where
4import Control.Monad (liftM,mapM)
5import Control.Arrow (first)
6import Types
7import Guid
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 , "box" -: iee
31 , "centeredText" -: text ==> element
32 , "justifiedText" -: text ==> element
33 , "collage" -: int ==> int ==> listOf form ==> element
34 ]
36directions = hasType direction ["up","down","left","right","inward","outward"]
37colors = [ numScheme (\n -> n ==> n ==> n ==> color) "rgb"
38 , numScheme (\n -> n ==> n ==> n ==> n ==> color) "rgba"
39 ] ++ hasType color ["red","green","blue","black","white"
40 ,"yellow","cyan","magenta","grey","gray"]
42lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"
43 , "customLine" -: listOf int ==> color ==> line ==> form
44 ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]
46shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"
47 , "filled" -: color ==> shape ==> form
48 , "outlined" -: color ==> shape ==> form
49 , "customOutline" -: listOf int ==> color ==> shape ==> form
50 ] ++ map (twoNums (\n m -> n ==> n ==> pairOf m ==> shape)) [ "ngon"
51 , "rect"
52 , "oval" ]
55-------- Foreign --------
57casts =
58 [ "castJSBoolToBool" -: jsBool ==> bool
59 , "castBoolToJSBool" -: bool ==> jsBool
60 , "castJSNumberToInt" -: jsNumber ==> int
61 , "castIntToJSNumber" -: int ==> jsNumber
62 , "castJSElementToElement" -: int ==> int ==> jsElement ==> element
63 , "castElementToJSElement" -: element ==> jsElement
64 , "castJSStringToString" -: jsString ==> string
65 , "castStringToJSString" -: string ==> jsString
66 , "castJSNumberToFloat" -: jsNumber ==> float
67 , "castFloatToJSNumber" -: float ==> jsNumber
68 ]
70castToTuple n = (,) name $ Forall [1..n] [] (jsTuple vs ==> tupleOf vs)
71 where vs = map VarT [1..n]
72 name = "castJSTupleToTuple" ++ show n
73castToJSTuple n = (,) name $ Forall [1..n] [] (tupleOf vs ==> jsTuple vs)
74 where vs = map VarT [1..n]
75 name = "castTupleToJSTuple" ++ show n
77polyCasts =
78 map castToTuple [2..5] ++ map castToJSTuple [2..5] ++
79 [ "castJSArrayToList" -:: jsArray a ==> listOf a
80 , "castListToJSArray" -:: listOf a ==> jsArray a
81 ]
84-------- Signals --------
86sig n name = (,) name $ Forall [1..n] [] (fn ts ==> fn (map signalOf ts))
87 where fn = foldr1 (==>)
88 ts = map VarT [1..n]
90signals =
91 [ sig 1 "constant"
92 , sig 2 "lift"
93 , sig 3 "lift2"
94 , sig 4 "lift3"
95 , sig 5 "lift4"
96 , "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
97 , "randomize" -:: int ==> int ==> signalOf a ==> signalOf int
98 , "count" -:: signalOf a ==> signalOf int
99 , "keepIf" -:: (a==>bool) ==> a ==> signalOf a ==> signalOf a
100 , "dropIf" -:: (a==>bool) ==> a ==> signalOf a ==> signalOf a
101 , "keepWhen" -:: signalOf bool ==>a==> signalOf a ==> signalOf a
102 , "dropWhen" -:: signalOf bool ==>a==> signalOf a ==> signalOf a
103 , "dropRepeats" -:: signalOf a ==> signalOf a
104 , "sampleOn" -:: signalOf a ==> signalOf b ==> signalOf b
105 ]
107concreteSignals =
108 [ "keysDown" -: signalOf (listOf int)
109 , "charPressed" -: signalOf (maybeOf int)
110 , "inRange" -: int ==> int ==> signalOf int
111 , timeScheme "every" (\t -> t ==> signalOf t)
112 , timeScheme "before" (\t -> t ==> signalOf bool)
113 , timeScheme "after" (\t -> t ==> signalOf bool)
114 , "dimensions" -: signalOf point
115 , "position" -: signalOf point
116 , "x" -: signalOf int
117 , "y" -: signalOf int
118 , "isDown" -: signalOf bool
119 , "isClicked" -: signalOf bool
120 , "textField" -: string ==> tupleOf [element, signalOf string]
121 , "password" -: string ==> tupleOf [element, signalOf string]
122 , "textArea" -: int ==> int ==> tupleOf [element, signalOf string]
123 , "checkBox" -: bool ==> tupleOf [element, signalOf bool]
124 , "button" -: string ==> tupleOf [element, signalOf bool]
125 , "stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
126 ]
128-------- Math and Binops --------
130binop t = t ==> t ==> t
131scheme1 super t name = (name, Forall [0] [VarT 0 :<: super] (t (VarT 0)))
132numScheme t name = scheme1 number t name
133timeScheme name t = scheme1 time t name
134twoNums f name =
135 (,) name . Forall [0,1] [ VarT 0 :<: number, VarT 1 :<: number ] $
136 f (VarT 0) (VarT 1)
138math =
139 map (numScheme (\t -> t ==> binop t)) ["clamp"] ++
140 map (numScheme (\t -> binop t)) ["+","-","*","max","min"] ++
141 [ numScheme (\t -> t ==> t) "abs" ] ++
142 hasType (binop float) [ "/", "logBase" ] ++
143 hasType (binop int) ["rem","div","mod"] ++
144 hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"] ++
145 hasType float ["pi","e"] ++
146 hasType (int ==> float) ["toFloat","castIntToFloat"] ++
147 hasType (float ==> int) ["round","floor","ceiling","truncate"]
149bools =
150 [ "not" -: bool ==> bool ] ++
151 hasType (binop bool) ["&&","||"] ++
152 map (scheme1 comparable (\t -> t ==> t ==> bool)) ["<",">","<=",">="] ++
153 [ ( "compare"
154 , Forall [0,1] [ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) )
155 ]
157-------- Polymorphic Functions --------
159var = VarT `liftM` guid
160vars n = mapM (const var) [1..n]
162infix 8 -::
163name -:: tipe = (name, Forall [1,2,3] [] tipe)
165[a,b,c] = map VarT [1,2,3]
167funcs =
168 [ "id" -:: a ==> a
169 , "==" -:: a ==> a ==> bool
170 , "/=" -:: a ==> a ==> bool
171 , "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
172 , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
173 , "$" -:: (a ==> b) ==> a ==> b
174 , ":" -:: a ==> listOf a ==> listOf a
175 , (,) "++" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0
176 , "Cons" -:: a ==> listOf a ==> listOf a
177 , "Nil" -:: listOf a
178 , "Just" -:: a ==> maybeOf a
179 , "Nothing" -:: maybeOf a
180 , "elmRange" -:: int ==> int ==> listOf int
181 ]
183lists =
184 [ "and" -:: listOf bool ==> bool
185 , "or" -:: listOf bool ==> bool
186 , numScheme (\n -> listOf n ==> listOf n) "sort"
187 , "head" -:: listOf a ==> a
188 , "tail" -:: listOf a ==> listOf a
189 , "length" -:: listOf a ==> int
190 , "filter" -:: (a ==> bool) ==> listOf a ==> listOf a
191 , "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
192 , "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
193 , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
194 , "forall" -:: (a ==> bool) ==> listOf a ==> bool
195 , "exists" -:: (a ==> bool) ==> listOf a ==> bool
196 , "reverse" -:: listOf a ==> listOf a
197 , "take" -:: int ==> listOf a ==> listOf a
198 , "drop" -:: int ==> listOf a ==> listOf a
199 , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]
200 , "intersperse" -:: a ==> listOf a ==> listOf a
201 , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
202 , "map" -:: (a ==> b) ==> listOf a ==> listOf b
203 , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
204 , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
205 , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b
206 , (,) "concat" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $
207 listOf (VarT 0) ==> VarT 0
208 , (,) "concatMap" . Forall [0,1,2] [ VarT 0 :<: appendable (VarT 1) ] $
209 (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0
210 , (,) "intercalate" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $
211 VarT 0 ==> listOf (VarT 0) ==> VarT 0
212 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
213 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
214 , "maximum", "minimum" ]
217-------- Everything --------
219hints =
220 concat [ funcs, lists, signals, math, bools, str2elem, textAttrs
221 , elements, directions, colors, lineTypes, shapes
222 , concreteSignals, casts, polyCasts
223 ]