git.iko.soy/elk
on ea05fbe help sign in
elk/src/Types/Hints.hs
157 lines 6.3 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-------- Signals --------
54sig ts = fn ts ==> fn (map signalOf ts)
55 where fn = foldr1 (==>)
57signals = sequence
58 [ do ts <- vars 1 ; "constant" -:: sig ts
59 , do ts <- vars 2 ; "lift" -:: sig ts
60 , do ts <- vars 3 ; "lift2" -:: sig ts
61 , do ts <- vars 4 ; "lift3" -:: sig ts
62 , do ts <- vars 5 ; "lift4" -:: sig ts
63 , do [a,b] <- vars 2
64 "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
65 ]
67concreteSignals =
68 [ "Mouse.position" -: signalOf point
69 , "Mouse.x" -: signalOf IntT
70 , "Mouse.y" -: signalOf IntT
71 , "Mouse.isDown" -: signalOf BoolT
72 , "Mouse.isClicked" -: signalOf BoolT
73 , "Window.dimensions" -: signalOf point
74 , "Window.width" -: signalOf IntT
75 , "Window.height" -: signalOf IntT
76 , "Input.textField" -: string ==> tupleOf [element, signalOf string]
77 , "Input.password" -: string ==> tupleOf [element, signalOf string]
78 , "Input.textArea" -: IntT ==> IntT ==> tupleOf [element, signalOf string]
79 , "Input.stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
80 ]
82-------- Math and Binops --------
84iii = IntT ==> IntT ==> IntT
85xxb x = x ==> x ==> BoolT
87math =
88 hasType (IntT ==> iii) ["clamp"] ++
89 hasType iii ["+", "-", "*", "/","rem","mod","logBase","max","min"] ++
90 hasType (IntT ==> IntT) ["sin","cos","tan","asin","acos","atan","sqrt","abs"]
92bool =
93 [ "not" -: BoolT ==> BoolT ] ++
94 hasType (xxb BoolT) ["&&","||"] ++
95 hasType (xxb IntT) ["==","/=","<",">","<=",">="]
98-------- Polymorphic Functions --------
100var = VarT `liftM` guid
101vars n = mapM (const var) [1..n]
103infix 8 -::
104name -:: tipe = return $ name -: tipe
106funcs = sequence
107 [ do a <- var ; "id" -:: a ==> a
108 , do [a,b,c] <- vars 3 ; "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
109 , do [a,b,c] <- vars 3 ; "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
110 , do [a,b] <- vars 2 ; "$" -:: (a ==> b) ==> a ==> b
111 , do a <- var ; ":" -:: a ==> listOf a ==> listOf a
112 , do a <- var ; "++" -:: listOf a ==> listOf a ==> listOf a
113 , do a <- var ; "Cons" -:: a ==> listOf a ==> listOf a
114 , do a <- var ; "Nil" -:: listOf a
115 , do a <- var ; "Just" -:: a ==> ADT "Maybe" [a]
116 , do a <- var ; "Nothing" -:: ADT "Maybe" [a]
117 , "elmRange" -:: IntT ==> IntT ==> listOf IntT
118 ]
120ints = map (-: (listOf IntT ==> IntT)) [ "sum","product","maximum","minimum" ]
122lists = liftM (map (first ("List."++)) . (++ints)) . sequence $
123 [ "and" -:: listOf BoolT ==> BoolT
124 , "or" -:: listOf BoolT ==> BoolT
125 , "sort" -:: listOf IntT ==> listOf IntT
126 , do a <- var ; "head" -:: listOf a ==> a
127 , do a <- var ; "tail" -:: listOf a ==> listOf a
128 , do a <- var ; "length" -:: listOf a ==> IntT
129 , do a <- var ; "filter" -:: (a ==> BoolT) ==> listOf a ==> listOf a
130 , do a <- var ; "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
131 , do a <- var ; "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
132 , do a <- var ; "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
133 , do a <- var ; "forall" -:: (a ==> BoolT) ==> listOf a ==> BoolT
134 , do a <- var ; "exists" -:: (a ==> BoolT) ==> listOf a ==> BoolT
135 , do a <- var ; "concat" -:: listOf (listOf a) ==> listOf a
136 , do a <- var ; "reverse" -:: listOf a ==> listOf a
137 , do a <- var ; "intersperse" -:: a ==> listOf a ==> listOf a
138 , do a <- var ; "intercalate" -:: listOf a ==> listOf(listOf a) ==> listOf a
139 , do [a,b] <- vars 2 ; "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
140 , do [a,b] <- vars 2 ; "map" -:: (a ==> b) ==> listOf a ==> listOf b
141 , do [a,b] <- vars 2 ; "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
142 , do [a,b] <- vars 2 ; "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
143 , do [a,b] <- vars 2 ; "scanl" -:: (a==>b==>b)==>b==>listOf a==>listOf b
144 , do [a,b] <- vars 2 ; "concatMap" -:: (a==>listOf b)==>listOf a ==> listOf b
145 , do [a,b,c] <- vars 3
146 "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
147 ]
150-------- Everything --------
152hints = do
153 fs <- funcs ; ls <- lists ; ss <- signals
154 return $ concat [ fs, ls, ss, math, bool, str2elem, textAttrs
155 , elements, directions, colors, lineTypes, shapes
156 , concreteSignals
157 ]