134 lines
4.5 KiB
Haskell
134 lines
4.5 KiB
Haskell
|
|
module Parse.Declaration where
|
|
|
|
import Control.Applicative ((<$>), (<*>))
|
|
import qualified Data.List as List
|
|
import Text.Parsec hiding (newline,spaces)
|
|
import Text.Parsec.Indent
|
|
import qualified Text.Pandoc as Pan
|
|
|
|
import Parse.Helpers
|
|
import qualified Parse.Expression as Expr
|
|
import qualified SourceSyntax.Type as T
|
|
import qualified Parse.Type as Type
|
|
import SourceSyntax.Declaration (Declaration(..), Assoc(..))
|
|
|
|
import Unique
|
|
|
|
declaration :: IParser (Declaration t v)
|
|
declaration = alias <|> datatype <|> infixDecl <|> foreignDef <|> definition
|
|
|
|
definition :: IParser (Declaration t v)
|
|
definition = Definition <$> Expr.def
|
|
|
|
alias :: IParser (Declaration t v)
|
|
alias = do
|
|
reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
|
|
forcedWS
|
|
alias <- capVar
|
|
args <- spacePrefix lowVar
|
|
whitespace ; string "=" ; whitespace
|
|
tipe <- Type.expr
|
|
return (TypeAlias alias args tipe)
|
|
|
|
datatype :: IParser (Declaration t v)
|
|
datatype = do
|
|
reserved "data" <?> "datatype definition (data T = A | B | ...)"
|
|
forcedWS
|
|
name <- capVar <?> "name of data-type"
|
|
args <- spacePrefix lowVar
|
|
whitespace ; string "=" ; whitespace
|
|
tcs <- pipeSep1 Type.constructor
|
|
return $ Datatype name args tcs
|
|
|
|
|
|
infixDecl :: IParser (Declaration t v)
|
|
infixDecl = do
|
|
assoc <- choice [ reserved "infixl" >> return L
|
|
, reserved "infix" >> return N
|
|
, reserved "infixr" >> return R ]
|
|
whitespace
|
|
n <- digit
|
|
forcedWS
|
|
Fixity assoc (read [n]) <$> anyOp
|
|
|
|
|
|
foreignDef :: IParser (Declaration t v)
|
|
foreignDef = do
|
|
try (reserved "foreign")
|
|
whitespace
|
|
importEvent <|> exportEvent
|
|
|
|
exportEvent :: IParser (Declaration t v)
|
|
exportEvent = do
|
|
try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace
|
|
eventName <- jsVar
|
|
whitespace
|
|
elmVar <- lowVar
|
|
whitespace ; hasType ; whitespace
|
|
tipe <- Type.expr
|
|
case tipe of
|
|
T.Data "Signal" [t] ->
|
|
case isExportable t of
|
|
Nothing -> return (ExportEvent eventName elmVar tipe)
|
|
Just err -> error err
|
|
_ -> error "When importing foreign events, the imported value must have type Signal."
|
|
|
|
importEvent :: IParser (Declaration t v)
|
|
importEvent = do
|
|
try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace
|
|
eventName <- jsVar
|
|
whitespace
|
|
baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"
|
|
whitespace
|
|
elmVar <- lowVar <?> "Name of imported signal"
|
|
whitespace ; hasType ; whitespace
|
|
tipe <- Type.expr
|
|
case tipe of
|
|
T.Data "Signal" [t] ->
|
|
case isExportable t of
|
|
Nothing -> return (ImportEvent eventName baseValue elmVar tipe)
|
|
Just err -> error err
|
|
_ -> error "When importing foreign events, the imported value must have type Signal."
|
|
|
|
jsVar :: IParser String
|
|
jsVar = betwixt '"' '"' $ do
|
|
v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')
|
|
if v `notElem` jsReserveds then return v else
|
|
error $ "'" ++ v ++
|
|
"' is not a good name for a importing or exporting JS values."
|
|
|
|
jsReserveds :: [String]
|
|
jsReserveds =
|
|
[ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
|
|
, "arguments", "int", "byte", "char", "goto", "long", "final", "float"
|
|
, "short", "double", "native", "throws", "boolean", "abstract", "volatile"
|
|
, "transient", "synchronized", "function", "break", "case", "catch"
|
|
, "continue", "debugger", "default", "delete", "do", "else", "finally"
|
|
, "for", "function", "if", "in", "instanceof", "new", "return", "switch"
|
|
, "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
|
|
, "const", "enum", "export", "extends", "import", "super", "implements"
|
|
, "interface", "let", "package", "private", "protected", "public"
|
|
, "static", "yield"
|
|
]
|
|
|
|
isExportable tipe =
|
|
case tipe of
|
|
T.Lambda _ _ ->
|
|
Just $ "Elm's JavaScript event interface does not yet handle functions. " ++
|
|
"Only simple values can be imported and exported in this release."
|
|
|
|
T.Data "JSArray" [t] -> isExportable t
|
|
|
|
T.Data name []
|
|
| name `elem` jsTypes -> Nothing
|
|
| otherwise -> Just $ "'" ++ name ++ "' is not an exportable type." ++ msg
|
|
|
|
T.Data name _ ->
|
|
Just $ "'" ++ name ++ "' is not an exportable type " ++
|
|
"constructor. Only 'JSArray' is an exportable container."
|
|
|
|
T.Var _ -> Just $ "Cannot export type variables." ++ msg
|
|
where
|
|
msg = " The following types are exportable: " ++ List.intercalate ", " jsTypes
|
|
jsTypes = ["JSString","JSNumber","JSDomNode","JSBool","JSObject"]
|