git.iko.soy/elk
on cbecda2 help sign in
elk/elm/src/Types/Hints.hs
204 lines 8.7 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 , "Text.height" -: IntT ==> text ==> text
20 ] ++ hasType (text ==> text) textToText
22elements = let iee = IntT ==> element ==> element in
23 [ "flow" -: direction ==> listOf element ==> element
24 , "layers" -: listOf element ==> element
25 , "text" -: text ==> element
26 , "opacity" -: iee
27 , "width" -: iee
28 , "height" -: iee
29 , "size" -: IntT ==> iee
30 , "box" -: iee
31 , "centeredText" -: text ==> element
32 , "justifiedText" -: text ==> element
33 , "collage" -: IntT ==> IntT ==> listOf form ==> element
34 ]
36directions = hasType direction ["up","down","left","right","inward","outward"]
37colors = [ "rgb" -: IntT ==> IntT ==> IntT ==> color
38 , "rgba" -: IntT ==> IntT ==> IntT ==> IntT ==> color
39 ] ++ hasType color ["red","green","blue","black","white"]
41lineTypes = [ "line" -: listOf point ==> line
42 , "customLine" -: listOf IntT ==> color ==> line ==> form
43 ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]
45shapes = [ "polygon" -: listOf point ==> point ==> shape
46 , "filled" -: color ==> shape ==> form
47 , "outlined" -: color ==> shape ==> form
48 , "customOutline" -: listOf IntT ==> color ==> shape ==> form
49 ] ++ hasType (IntT ==> IntT ==> point ==> shape) ["ngon","rect","oval"]
52-------- Foreign --------
54casts =
55 [ "castJSBoolToBool" -: jsBool ==> BoolT
56 , "castBoolToJSBool" -: BoolT ==> jsBool
57 , "castJSNumberToInt" -: jsNumber ==> IntT
58 , "castIntToJSNumber" -: IntT ==> jsNumber
59 , "castJSElementToElement" -: IntT ==> IntT ==> jsElement ==> element
60 , "castElementToJSElement" -: element ==> jsElement
61 , "castJSStringToString" -: jsString ==> string
62 , "castStringToJSString" -: string ==> jsString
63 -- , "castJSNumberToFloat -:
64 -- , "castFloatToJSNumber -:
65 ]
67polyCasts = sequence
68 [ do a <- var ; "castJSArrayToList" -:: jsArray a ==> listOf a
69 , do a <- var ; "castListToJSArray" -:: listOf a ==> jsArray a
70 , do vs <- vars 2 ; "castTupleToJSTuple2" -:: tupleOf vs ==> jsTuple vs
71 , do vs <- vars 3 ; "castTupleToJSTuple3" -:: tupleOf vs ==> jsTuple vs
72 , do vs <- vars 4 ; "castTupleToJSTuple4" -:: tupleOf vs ==> jsTuple vs
73 , do vs <- vars 5 ; "castTupleToJSTuple5" -:: tupleOf vs ==> jsTuple vs
74 , do vs <- vars 2 ; "castJSTupleToTuple2" -:: jsTuple vs ==> tupleOf vs
75 , do vs <- vars 3 ; "castJSTupleToTuple3" -:: jsTuple vs ==> tupleOf vs
76 , do vs <- vars 4 ; "castJSTupleToTuple4" -:: jsTuple vs ==> tupleOf vs
77 , do vs <- vars 5 ; "castJSTupleToTuple5" -:: jsTuple vs ==> tupleOf vs
78 ]
81-------- Signals --------
83sig ts = fn ts ==> fn (map signalOf ts)
84 where fn = foldr1 (==>)
86signals = sequence
87 [ do ts <- vars 1 ; "constant" -:: sig ts
88 , do ts <- vars 2 ; "lift" -:: sig ts
89 , do ts <- vars 3 ; "lift2" -:: sig ts
90 , do ts <- vars 4 ; "lift3" -:: sig ts
91 , do ts <- vars 5 ; "lift4" -:: sig ts
92 , do [a,b] <- vars 2
93 "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
94 , do a <- var ; "randomize" -:: IntT ==> IntT ==> signalOf a ==> signalOf IntT
95 , do a <- var ; "count" -:: signalOf a ==> signalOf IntT
96 , do a <- var ; "keepIf" -:: (a==>BoolT) ==> a ==> signalOf a ==> signalOf a
97 , do a <- var ; "dropIf" -:: (a==>BoolT) ==> a ==> signalOf a ==> signalOf a
98 , do a <- var ; "keepWhen" -:: signalOf BoolT ==>a==> signalOf a ==> signalOf a
99 , do a <- var ; "dropWhen" -:: signalOf BoolT ==>a==> signalOf a ==> signalOf a
100 , do a <- var ; "dropRepeats" -:: signalOf a ==> signalOf a
101 ]
103concreteSignals =
104 [ "keysDown" -: signalOf (listOf IntT)
105 , "charPressed" -: signalOf (maybeOf IntT)
106 , "inRange" -: IntT ==> IntT ==> signalOf IntT
107 , "every" -: time ==> signalOf time
108 , "before" -: time ==> signalOf BoolT
109 , "after" -: time ==> signalOf BoolT
110 , "dimensions" -: signalOf point
111 , "position" -: signalOf point
112 , "x" -: signalOf IntT
113 , "y" -: signalOf IntT
114 , "isDown" -: signalOf BoolT
115 , "isClicked" -: signalOf BoolT
116 , "textField" -: string ==> tupleOf [element, signalOf string]
117 , "password" -: string ==> tupleOf [element, signalOf string]
118 , "textArea" -: IntT ==> IntT ==> tupleOf [element, signalOf string]
119 , "checkBox" -: BoolT ==> tupleOf [element, signalOf BoolT]
120 , "button" -: string ==> tupleOf [element, signalOf BoolT]
121 , "stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
122 ]
124-------- Math and Binops --------
126iii = IntT ==> IntT ==> IntT
127xxb x = x ==> x ==> BoolT
129math =
130 hasType (IntT ==> iii) ["clamp"] ++
131 hasType iii ["+", "-", "*", "/","rem","mod","logBase","max","min"] ++
132 hasType (IntT ==> IntT) ["sin","cos","tan","asin","acos","atan","sqrt","abs"]
134bool =
135 [ "not" -: BoolT ==> BoolT ] ++
136 hasType (xxb BoolT) ["&&","||"] ++
137 hasType (xxb IntT) ["<",">","<=",">="]
140-------- Polymorphic Functions --------
142var = VarT `liftM` guid
143vars n = mapM (const var) [1..n]
145infix 8 -::
146name -:: tipe = return $ name -: tipe
148funcs = sequence
149 [ do a <- var ; "id" -:: a ==> a
150 , do a <- var ; "==" -:: a ==> a ==> BoolT
151 , do a <- var ; "/=" -:: a ==> a ==> BoolT
152 , do [a,b,c] <- vars 3 ; "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
153 , do [a,b,c] <- vars 3 ; "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
154 , do [a,b] <- vars 2 ; "$" -:: (a ==> b) ==> a ==> b
155 , do a <- var ; ":" -:: a ==> listOf a ==> listOf a
156 , do a <- var ; "++" -:: a ==> a ==> a
157 , do a <- var ; "Cons" -:: a ==> listOf a ==> listOf a
158 , do a <- var ; "Nil" -:: listOf a
159 , do a <- var ; "Just" -:: a ==> ADT "Maybe" [a]
160 , do a <- var ; "Nothing" -:: ADT "Maybe" [a]
161 , "elmRange" -:: IntT ==> IntT ==> listOf IntT
162 ]
164ints = map (-: (listOf IntT ==> IntT)) [ "sum","product","maximum","minimum" ]
166lists = liftM (++ints) . sequence $
167 [ "and" -:: listOf BoolT ==> BoolT
168 , "or" -:: listOf BoolT ==> BoolT
169 , "sort" -:: listOf IntT ==> listOf IntT
170 , do a <- var ; "head" -:: listOf a ==> a
171 , do a <- var ; "tail" -:: listOf a ==> listOf a
172 , do a <- var ; "length" -:: listOf a ==> IntT
173 , do a <- var ; "filter" -:: (a ==> BoolT) ==> listOf a ==> listOf a
174 , do a <- var ; "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
175 , do a <- var ; "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
176 , do a <- var ; "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
177 , do a <- var ; "forall" -:: (a ==> BoolT) ==> listOf a ==> BoolT
178 , do a <- var ; "exists" -:: (a ==> BoolT) ==> listOf a ==> BoolT
179 , do a <- var ; "concat" -:: listOf (listOf a) ==> listOf a
180 , do a <- var ; "reverse" -:: listOf a ==> listOf a
181 , do a <- var ; "take" -:: IntT ==> listOf a ==> listOf a
182 , do a <- var ; "drop" -:: IntT ==> listOf a ==> listOf a
183 , do a <- var ; "partition" -:: (a==>BoolT)==>listOf a==>tupleOf [listOf a,listOf a]
184 , do a <- var ; "intersperse" -:: a ==> listOf a ==> listOf a
185 , do a <- var ; "intercalate" -:: listOf a ==> listOf(listOf a) ==> listOf a
186 , do [a,b] <- vars 2 ; "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
187 , do [a,b] <- vars 2 ; "map" -:: (a ==> b) ==> listOf a ==> listOf b
188 , do [a,b] <- vars 2 ; "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
189 , do [a,b] <- vars 2 ; "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
190 , do [a,b] <- vars 2 ; "scanl" -:: (a==>b==>b)==>b==>listOf a==>listOf b
191 , do [a,b] <- vars 2 ; "concatMap" -:: (a==>listOf b)==>listOf a ==> listOf b
192 , do [a,b,c] <- vars 3
193 "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
194 ]
197-------- Everything --------
199hints = do
200 fs <- funcs ; ls <- lists ; ss <- signals ; pcasts <- polyCasts
201 return $ concat [ fs, ls, ss, math, bool, str2elem, textAttrs
202 , elements, directions, colors, lineTypes, shapes
203 , concreteSignals, casts, pcasts
204 ]