git.iko.soy/elk
on c19392f help sign in
elk/src/Parse/Declaration.hs
163 lines 4.4 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Declaration
4 ( declaration
5 )
6 where
9import Data.Text (Text)
10import qualified Data.Text.Encoding as Text
12import qualified AST.Expression.Source as Src
13import qualified AST.Pattern as Pattern
14import qualified AST.Type as Type
15import qualified Parse.Expression as Expr
16import qualified Parse.Pattern as Pattern
17import Parse.Primitives
18import qualified Parse.Primitives.Keyword as Keyword
19import qualified Parse.Primitives.Symbol as Symbol
20import qualified Parse.Primitives.Variable as Var
21import qualified Parse.Primitives.Whitespace as W
22import qualified Parse.Type as Type
23import qualified Reporting.Annotation as A
24import qualified Reporting.Error.Syntax as E
25import qualified Reporting.Region as R
29-- DECLARATION
32declaration :: SParser Src.Decl
33declaration =
34 hint E.Decl $
35 do start <- getPosition
36 oneOf
37 [ doc_ start
38 , type_ start
39 , port_ start
40 , def_ start
41 ]
45-- DOC COMMENTS
48{-# INLINE doc_ #-}
49doc_ :: R.Position -> SParser Src.Decl
50doc_ start =
51 do doc <- W.docComment
52 end <- getPosition
53 pos <- W.whitespace
54 return ( A.at start end (Src.Docs (Text.decodeUtf8 doc)), end, pos )
58-- DEFINITION and ANNOTATION
61{-# INLINE def_ #-}
62def_ :: R.Position -> SParser Src.Decl
63def_ start =
64 do name <- Var.lower
65 nameEnd <- getPosition
66 let locatedName = A.at start nameEnd name
67 spaces
68 oneOf
69 [ do Symbol.hasType
70 inContext start (E.Annotation name) $
71 do spaces
72 (tipe, end, space) <- Type.expression
73 return ( A.at start end (Src.Annotation locatedName tipe), end, space )
74 , inContext start (E.Definition name) $
75 definitionHelp start locatedName []
76 ]
79definitionHelp :: R.Position -> A.Located Text -> [Pattern.Raw] -> SParser Src.Decl
80definitionHelp start name revArgs =
81 oneOf
82 [ do arg <- hint E.Arg Pattern.term
83 spaces
84 definitionHelp start name (arg : revArgs)
85 , do Symbol.equals
86 spaces
87 (body, end, space) <- Expr.expression
88 let def = A.at start end (Src.Definition name (reverse revArgs) body)
89 return ( def, end, space )
90 ]
94-- TYPE ALIAS and UNION TYPES
97{-# INLINE type_ #-}
98type_ :: R.Position -> SParser Src.Decl
99type_ start =
100 do Keyword.type_
101 spaces
102 oneOf
103 [ do Keyword.alias_
104 inContext start E.TypeAlias $
105 do spaces
106 (name, args) <- nameArgsEquals
107 (tipe, end, pos) <- Type.expression
108 return ( A.at start end (Src.Alias name args tipe), end, pos )
109 , inContext start E.TypeUnion $
110 do (name, args) <- nameArgsEquals
111 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
112 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace
113 return ( A.at start end (Src.Union name args ctors), end, pos )
114 ]
117nameArgsEquals :: Parser (A.Located Text, [A.Located Text])
118nameArgsEquals =
119 do name <- addLocation Var.upper
120 spaces
121 nameArgsEqualsHelp name []
124nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])
125nameArgsEqualsHelp name args =
126 oneOf
127 [ do arg <- addLocation Var.lower
128 spaces
129 nameArgsEqualsHelp name (arg:args)
130 , do Symbol.equals
131 spaces
132 return ( name, reverse args )
133 ]
136chompConstructors :: [(A.Located Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(A.Located Text, [Type.Raw])]
137chompConstructors ctors end pos =
138 oneOf
139 [ do checkSpace pos
140 Symbol.pipe
141 spaces
142 (ctor, newEnd, newSpace) <- Type.unionConstructor
143 chompConstructors (ctor:ctors) newEnd newSpace
144 , return ( reverse ctors, end, pos )
145 ]
149-- PORT
152{-# INLINE port_ #-}
153port_ :: R.Position -> SParser Src.Decl
154port_ start =
155 do Keyword.port_
156 inContext start E.Port $
157 do spaces
158 name <- addLocation Var.lower
159 spaces
160 Symbol.hasType
161 spaces
162 (tipe, end, pos) <- Type.expression
163 return ( A.at start end (Src.Port name tipe), end, pos )