git.iko.soy/rowtype-yoga/purescript-native
on 73a773e help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Declarations.hs
97 lines 3.4 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
39parseDataDeclaration :: P.Parsec String ParseState Declaration
40parseDataDeclaration = do
41 reserved "data"
42 name <- indented *> properName
43 tyArgs <- many (indented *> identifier)
44 lexeme $ indented *> P.char '='
45 ctors <- P.sepBy1 ((,) <$> (indented *> properName) <*> P.optionMaybe parseType) (lexeme $ indented *> P.char '|')
46 return $ DataDeclaration name tyArgs ctors
48parseTypeDeclaration :: P.Parsec String ParseState Declaration
49parseTypeDeclaration =
50 TypeDeclaration <$> parseIdent
51 <*> (lexeme (indented *> P.string "::") *> parsePolyType)
53parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
54parseTypeSynonymDeclaration =
55 TypeSynonymDeclaration <$> (reserved "type" *> indented *> properName)
56 <*> many (indented *> identifier)
57 <*> (lexeme (indented *> P.char '=') *> parseType)
59parseValueDeclaration :: P.Parsec String ParseState Declaration
60parseValueDeclaration =
61 ValueDeclaration <$> parseIdent
62 <*> (lexeme (indented *> P.char '=') *> parseValue)
64parseExternDeclaration :: P.Parsec String ParseState Declaration
65parseExternDeclaration =
66 ExternDeclaration <$> (reserved "extern" *> indented *> parseIdent)
67 <*> (lexeme (indented *> P.string "::") *> parsePolyType)
69parseAssociativity :: P.Parsec String ParseState Associativity
70parseAssociativity =
71 (reserved "infixl" >> return Infixl) <|>
72 (reserved "infixr" >> return Infixr)
74parseFixity :: P.Parsec String ParseState Fixity
75parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
77parseFixityDeclaration :: P.Parsec String ParseState Declaration
78parseFixityDeclaration = do
79 fixity <- parseFixity
80 indented
81 name <- operator
82 current <- fixities <$> P.getState
83 when (name `M.member` current) (P.unexpected $ "redefined fixity for " ++ show name)
84 P.modifyState $ \st -> st { fixities = M.insert name fixity current }
85 return $ FixityDeclaration fixity name
87parseDeclaration :: P.Parsec String ParseState Declaration
88parseDeclaration = P.choice $ map P.try
89 [ parseDataDeclaration
90 , parseTypeDeclaration
91 , parseTypeSynonymDeclaration
92 , parseValueDeclaration
93 , parseExternDeclaration
94 , parseFixityDeclaration ]
96parseDeclarations :: P.Parsec String ParseState [Declaration]
97parseDeclarations = whiteSpace *> mark (same *> P.many parseDeclaration) <* P.eof