@@ -0,0 +1,79 @@
1+
2+module ParseForeign (foreignDefs) where
3+
4+import Control.Applicative ((<$>), (<*>))
5+import Data.Either (partitionEithers)
6+import Text.Parsec hiding (newline,spaces)
7+
8+import Ast
9+import ParseLib
10+import ParseExpr (term)
11+import ParseTypes
12+
13+
14+foreignDefs = option [] $ do
15+ f <- commitIf (reserved "foreign") foreign
16+ fs <- many (commitIf (freshLine >> reserved "foreign") (freshLine >> foreign))
17+ return (f:fs)
18+
19+
20+foreign = do reserved "foreign" ; whitespace ; (jsEvent <|> jsValue)
21+
22+
23+jsValue = do
24+ what <- try $ choice
25+ [ try (reserved "import" >> whitespace >>
26+ reserved "jsValue" >> whitespace >> return ImportValue)
27+ , try (reserved "export" >> whitespace >>
28+ reserved "jsValue" >> whitespace >> return ExportValue) ]
29+ js <- jsVar ; whitespace
30+ elm <- lowVar ; whitespace
31+ tipe <- typeExpr
32+ either fail (return . what js elm) (toForeignType tipe)
33+
34+
35+jsEvent = importEvent <|> exportEvent
36+
37+exportEvent = do
38+ try (reserved "export" >> whitespace >> reserved "jsEvent" >> whitespace)
39+ js <- jsVar ; whitespace
40+ elm <- lowVar ; whitespace
41+ string "::" ; whitespace
42+ tipe <- typeExpr
43+ case tipe of
44+ ADTPT "Signal" [pt] ->
45+ either fail (return . ExportEvent js elm) (toForeignType pt)
46+ _ -> fail "When exporting events, the exported value must be a Signal."
47+
48+importEvent = do
49+ try (reserved "import" >> whitespace >> reserved "jsEvent" >> whitespace)
50+ js <- jsVar ; whitespace
51+ base <- term ; whitespace
52+ elm <- lowVar ; whitespace
53+ string "::" ; whitespace
54+ tipe <- typeExpr
55+ case tipe of
56+ ADTPT "Signal" [pt] ->
57+ either fail (return . ImportEvent js elm base) (toForeignType pt)
58+ _ -> fail "When importing events, the imported value must be a Signal."
59+
60+
61+jsVar :: (Monad m) => ParsecT [Char] u m String
62+jsVar = betwixt '"' '"' $ do
63+ v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')
64+ if v `notElem` jsReserveds then return v else
65+ fail $ "'" ++ v ++
66+ "' is not a good name for a importing or exporting JS values."
67+
68+jsReserveds =
69+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
70+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
71+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
72+ , "transient", "synchronized", "function", "break", "case", "catch"
73+ , "continue", "debugger", "default", "delete", "do", "else", "finally"
74+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
75+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
76+ , "const", "enum", "export", "extends", "import", "super", "implements"
77+ , "interface", "let", "package", "private", "protected", "public"
78+ , "static", "yield"
79+ ]