Skip to content

Commit 9a4992a

Browse files
garybgaryb
authored
Add source spans for literals (purescript#3277)
* Add source spans for literals This fixes the IntOutOfRange error (again 😄) * Don't parenthesise flipped constructors
1 parent 96ccf1e commit 9a4992a

15 files changed

Lines changed: 101 additions & 99 deletions

File tree

‎src/Language/PureScript/AST/Binders.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ data Binder
2424
-- |
2525
-- A binder which matches a literal
2626
--
27-
| LiteralBinder (Literal Binder)
27+
| LiteralBinder SourceSpan (Literal Binder)
2828
-- |
2929
-- A binder which binds an identifier
3030
--
@@ -76,7 +76,7 @@ instance Eq Binder where
7676
(==) NullBinder NullBinder = True
7777
(==) NullBinder _ = False
7878

79-
(==) (LiteralBinder lb) (LiteralBinder lb') = (==) lb lb'
79+
(==) (LiteralBinder _ lb) (LiteralBinder _ lb') = (==) lb lb'
8080
(==) LiteralBinder{} _ = False
8181

8282
(==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'
@@ -114,7 +114,7 @@ instance Ord Binder where
114114
compare NullBinder NullBinder = EQ
115115
compare NullBinder _ = LT
116116

117-
compare (LiteralBinder lb) (LiteralBinder lb') = compare lb lb'
117+
compare (LiteralBinder _ lb) (LiteralBinder _ lb') = compare lb lb'
118118
compare LiteralBinder{} NullBinder = GT
119119
compare LiteralBinder{} _ = LT
120120

@@ -174,7 +174,7 @@ instance Ord Binder where
174174
binderNames :: Binder -> [Ident]
175175
binderNames = go []
176176
where
177-
go ns (LiteralBinder b) = lit ns b
177+
go ns (LiteralBinder _ b) = lit ns b
178178
go ns (VarBinder _ name) = name : ns
179179
go ns (ConstructorBinder _ _ bs) = foldl go ns bs
180180
go ns (BinaryNoParensBinder b1 b2 b3) = foldl go ns [b1, b2, b3]

‎src/Language/PureScript/AST/Declarations.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -697,7 +697,7 @@ data Expr
697697
-- |
698698
-- A literal value
699699
--
700-
= Literal (Literal Expr)
700+
= Literal SourceSpan (Literal Expr)
701701
-- |
702702
-- A prefix -, will be desugared
703703
--
@@ -886,7 +886,7 @@ $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Declarat
886886
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
887887

888888
isTrueExpr :: Expr -> Bool
889-
isTrueExpr (Literal (BooleanLiteral True)) = True
889+
isTrueExpr (Literal _ (BooleanLiteral True)) = True
890890
isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) = True
891891
isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) = True
892892
isTrueExpr (TypedValue _ e _) = isTrueExpr e

‎src/Language/PureScript/AST/Traversals.hs‎

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ everywhereOnValues f g h = (f', g', h')
6262
f' other = f other
6363

6464
g' :: Expr -> Expr
65-
g' (Literal l) = g (Literal (lit g' l))
65+
g' (Literal ss l) = g (Literal ss (lit g' l))
6666
g' (UnaryMinus ss v) = g (UnaryMinus ss (g' v))
6767
g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
6868
g' (Parens v) = g (Parens (g' v))
@@ -85,7 +85,7 @@ everywhereOnValues f g h = (f', g', h')
8585
h' (ConstructorBinder ss ctor bs) = h (ConstructorBinder ss ctor (fmap h' bs))
8686
h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))
8787
h' (ParensInBinder b) = h (ParensInBinder (h' b))
88-
h' (LiteralBinder l) = h (LiteralBinder (lit h' l))
88+
h' (LiteralBinder ss l) = h (LiteralBinder ss (lit h' l))
8989
h' (NamedBinder ss name b) = h (NamedBinder ss name (h' b))
9090
h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
9191
h' (TypedBinder t b) = h (TypedBinder t (h' b))
@@ -136,7 +136,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
136136
f' other = f other
137137

138138
g' :: Expr -> m Expr
139-
g' (Literal l) = Literal <$> litM (g >=> g') l
139+
g' (Literal ss l) = Literal ss <$> litM (g >=> g') l
140140
g' (UnaryMinus ss v) = UnaryMinus ss <$> (g v >>= g')
141141
g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
142142
g' (Parens v) = Parens <$> (g v >>= g')
@@ -156,7 +156,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
156156
g' other = g other
157157

