on 62bed13 help sign in
elk/src/Type/ExtraChecks.hs
78 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
3{-| This module contains checks to be run *after* type inference has completed
4successfully. At that point we still need to ensure that `main` has an
5acceptable type.
6-}
7module Type.ExtraChecks (mainType) where
9import Prelude hiding (maybe)
10import Control.Monad.Except (ExceptT, throwError)
11import qualified Data.Map as Map
13import qualified AST.Type as ST
14import qualified AST.Variable as Var
17-- MAIN TYPE
19mainType
20 :: (Monad m)
21 => Map.Map String ST.Canonical
22 -> ExceptT ST.Canonical m ()
23mainType env =
24 case Map.lookup "main" env of
25 Nothing ->
26 return ()
28 Just typeOfMain ->
29 let tipe = ST.deepDealias typeOfMain
30 in
31 if tipe `elem` validMainTypes
32 then return ()
33 else throwError typeOfMain
36validMainTypes :: [ST.Canonical]
37validMainTypes =
38 [ element
39 , html
40 , signal element
41 , signal html
42 ]
43 where
44 fromModule :: [String] -> String -> ST.Canonical
45 fromModule home name =
46 ST.Type (Var.fromModule home name)
48 html =
49 fromModule ["VirtualDom"] "Node"
51 signal tipe =
52 ST.App (fromModule ["Signal"] "Signal") [ tipe ]
54 element =
55 let builtin name =
56 ST.Type (Var.builtin name)
58 maybe tipe =
59 ST.App (fromModule ["Maybe"] "Maybe") [ tipe ]
60 in
61 ST.Record
62 [ ("element", fromModule ["Graphics","Element"] "ElementPrim")
63 , ("props",
64 ST.Record
65 [ ("click" , builtin "_Tuple0")
66 , ("color" , maybe (fromModule ["Color"] "Color"))
67 , ("height" , builtin "Int")
68 , ("hover" , builtin "_Tuple0")
69 , ("href" , builtin "String")
70 , ("id" , builtin "Int")
71 , ("opacity", builtin "Float")
72 , ("tag" , builtin "String")
73 , ("width" , builtin "Int")
74 ]
75 Nothing
76 )
77 ]
78 Nothing