never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 module Parse.Type where
3
4 import Text.Parsec ((<|>), (<?>), char, many1, string, try, optionMaybe)
5
6 import Parse.Helpers
7 import Reporting.Annotation (Located)
8 import qualified Reporting.Annotation as A
9 import AST.V0_16
10 import AST.Structure
11 import Data.Coapplicative
12 import qualified Data.Indexed as I
13 import ElmVersion
14 import Parse.IParser
15 import Parse.Common
16
17
18 tvar :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'TypeNK)
19 tvar elmVersion =
20 fmap I.Fix $ addLocation
21 (TypeVariable <$> lowVar elmVersion <?> "a type variable")
22
23
24 tuple :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
25 tuple elmVersion =
26 fmap I.Fix $ addLocation $ checkMultiline $
27 do types <- parens'' (withEol $ expr elmVersion)
28 return $
29 case types of
30 Left comments ->
31 \_ -> UnitType comments
32 Right [] ->
33 \_ -> UnitType []
34 Right [C ([], []) (C Nothing t)] ->
35 \_ -> extract $ I.unFix t
36 Right [C (pre, post) (C eol t)] ->
37 \_ -> TypeParens $ C (pre, eolToComment eol ++ post) t
38 Right types' ->
39 TupleType $ fmap (\(C (pre, post) (C eol t)) -> C (pre, post, eol) t) types'
40
41
42 record :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
43 record elmVersion =
44 fmap I.Fix $ addLocation $ brackets' $ checkMultiline $
45 do
46 base' <- optionMaybe $ try (commented (lowVar elmVersion) <* string "|")
47 (fields', trailing) <- sectionedGroup (pair (lowVar elmVersion) lenientHasType (expr elmVersion))
48 return $ RecordType base' fields' trailing
49
50
51 capTypeVar :: ElmVersion -> IParser [UppercaseIdentifier]
52 capTypeVar elmVersion =
53 dotSep1 (capVar elmVersion)
54
55
56 constructor0 :: ElmVersion -> IParser (TypeConstructor ([UppercaseIdentifier], UppercaseIdentifier))
57 constructor0 elmVersion =
58 do name <- capTypeVar elmVersion
59 case reverse name of
60 [] -> error "Impossible empty TypeConstructor name"
61 last':rest' ->
62 return (NamedConstructor (reverse rest', last'))
63
64
65 constructor0' :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
66 constructor0' elmVersion =
67 fmap I.Fix $ addLocation $ checkMultiline $
68 do ctor <- constructor0 elmVersion
69 return (TypeConstruction ctor [])
70
71
72 term :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
73 term elmVersion =
74 tuple elmVersion <|> record elmVersion <|> tvar elmVersion <|> constructor0' elmVersion
75
76
77 tupleCtor :: IParser (TypeConstructor ns)
78 tupleCtor =
79 do ctor <- parens' (many1 (char ','))
80 return (TupleConstructor (length ctor + 1))
81
82
83 app :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
84 app elmVersion =
85 fmap I.Fix $ addLocation $ checkMultiline $
86 do f <- constructor0 elmVersion <|> try tupleCtor <?> "a type constructor"
87 args <- spacePrefix (term elmVersion)
88 return $ TypeConstruction f args
89
90
91 expr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
92 expr elmVersion =
93 do
94 result <- separated rightArrow (app elmVersion <|> term elmVersion)
95 return $
96 case result of
97 Left t ->
98 t
99 Right (region, first', rest', multiline) ->
100 I.Fix $ A.A region $ FunctionType first' rest' (ForceMultiline multiline)
101
102
103 -- TODO: can this be removed? (tag is the new name?)
104 constructor :: ElmVersion -> IParser ([UppercaseIdentifier], [C1 before (ASTNS Located [UppercaseIdentifier] 'TypeNK)])
105 constructor elmVersion =
106 (,) <$> (capTypeVar elmVersion<?> "another type constructor")
107 <*> spacePrefix (term elmVersion)
108
109
110 tag :: ElmVersion -> IParser (NameWithArgs UppercaseIdentifier (ASTNS Located [UppercaseIdentifier] 'TypeNK))
111 tag elmVersion =
112 NameWithArgs
113 <$> (capVar elmVersion <?> "another type constructor")
114 <*> spacePrefix (term elmVersion)