158158
h' :: Binder -> m Binder
159-
h' (LiteralBinder l) = LiteralBinder <$> litM (h >=> h') l
159+
h' (LiteralBinder ss l) = LiteralBinder ss <$> litM (h >=> h') l
160160
h' (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h' <=< h) bs
161161
h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')
162162
h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')
@@ -205,7 +205,7 @@ everywhereOnValuesM f g h = (f', g', h')
205205
f' other = f other
206206

207207
g' :: Expr -> m Expr
208-
g' (Literal l) = (Literal <$> litM g' l) >>= g
208+
g' (Literal ss l) = (Literal ss <$> litM g' l) >>= g
209209
g' (UnaryMinus ss v) = (UnaryMinus ss <$> g' v) >>= g
210210
g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
211211
g' (Parens v) = (Parens <$> g' v) >>= g
@@ -225,7 +225,7 @@ everywhereOnValuesM f g h = (f', g', h')
225225
g' other = g other
226226

227227
h' :: Binder -> m Binder
228-
h' (LiteralBinder l) = (LiteralBinder <$> litM h' l) >>= h
228+
h' (LiteralBinder ss l) = (LiteralBinder ss <$> litM h' l) >>= h
229229
h' (ConstructorBinder ss ctor bs) = (ConstructorBinder ss ctor <$> traverse h' bs) >>= h
230230
h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h
231231
h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h
@@ -277,7 +277,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
277277
f' d = f d
278278

279279
g' :: Expr -> r
280-
g' v@(Literal l) = lit (g v) g' l
280+
g' v@(Literal _ l) = lit (g v) g' l
281281
g' v@(UnaryMinus _ v1) = g v <> g' v1
282282
g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
283283
g' v@(Parens v1) = g v <> g' v1
@@ -297,7 +297,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
297297
g' v = g v
298298

