git.iko.soy/rowtype-yoga/purescript-native
on f98236e help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Declarations.hs
100 lines 3.7 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : PureScript.Parser.Declarations
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15module PureScript.Parser.Declarations (
16 parseDeclaration,
17 parseDeclarations
18) where
20import Data.Char
21import Data.List
22import Data.Maybe
23import Data.Function
24import Control.Applicative
25import Control.Arrow (Arrow(..))
26import Control.Monad.State
27import qualified Data.Map as M
28import qualified Text.Parsec as P
29import qualified Text.Parsec.Pos as P
31import PureScript.Values
32import PureScript.Types
33import PureScript.Parser.State
34import PureScript.Parser.Common
35import PureScript.Declarations
36import PureScript.Parser.Values
37import PureScript.Parser.Types
38import PureScript.Parser.Kinds
40parseDataDeclaration :: P.Parsec String ParseState Declaration
41parseDataDeclaration = do
42 reserved "data"
43 name <- indented *> properName
44 tyArgs <- many (indented *> identifier)
45 lexeme $ indented *> P.char '='
46 ctors <- P.sepBy1 ((,) <$> (indented *> properName) <*> P.optionMaybe parseType) (lexeme $ indented *> P.char '|')
47 return $ DataDeclaration name tyArgs ctors
49parseTypeDeclaration :: P.Parsec String ParseState Declaration
50parseTypeDeclaration =
51 TypeDeclaration <$> parseIdent
52 <*> (lexeme (indented *> P.string "::") *> parsePolyType)
54parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
55parseTypeSynonymDeclaration =
56 TypeSynonymDeclaration <$> (reserved "type" *> indented *> properName)
57 <*> many (indented *> identifier)
58 <*> (lexeme (indented *> P.char '=') *> parseType)
60parseValueDeclaration :: P.Parsec String ParseState Declaration
61parseValueDeclaration =
62 ValueDeclaration <$> parseIdent
63 <*> (lexeme (indented *> P.char '=') *> parseValue)
65parseExternDeclaration :: P.Parsec String ParseState Declaration
66parseExternDeclaration = reserved "extern" *> indented *>
67 (ExternDataDeclaration <$> (reserved "data" *> indented *> properName)
68 <*> (lexeme (indented *> P.string "::") *> parseKind)
69 <|> ExternDeclaration <$> parseIdent
70 <*> (lexeme (indented *> P.string "::") *> parsePolyType))
72parseAssociativity :: P.Parsec String ParseState Associativity
73parseAssociativity =
74 (reserved "infixl" >> return Infixl) <|>
75 (reserved "infixr" >> return Infixr)
77parseFixity :: P.Parsec String ParseState Fixity
78parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
80parseFixityDeclaration :: P.Parsec String ParseState Declaration
81parseFixityDeclaration = do
82 fixity <- parseFixity
83 indented
84 name <- operator
85 current <- fixities <$> P.getState
86 when (name `M.member` current) (P.unexpected $ "redefined fixity for " ++ show name)
87 P.modifyState $ \st -> st { fixities = M.insert name fixity current }
88 return $ FixityDeclaration fixity name
90parseDeclaration :: P.Parsec String ParseState Declaration
91parseDeclaration = P.choice (map P.try
92 [ parseDataDeclaration
93 , parseTypeDeclaration
94 , parseTypeSynonymDeclaration
95 , parseValueDeclaration
96 , parseExternDeclaration
97 , parseFixityDeclaration ]) P.<?> "declaration"
99parseDeclarations :: P.Parsec String ParseState [Declaration]
100parseDeclarations = whiteSpace *> mark (same *> P.many parseDeclaration) <* P.eof