git.iko.soy/elk
on 46cb69f help sign in
elk/elm/src/Types/Types.hs
93 lines 2.5 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" ])
55jsBool = tipe "JSBool"
56jsNumber = tipe "JSNumber"
57jsString = tipe "JSString"
58jsElement = tipe "JSElement"
59jsArray t = ADT "JSArray" [t]
60jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
61jsonValue = tipe "JsonValue"
62jsonObject = tipe "JsonObject"
64infixr ==>
65t1 ==> t2 = LambdaT t1 t2
67infix 8 -:
68name -: tipe = (,) name $ Forall [] [] tipe
70hasType t = map (-: t)
72parens = ("("++) . (++")")
74instance Show Type where
75 show t =
76 case t of
77 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
78 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
79 ; VarT x -> 't' : show x
80 ; ADT "List" [ADT "Char" []] -> "String"
81 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
82 ; ADT name cs ->
83 if isTupleString name
84 then parens . intercalate "," $ map show cs
85 else case cs of [] -> name
86 _ -> parens $ name ++ " " ++ unwords (map show cs)
87 }
89instance Show SuperType where
90 show (SuperType n ts) = "" ++ n ++ " (a type in {" ++ subs ++ "})"
91 where subs = intercalate "," . map show $ Set.toList ts
93isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)