git.iko.soy/elk
on 5ba2f27 help sign in
elk/src/Types/Hints.hs
117 lines 4.2 kB history raw
2module Hints (hints) where
4import Control.Monad (liftM,mapM)
5import Control.Arrow (first)
6import Types
7import Guid
9element = ADT "Element" []
10direction = ADT "Direction" []
11text = ADT "Text" []
12listOf t = ADT "List" [t]
13tuple2 a b = ADT "Tuple2" [a,b]
14string = listOf CharT
16infixr ==>
17t1 ==> t2 = LambdaT t1 t2
19infix 8 -:
20name -: tipe = (,) name tipe
22hasType t = map (-: t)
24-------- Text and Elements --------
26str2elem = hasType (string ==> element) [ "image","video","plainText" ]
28textToText = ["header", "italic", "bold", "underline"
29 , "overline", "strikeThrough", "monospace" ]
31textAttrs = [ "toText" -: string ==> text
32 , "link" -: string ==> text ==> text
33 , "height" -: IntT ==> text ==> text
34 ] ++ hasType (text ==> text) textToText
36elements = let iee = IntT ==> element ==> element in
37 [ "flow" -: direction ==> listOf element ==> element
38 , "opacity" -: iee
39 , "width" -: iee
40 , "height" -: iee
41 , "size" -: IntT ==> iee
42 , "box" -: iee
43 ]
46-------- Math and Binops --------
48iii = IntT ==> IntT ==> IntT
49xxb x = x ==> x ==> BoolT
51math =
52 hasType (IntT ==> iii) ["clamp"] ++
53 hasType iii ["+", "-", "*", "/","rem","mod","logBase","max","min"] ++
54 hasType (IntT ==> IntT) ["sin","cos","tan","asin","acos","atan","sqrt","abs"]
56bool =
57 [ "not" -: BoolT ==> BoolT ] ++
58 hasType (xxb BoolT) ["&&","||"] ++
59 hasType (xxb IntT) ["==","/=","<",">","<=",">="]
62-------- Polymorphic Functions --------
64var = VarT `liftM` guid
65vars n = mapM (const var) [1..n]
67infix 8 -::
68name -:: tipe = return $ name -: tipe
70funcs = sequence
71 [ do a <- var ; "id" -:: a ==> a
72 , do [a,b,c] <- vars 3 ; "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
73 , do [a,b,c] <- vars 3 ; "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
74 , do [a,b] <- vars 2 ; "$" -:: (a ==> b) ==> a ==> b
75 , do a <- var ; ":" -:: a ==> listOf a ==> listOf a
76 , do a <- var ; "++" -:: listOf a ==> listOf a ==> listOf a
77 , do a <- var ; "Cons" -:: a ==> listOf a ==> listOf a
78 , do a <- var ; "Nil" -:: listOf a
79 , do a <- var ; "Just" -:: a ==> ADT "Maybe" [a]
80 , do a <- var ; "Nothing" -:: ADT "Maybe" [a]
81 , "elmRange" -:: IntT ==> IntT ==> listOf IntT
82 ]
84ints = map (-: (listOf IntT ==> IntT)) [ "sum","product","maximum","minimum" ]
86lists = liftM (map (first ("List."++)) . (++ints)) . sequence $
87 [ "and" -:: listOf BoolT ==> BoolT
88 , "or" -:: listOf BoolT ==> BoolT
89 , "sort" -:: listOf IntT ==> listOf IntT
90 , do a <- var ; "head" -:: listOf a ==> a
91 , do a <- var ; "tail" -:: listOf a ==> listOf a
92 , do a <- var ; "length" -:: listOf a ==> IntT
93 , do a <- var ; "filter" -:: (a ==> BoolT) ==> listOf a ==> listOf a
94 , do a <- var ; "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
95 , do a <- var ; "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
96 , do a <- var ; "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
97 , do a <- var ; "forall" -:: (a ==> BoolT) ==> listOf a ==> BoolT
98 , do a <- var ; "exists" -:: (a ==> BoolT) ==> listOf a ==> BoolT
99 , do a <- var ; "concat" -:: listOf (listOf a) ==> listOf a
100 , do a <- var ; "reverse" -:: listOf a ==> listOf a
101 , do a <- var ; "intersperse" -:: a ==> listOf a ==> listOf a
102 , do a <- var ; "intercalate" -:: listOf a ==> listOf(listOf a) ==> listOf a
103 , do [a,b] <- vars 2 ; "zip" -:: listOf a ==>listOf b ==>listOf(tuple2 a b)
104 , do [a,b] <- vars 2 ; "map" -:: (a ==> b) ==> listOf a ==> listOf b
105 , do [a,b] <- vars 2 ; "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
106 , do [a,b] <- vars 2 ; "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
107 , do [a,b] <- vars 2 ; "scanl" -:: (a==>b==>b)==>b==>listOf a==>listOf b
108 , do [a,b] <- vars 2 ; "concatMap" -:: (a==>listOf b)==>listOf a ==> listOf b
109 , do [a,b,c] <- vars 3
110 "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
111 ]
114-------- Everything --------
116hints = do fs <- funcs ; ls <- lists
117 return $ fs ++ ls ++ str2elem ++ textAttrs ++ elements ++ math ++ bool