forked from purescript/purescript
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathTypes.hs
More file actions
128 lines (108 loc) · 3.94 KB
/
Types.hs
File metadata and controls
128 lines (108 loc) · 3.94 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
module Language.PureScript.Parser.Types
( parseType
, parsePolyType
, noWildcards
, parseTypeAtom
) where
import Prelude.Compat
import Control.Monad (when, unless)
import Control.Applicative ((<|>))
import qualified Data.Text as T
import Language.PureScript.AST.SourcePos
import Language.PureScript.Environment
import Language.PureScript.Parser.Common
import Language.PureScript.Parser.Kinds
import Language.PureScript.Parser.Lexer
import Language.PureScript.Types
import Language.PureScript.Label (Label(..))
import qualified Text.Parsec as P
import qualified Text.Parsec.Expr as P
parseFunction :: TokenParser Type
parseFunction = parens rarrow *> return tyFunction
parseObject :: TokenParser Type
parseObject = braces $ TypeApp tyRecord <$> parseRow
parseTypeLevelString :: TokenParser Type
parseTypeLevelString = TypeLevelString <$> stringLiteral
parseTypeWildcard :: TokenParser Type
parseTypeWildcard = do
start <- P.getPosition
let end = P.incSourceColumn start 1
underscore
return $ TypeWildcard (SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end))
parseTypeVariable :: TokenParser Type
parseTypeVariable = do
ident <- identifier
when (ident `elem` reservedTypeNames) $ P.unexpected (T.unpack ident)
return $ TypeVar ident
parseTypeConstructor :: TokenParser Type
parseTypeConstructor = TypeConstructor <$> parseQualified typeName
parseForAll :: TokenParser Type
parseForAll = mkForAll <$> ((reserved "forall" <|> reserved "∀") *> P.many1 (indented *> identifier) <* indented <* dot)
<*> parseType
-- |
-- Parse a type as it appears in e.g. a data constructor
--
parseTypeAtom :: TokenParser Type
parseTypeAtom = indented *> P.choice
[ P.try parseFunction
, parseTypeLevelString
, parseObject
, parseTypeWildcard
, parseForAll
, parseTypeVariable
, parseTypeConstructor
-- This try is needed due to some unfortunate ambiguities between rows and kinded types
, P.try (parens parseRow)
, ParensInType <$> parens parsePolyType
]
parseConstrainedType :: TokenParser Type
parseConstrainedType = do
constraints <- P.try (return <$> parseConstraint) <|> parens (commaSep1 parseConstraint)
_ <- rfatArrow
indented
ty <- parseType
return $ ConstrainedType constraints ty
where
parseConstraint = do
className <- parseQualified properName
indented
ty <- P.many parseTypeAtom
return (Constraint className ty Nothing)
parseAnyType :: TokenParser Type
parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable (P.try parseConstrainedType <|> parseTypeAtom)) P.<?> "type"
where
operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]
, [ P.Infix (P.try (parseQualified parseOperator) >>= \ident ->
return (BinaryNoParensType (TypeOp ident))) P.AssocRight
]
, [ P.Infix (rarrow *> return function) P.AssocRight ]
]
postfixTable = [ \t -> KindedType t <$> (indented *> doubleColon *> parseKind)
]
-- |
-- Parse a monotype
--
parseType :: TokenParser Type
parseType = do
ty <- parseAnyType
unless (isMonoType ty) $ P.unexpected "polymorphic type"
return ty
-- |
-- Parse a polytype
--
parsePolyType :: TokenParser Type
parsePolyType = parseAnyType
-- |
-- Parse an atomic type with no wildcards
--
noWildcards :: TokenParser Type -> TokenParser Type
noWildcards p = do
ty <- p
when (containsWildcards ty) $ P.unexpected "type wildcard"
return ty
parseNameAndType :: TokenParser t -> TokenParser (Label, t)
parseNameAndType p = (,) <$> (indented *> (Label <$> parseLabel) <* indented <* doubleColon) <*> p
parseRowEnding :: TokenParser Type
parseRowEnding = P.option REmpty $ indented *> pipe *> indented *> parseType
parseRow :: TokenParser Type
parseRow = (curry rowFromList <$> commaSep (parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"