git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Parse/Declaration.hs
156 lines 3.9 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Declaration where
5import Data.Text (Text)
7import qualified AST.Declaration as Decl
8import qualified AST.Type as Type
9import qualified Parse.Expression as Expr
10import Parse.Helpers as Help
11import qualified Parse.Type as Type
12import qualified Reporting.Annotation as A
13import qualified Reporting.Error.Syntax as E
14import qualified Reporting.Region as R
18-- DECLARATION
21declaration :: SParser Decl.Source
22declaration =
23 hint E.Decl $
24 do start <- getPosition
25 oneOf
26 [ docDecl start
27 , typeDecl start
28 , infixDecl start
29 , portDecl start
30 , defDecl start
31 ]
35-- DOC COMMENTS
38docDecl :: R.Position -> SParser Decl.Source
39docDecl start =
40 do comment <- docComment
41 end <- getPosition
42 pos <- whitespace
43 return ( Decl.Comment (A.at start end comment), end, pos )
46-- TYPE ANNOTATIONS and DEFINITIONS
49defDecl :: R.Position -> SParser Decl.Source
50defDecl start =
51 do (def, end, pos) <- Expr.definition
52 let decl = A.at start end (Decl.Def def)
53 return ( Decl.Whatever decl, end, pos )
57-- TYPE ALIAS and UNION TYPES
60typeDecl :: R.Position -> SParser Decl.Source
61typeDecl start =
62 do keyword "type"
63 spaces
64 oneOf
65 [ do keyword "alias"
66 inContext start E.TypeAlias $
67 do spaces
68 (name, args) <- nameArgsEquals
69 (tipe, end, pos) <- Type.expression
70 let decl = A.at start end (Decl.Alias (Decl.Type name args tipe))
71 return ( Decl.Whatever decl, end, pos )
72 , inContext start E.TypeUnion $
73 do (name, args) <- nameArgsEquals
74 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
75 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace
76 let decl = A.at start end (Decl.Union (Decl.Type name args ctors))
77 return ( Decl.Whatever decl, end, pos )
78 ]
81nameArgsEquals :: Parser (Text, [Text])
82nameArgsEquals =
83 do name <- capVar
84 spaces
85 nameArgsEqualsHelp name []
88nameArgsEqualsHelp :: Text -> [Text] -> Parser (Text, [Text])
89nameArgsEqualsHelp name args =
90 oneOf
91 [ do arg <- lowVar
92 spaces
93 nameArgsEqualsHelp name (arg:args)
94 , do equals
95 spaces
96 return ( name, reverse args )
97 ]
100chompConstructors :: [(Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(Text, [Type.Raw])]
101chompConstructors ctors end pos =
102 oneOf
103 [ do checkSpace pos
104 pipe
105 spaces
106 (ctor, newEnd, newSpace) <- Type.unionConstructor
107 chompConstructors (ctor:ctors) newEnd newSpace
108 , return ( reverse ctors, end, pos )
109 ]
113-- INFIX
116infixDecl :: R.Position -> SParser Decl.Source
117infixDecl start =
118 oneOf
119 [ do keyword "infixl"
120 inContext start E.Infix $ infixDeclHelp start Decl.Left
121 , do keyword "infixr"
122 inContext start E.Infix $ infixDeclHelp start Decl.Right
123 , do keyword "infix"
124 inContext start E.Infix $ infixDeclHelp start Decl.Non
125 ]
128infixDeclHelp :: R.Position -> Decl.Assoc -> SParser Decl.Source
129infixDeclHelp start assoc =
130 do spaces
131 n <- digit
132 spaces
133 op <- infixOp
134 end <- getPosition
135 pos <- whitespace
136 let decl = A.at start end (Decl.Fixity (Decl.Infix op assoc n))
137 return ( Decl.Whatever decl, end, pos )
141-- FOREIGN
144portDecl :: R.Position -> SParser Decl.Source
145portDecl start =
146 do keyword "port"
147 inContext start E.Port $
148 do spaces
149 name <- lowVar
150 spaces
151 hasType
152 spaces
153 (tipe, end, pos) <- Type.expression
154 let decl = A.at start end (Decl.Port name tipe)
155 return ( Decl.Whatever decl, end, pos )