299299
h' :: Binder -> r
300-
h' b@(LiteralBinder l) = lit (h b) h' l
300+
h' b@(LiteralBinder _ l) = lit (h b) h' l
301301
h' b@(ConstructorBinder _ _ bs) = foldl (<>) (h b) (fmap h' bs)
302302
h' b@(BinaryNoParensBinder b1 b2 b3) = h b <> h' b1 <> h' b2 <> h' b3
303303
h' b@(ParensInBinder b1) = h b <> h' b1
@@ -358,7 +358,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
358358
g'' s v = let (s', r) = g s v in r <> g' s' v
359359

360360
g' :: s -> Expr -> r
361-
g' s (Literal l) = lit g'' s l
361+
g' s (Literal _ l) = lit g'' s l
362362
g' s (UnaryMinus _ v1) = g'' s v1
363363
g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
364364
g' s (Parens v1) = g'' s v1
@@ -381,7 +381,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
381381
h'' s b = let (s', r) = h s b in r <> h' s' b
382382

383383
h' :: s -> Binder -> r
384-
h' s (LiteralBinder l) = lit h'' s l
384+
h' s (LiteralBinder _ l) = lit h'' s l
385385
h' s (ConstructorBinder _ _ bs) = foldl (<>) r0 (fmap (h'' s) bs)
386386
h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <> h'' s b2 <> h'' s b3
387387
h' s (ParensInBinder b) = h'' s b
@@ -443,7 +443,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
443443

444444
g'' s = uncurry g' <=< g s
445445

446-
g' s (Literal l) = Literal <$> lit g'' s l
446+
g' s (Literal ss l) = Literal ss <$> lit g'' s l
447447
g' s (UnaryMinus ss v) = UnaryMinus ss <$> g'' s v
448448
g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
449449
g' s (Parens v) = Parens <$> g'' s v
@@ -464,7 +464,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
464464

465465
h'' s = uncurry h' <=< h s
466466

467-
h' s (LiteralBinder l) = LiteralBinder <$> lit h'' s l
467+
h' s (LiteralBinder ss l) = LiteralBinder ss <$> lit h'' s l
468468
h' s (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h'' s) bs
469469
h' s (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> h'' s b1 <*> h'' s b2 <*> h'' s b3
470470
h' s (ParensInBinder b) = ParensInBinder <$> h'' s b
@@ -533,7 +533,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
533533
g'' s a = g s a <> g' s a
534534

535535
g' :: S.Set Ident -> Expr -> r
536-
g' s (Literal l) = lit g'' s l
536+
g' s (Literal _ l) = lit g'' s l
537537
g' s (UnaryMinus _ v1) = g'' s v1
538538
g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
539539
g' s (Parens v1) = g'' s v1
@@ -562,7 +562,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
562562
h'' s a = h s a <> h' s a
563563

564564
h' :: S.Set Ident -> Binder -> r
565-
h' s (LiteralBinder l) = lit h'' s l
565+
h' s (LiteralBinder _ l) = lit h'' s l
566566
h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs
567567
h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]
568568
h' s (ParensInBinder b) = h'' s b

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -177,7 +177,7 @@ moduleToJs (Module coms mn _ imps exps foreigns decls) foreign_ =
177177

178178
valueToJs' :: Expr Ann -> m AST
179179
valueToJs' (Literal (pos, _, _, _) l) =
180-
rethrowWithPosition pos $ literalToValueJS l
180+
rethrowWithPosition pos $ literalToValueJS pos l
181181
valueToJs' (Var (_, _, _, Just (IsConstructor _ [])) name) =
182182
return $ accessorString "value" $ qualifiedToJS id name
183183
valueToJs' (Var (_, _, _, Just (IsConstructor _ _)) name) =
@@ -255,14 +255,14 @@ moduleToJs (Module coms mn _ imps exps foreigns decls) foreign_ =
255255
iife :: Text -> [AST] -> AST
256256
iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
257257

258-
literalToValueJS :: Literal (Expr Ann) -> m AST
259-
literalToValueJS (NumericLiteral (Left i)) = return $ AST.NumericLiteral Nothing (Left i)
260-
literalToValueJS (NumericLiteral (Right n)) = return $ AST.NumericLiteral Nothing (Right n)
261-
literalToValueJS (StringLiteral s) = return $ AST.StringLiteral Nothing s
262-
literalToValueJS (CharLiteral c) = return $ AST.StringLiteral Nothing (fromString [c])
263-
literalToValueJS (BooleanLiteral b) = return $ AST.BooleanLiteral Nothing b
264-
literalToValueJS (ArrayLiteral xs) = AST.ArrayLiteral Nothing <$> mapM valueToJs xs
265-
literalToValueJS (ObjectLiteral ps) = AST.ObjectLiteral Nothing <$> mapM (sndM valueToJs) ps
258+
literalToValueJS :: SourceSpan -> Literal (Expr Ann) -> m AST
259+
literalToValueJS ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)
260+
literalToValueJS ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)
261+
literalToValueJS ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s
262+
literalToValueJS ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])
263+
literalToValueJS ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b
264+
literalToValueJS ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToJs xs
265+
literalToValueJS ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToJs) ps
266266

267267
-- | Shallow copy an object.
268268
extendObj :: AST -> [(PSString, AST)] -> m AST

‎src/Language/PureScript/CoreFn/Desugar.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
7373

7474
-- | Desugars expressions from AST to CoreFn representation.
7575
exprToCoreFn :: SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
76-
exprToCoreFn ss com ty (A.Literal lit) =
76+
exprToCoreFn _ com ty (A.Literal ss lit) =
7777
Literal (ss, com, ty, Nothing) (fmap (exprToCoreFn ss com Nothing) lit)
7878
exprToCoreFn ss com ty (A.Accessor name v) =
7979
Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
@@ -101,9 +101,9 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
101101
exprToCoreFn ss com (Just ty) v
102102
exprToCoreFn ss com ty (A.Let ds v) =
103103
Let (ss, com, ty, Nothing) (concatMap declToCoreFn ds) (exprToCoreFn ss [] Nothing v)
104-
exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ lit@(A.Literal (A.ObjectLiteral _)) _)) =
104+
exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ lit@(A.Literal _ (A.ObjectLiteral _)) _)) =
105105
exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name lit)
106-
exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.Literal (A.ObjectLiteral vs))) =
106+
exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.Literal _ (A.ObjectLiteral vs))) =
107107
let args = fmap (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
108108
ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
109109
in foldl (App (ss, com, Nothing, Nothing)) ctor args
@@ -133,7 +133,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
133133

134134
-- | Desugars case binders from AST to CoreFn representation.
135135
binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann
136-
binderToCoreFn ss com (A.LiteralBinder lit) =
136+
binderToCoreFn _ com (A.LiteralBinder ss lit) =
137137
LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)
138138
binderToCoreFn ss com A.NullBinder =
139139
NullBinder (ss, com, Nothing, Nothing)

