git.iko.soy/elk
on 46df5ff help sign in
elk/elm/src/Types/Types.hs
94 lines 2.6 kB history raw
2module Types where
4import Data.Char (isDigit)
5import Data.List (intercalate,isPrefixOf)
6import qualified Data.Set as Set
8type X = Int
10data Type = LambdaT Type Type
11 | VarT X
12 | ADT String [Type]
13 deriving (Eq, Ord)
15data Scheme = Forall [X] [Constraint] Type deriving (Eq, Ord, Show)
17data SuperType = SuperType String (Set.Set Type) deriving (Eq, Ord)
19data Constraint = Type :=: Type
20 | Type :<: SuperType
21 | Type :<<: Scheme
22 deriving (Eq, Ord, Show)
24tipe t = ADT t []
27int = tipe "Int"
28float = tipe "Float"
29number = SuperType "Number" (Set.fromList [ int, float ])
31char = tipe "Char"
32bool = tipe "Bool"
34string = listOf char -- tipe "String"
35text = tipe "Text"
37time = SuperType "Time" (Set.fromList [ int, float, tipe "Number" ])
39element = tipe "Element"
40direction = tipe "Direction"
41form = tipe "Form"
42line = tipe "Line"
43shape = tipe "Shape"
44color = tipe "Color"
46listOf t = ADT "List" [t]
47signalOf t = ADT "Signal" [t]
48tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
49maybeOf t = ADT "Maybe" [t]
50pairOf t = tupleOf [t,t]
51point = pairOf int
52appendable t = SuperType "Appendable" (Set.fromList [ string, text, listOf t ])
53comparable = SuperType "Comparable" (Set.fromList [ int, float, char, string, tipe "Number", tipe "Time" ])
54transformable = SuperType "Transformable" (Set.fromList [ shape, line ])
56jsBool = tipe "JSBool"
57jsNumber = tipe "JSNumber"
58jsString = tipe "JSString"
59jsElement = tipe "JSElement"
60jsArray t = ADT "JSArray" [t]
61jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
62jsonValue = tipe "JsonValue"
63jsonObject = tipe "JsonObject"
65infixr ==>
66t1 ==> t2 = LambdaT t1 t2
68infix 8 -:
69name -: tipe = (,) name $ Forall [] [] tipe
71hasType t = map (-: t)
73parens = ("("++) . (++")")
75instance Show Type where
76 show t =
77 case t of
78 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
79 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
80 ; VarT x -> 't' : show x
81 ; ADT "List" [ADT "Char" []] -> "String"
82 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
83 ; ADT name cs ->
84 if isTupleString name
85 then parens . intercalate "," $ map show cs
86 else case cs of [] -> name
87 _ -> parens $ name ++ " " ++ unwords (map show cs)
88 }
90instance Show SuperType where
91 show (SuperType n ts) = "" ++ n ++ " (a type in {" ++ subs ++ "})"
92 where subs = intercalate "," . map show $ Set.toList ts
94isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)