git.iko.soy/elk
on 727d708 help sign in
elk/compiler/Parse/Declaration.hs
134 lines 4.6 kB history raw
2module Parse.Declaration where
4import Control.Applicative ((<$>), (<*>))
5import qualified Data.List as List
6import Text.Parsec hiding (newline,spaces)
7import Text.Parsec.Indent
8import qualified Text.Pandoc as Pan
10import Parse.Helpers
11import qualified Parse.Expression as Expr
12import qualified SourceSyntax.Type as T
13import qualified Parse.Type as Type
14import SourceSyntax.Declaration (Declaration(..), Assoc(..))
16import Unique
18declaration :: IParser (Declaration t v)
19declaration = alias <|> datatype <|> infixDecl <|> foreignDef <|> definition
21definition :: IParser (Declaration t v)
22definition = Definition <$> Expr.def
24alias :: IParser (Declaration t v)
25alias = do
26 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
27 forcedWS
28 alias <- capVar
29 args <- spacePrefix lowVar
30 whitespace ; string "=" ; whitespace
31 tipe <- Type.expr
32 return (TypeAlias alias args tipe)
34datatype :: IParser (Declaration t v)
35datatype = do
36 reserved "data" <?> "datatype definition (data T = A | B | ...)"
37 forcedWS
38 name <- capVar <?> "name of data-type"
39 args <- spacePrefix lowVar
40 whitespace ; string "=" ; whitespace
41 tcs <- pipeSep1 Type.constructor
42 return $ Datatype name args tcs
45infixDecl :: IParser (Declaration t v)
46infixDecl = do
47 assoc <- choice [ reserved "infixl" >> return L
48 , reserved "infix" >> return N
49 , reserved "infixr" >> return R ]
50 whitespace
51 n <- digit
52 forcedWS
53 Fixity assoc (read [n]) <$> anyOp
56foreignDef :: IParser (Declaration t v)
57foreignDef = do
58 try (reserved "foreign")
59 whitespace
60 importEvent <|> exportEvent
62exportEvent :: IParser (Declaration t v)
63exportEvent = do
64 try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace
65 eventName <- jsVar
66 whitespace
67 elmVar <- lowVar
68 whitespace ; hasType ; whitespace
69 tipe <- Type.expr
70 case tipe of
71 T.Data "Signal" [t] ->
72 case isExportable t of
73 Nothing -> return (ExportEvent eventName elmVar tipe)
74 Just err -> error err
75 _ -> error "When importing foreign events, the imported value must have type Signal."
77importEvent :: IParser (Declaration t v)
78importEvent = do
79 try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace
80 eventName <- jsVar
81 whitespace
82 baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"
83 whitespace
84 elmVar <- lowVar <?> "Name of imported signal"
85 whitespace ; hasType ; whitespace
86 tipe <- Type.expr
87 case tipe of
88 T.Data "Signal" [t] ->
89 case isExportable t of
90 Nothing -> return (ImportEvent eventName baseValue elmVar tipe)
91 Just err -> error err
92 _ -> error "When importing foreign events, the imported value must have type Signal."
94jsVar :: IParser String
95jsVar = betwixt '"' '"' $ do
96 v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')
97 if v `notElem` jsReserveds then return v else
98 error $ "'" ++ v ++
99 "' is not a good name for a importing or exporting JS values."
101jsReserveds :: [String]
102jsReserveds =
103 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
104 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
105 , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
106 , "transient", "synchronized", "function", "break", "case", "catch"
107 , "continue", "debugger", "default", "delete", "do", "else", "finally"
108 , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
109 , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
110 , "const", "enum", "export", "extends", "import", "super", "implements"
111 , "interface", "let", "package", "private", "protected", "public"
112 , "static", "yield"
113 ]
115isExportable tipe =
116 case tipe of
117 T.Lambda _ _ ->
118 Just $ "Elm's JavaScript event interface does not yet handle functions. " ++
119 "Only simple values can be imported and exported in this release."
121 T.Data "JSArray" [t] -> isExportable t
123 T.Data name []
124 | name `elem` jsTypes -> Nothing
125 | otherwise -> Just $ "'" ++ name ++ "' is not an exportable type." ++ msg
127 T.Data name _ ->
128 Just $ "'" ++ name ++ "' is not an exportable type " ++
129 "constructor. Only 'JSArray' is an exportable container."
131 T.Var _ -> Just $ "Cannot export type variables." ++ msg
132 where
133 msg = " The following types are exportable: " ++ List.intercalate ", " jsTypes
134 jsTypes = ["JSString","JSNumber","JSDomNode","JSBool","JSObject"]