‎src/Language/PureScript/Interactive.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ handleDecls
167167
-> m ()
168168
handleDecls ds = do
169169
st <- gets (updateLets (++ ds))
170-
let m = createTemporaryModule False st (P.Literal (P.ObjectLiteral []))
170+
let m = createTemporaryModule False st (P.Literal P.nullSourceSpan (P.ObjectLiteral []))
171171
e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m
172172
case e of
173173
Left err -> printErrors err

‎src/Language/PureScript/Linter/Exhaustive.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -126,12 +126,12 @@ missingCasesSingle env mn NullBinder cb@(ConstructorBinder ss con _) =
126126
missingCasesSingle env mn cb@(ConstructorBinder ss con bs) (ConstructorBinder _ con' bs')
127127
| con == con' = let (bs'', pr) = missingCasesMultiple env mn bs bs' in (map (ConstructorBinder ss con) bs'', pr)
128128
| otherwise = ([cb], return False)
129-
missingCasesSingle env mn NullBinder (LiteralBinder (ObjectLiteral bs)) =
130-
(map (LiteralBinder . ObjectLiteral . zip (map fst bs)) allMisses, pr)
129+
missingCasesSingle env mn NullBinder (LiteralBinder ss (ObjectLiteral bs)) =
130+
(map (LiteralBinder ss . ObjectLiteral . zip (map fst bs)) allMisses, pr)
131131
where
132132
(allMisses, pr) = missingCasesMultiple env mn (initialize $ length bs) (map snd bs)
133-
missingCasesSingle env mn (LiteralBinder (ObjectLiteral bs)) (LiteralBinder (ObjectLiteral bs')) =
134-
(map (LiteralBinder . ObjectLiteral . zip sortedNames) allMisses, pr)
133+
missingCasesSingle env mn (LiteralBinder _ (ObjectLiteral bs)) (LiteralBinder ss (ObjectLiteral bs')) =
134+
(map (LiteralBinder ss . ObjectLiteral . zip sortedNames) allMisses, pr)
135135
where
136136
(allMisses, pr) = uncurry (missingCasesMultiple env mn) (unzip binders)
137137

@@ -148,10 +148,10 @@ missingCasesSingle env mn (LiteralBinder (ObjectLiteral bs)) (LiteralBinder (Obj
148148
compBS e s b b' = (s, compB e b b')
149149

150150
(sortedNames, binders) = unzip $ genericMerge (compBS NullBinder) sbs sbs'
151-
missingCasesSingle _ _ NullBinder (LiteralBinder (BooleanLiteral b)) = ([LiteralBinder . BooleanLiteral $ not b], return True)
152-
missingCasesSingle _ _ (LiteralBinder (BooleanLiteral bl)) (LiteralBinder (BooleanLiteral br))
151+
missingCasesSingle _ _ NullBinder (LiteralBinder ss (BooleanLiteral b)) = ([LiteralBinder ss . BooleanLiteral $ not b], return True)
152+
missingCasesSingle _ _ (LiteralBinder ss (BooleanLiteral bl)) (LiteralBinder _ (BooleanLiteral br))
153153
| bl == br = ([], return True)
154-
| otherwise = ([LiteralBinder $ BooleanLiteral bl], return False)
154+
| otherwise = ([LiteralBinder ss $ BooleanLiteral bl], return False)
155155
missingCasesSingle env mn b (PositionedBinder _ _ cb) = missingCasesSingle env mn b cb
156156
missingCasesSingle env mn b (TypedBinder _ cb) = missingCasesSingle env mn b cb
157157
missingCasesSingle _ _ b _ = ([b], Left Unknown)
@@ -337,8 +337,8 @@ checkExhaustiveExpr initSS env mn = onExpr initSS
337337

338338
onExpr :: SourceSpan -> Expr -> m Expr
339339
onExpr _ (UnaryMinus ss e) = UnaryMinus ss <$> onExpr ss e
340-
onExpr ss (Literal (ArrayLiteral es)) = Literal . ArrayLiteral <$> mapM (onExpr ss) es
341-
onExpr ss (Literal (ObjectLiteral es)) = Literal . ObjectLiteral <$> mapM (sndM (onExpr ss)) es
340+
onExpr _ (Literal ss (ArrayLiteral es)) = Literal ss . ArrayLiteral <$> mapM (onExpr ss) es
341+
onExpr _ (Literal ss (ObjectLiteral es)) = Literal ss . ObjectLiteral <$> mapM (sndM (onExpr ss)) es
342342
onExpr ss (TypeClassDictionaryConstructorApp x e) = TypeClassDictionaryConstructorApp x <$> onExpr ss e
343343
onExpr ss (Accessor x e) = Accessor x <$> onExpr ss e
344344
onExpr ss (ObjectUpdate o es) = ObjectUpdate <$> onExpr ss o <*> mapM (sndM (onExpr ss)) es

‎src/Language/PureScript/Parser/Declarations.hs‎

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -438,12 +438,12 @@ parseLet = do
438438
parseValueAtom :: TokenParser Expr
439439
parseValueAtom = withSourceSpan PositionedValue $ P.choice
440440
[ parseAnonymousArgument
441-
, Literal <$> parseNumericLiteral
442-
, Literal <$> parseCharLiteral
443-
, Literal <$> parseStringLiteral
444-
, Literal <$> parseBooleanLiteral
445-
, Literal <$> parseArrayLiteral parseValue
446-
, Literal <$> parseObjectLiteral parseIdentifierAndValue
441+
, withSourceSpan' Literal $ parseNumericLiteral
442+
, withSourceSpan' Literal $ parseCharLiteral
443+
, withSourceSpan' Literal $ parseStringLiteral
444+
, withSourceSpan' Literal $ parseBooleanLiteral
445+
, withSourceSpan' Literal $ parseArrayLiteral parseValue
446+
, withSourceSpan' Literal $ parseObjectLiteral parseIdentifierAndValue
447447
, parseAbs
448448
, P.try parseConstructor
449449
, P.try parseVar
@@ -551,7 +551,8 @@ parseAnonymousArgument :: TokenParser Expr
551551
parseAnonymousArgument = underscore *> pure AnonymousArgument
552552

553553
parseNumberLiteral :: TokenParser Binder
554-
parseNumberLiteral = LiteralBinder . NumericLiteral <$> (sign <*> number)
554+
parseNumberLiteral = withSourceSpanF $
555+
(\n ss -> LiteralBinder ss (NumericLiteral n)) <$> (sign <*> number)
555556
where
556557
sign :: TokenParser (Either Integer Double -> Either Integer Double)
557558
sign = (symbol' "-" >> return (negate +++ negate))
@@ -570,8 +571,8 @@ parseConstructorBinder = withSourceSpanF $
570571
<*> many (indented *> parseBinderNoParens)
571572

572573
parseObjectBinder:: TokenParser Binder
573-
parseObjectBinder =
574-
LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
574+
parseObjectBinder = withSourceSpanF $
575+
flip LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
575576
where
576577
parseEntry :: TokenParser (PSString, Binder)
577578
parseEntry = var <|> (,) <$> stringLiteral <*> rest
@@ -583,7 +584,8 @@ parseObjectBinder =
583584
rest = indented *> colon *> indented *> parseBinder
584585

585586
parseArrayBinder :: TokenParser Binder
586-
parseArrayBinder = LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
587+
parseArrayBinder = withSourceSpanF $
588+
flip LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
587589

588590
parseVarOrNamedBinder :: TokenParser Binder
589591
parseVarOrNamedBinder = withSourceSpanF $ do
@@ -619,9 +621,9 @@ parseBinderAtom :: TokenParser Binder
619621
parseBinderAtom = withSourceSpan PositionedBinder
620622
(P.choice
621623
[ parseNullBinder
622-
, LiteralBinder <$> parseCharLiteral
623-
, LiteralBinder <$> parseStringLiteral
624-
, LiteralBinder <$> parseBooleanLiteral
624+
, withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
625+
, withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
626+
, withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
625627
, parseNumberLiteral
626628
, parseVarOrNamedBinder
627629
, parseConstructorBinder
@@ -635,9 +637,9 @@ parseBinderNoParens :: TokenParser Binder
635637
parseBinderNoParens = withSourceSpan PositionedBinder
636638
(P.choice
637639
[ parseNullBinder
638-
, LiteralBinder <$> parseCharLiteral
639-
, LiteralBinder <$> parseStringLiteral
640-
, LiteralBinder <$> parseBooleanLiteral
640+
, withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
641+
, withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
642+
, withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
641643
, parseNumberLiteral
642644
, parseVarOrNamedBinder
643645
, parseNullaryConstructorBinder

0 commit comments

Comments
 (0)