purescript · garyb · Mar 11, 2018 · Mar 11, 2018 · Mar 11, 2018
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
@@ -24,7 +24,7 @@ data Binder
   -- |
   -- A binder which matches a literal
   --
-  | LiteralBinder (Literal Binder)
+  | LiteralBinder SourceSpan (Literal Binder)
   -- |
   -- A binder which binds an identifier
   --
@@ -76,7 +76,7 @@ instance Eq Binder where
   (==) NullBinder NullBinder = True
   (==) NullBinder _ = False
 
-  (==) (LiteralBinder lb) (LiteralBinder lb') = (==) lb lb'
+  (==) (LiteralBinder _ lb) (LiteralBinder _ lb') = (==) lb lb'
   (==) LiteralBinder{} _ = False
 
   (==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'
@@ -114,7 +114,7 @@ instance Ord Binder where
   compare NullBinder NullBinder = EQ
   compare NullBinder _ = LT
 
-  compare (LiteralBinder lb) (LiteralBinder lb') = compare lb lb'
+  compare (LiteralBinder _ lb) (LiteralBinder _ lb') = compare lb lb'
   compare LiteralBinder{} NullBinder = GT
   compare LiteralBinder{} _ = LT
 
@@ -174,7 +174,7 @@ instance Ord Binder where
 binderNames :: Binder -> [Ident]
 binderNames = go []
   where
-  go ns (LiteralBinder b) = lit ns b
+  go ns (LiteralBinder _ b) = lit ns b
   go ns (VarBinder _ name) = name : ns
   go ns (ConstructorBinder _ _ bs) = foldl go ns bs
   go ns (BinaryNoParensBinder b1 b2 b3) = foldl go ns [b1, b2, b3]

diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -697,7 +697,7 @@ data Expr
   -- |
   -- A literal value
   --
-  = Literal (Literal Expr)
+  = Literal SourceSpan (Literal Expr)
   -- |
   -- A prefix -, will be desugared
   --
@@ -886,7 +886,7 @@ $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Declarat
 $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
 
 isTrueExpr :: Expr -> Bool
-isTrueExpr (Literal (BooleanLiteral True)) = True
+isTrueExpr (Literal _ (BooleanLiteral True)) = True
 isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) = True
 isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) = True
 isTrueExpr (TypedValue _ e _) = isTrueExpr e

diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
@@ -62,7 +62,7 @@ everywhereOnValues f g h = (f', g', h')
   f' other = f other
 
   g' :: Expr -> Expr
-  g' (Literal l) = g (Literal (lit g' l))
+  g' (Literal ss l) = g (Literal ss (lit g' l))
   g' (UnaryMinus ss v) = g (UnaryMinus ss (g' v))
   g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
   g' (Parens v) = g (Parens (g' v))
@@ -85,7 +85,7 @@ everywhereOnValues f g h = (f', g', h')
   h' (ConstructorBinder ss ctor bs) = h (ConstructorBinder ss ctor (fmap h' bs))
   h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))
   h' (ParensInBinder b) = h (ParensInBinder (h' b))
-  h' (LiteralBinder l) = h (LiteralBinder (lit h' l))
+  h' (LiteralBinder ss l) = h (LiteralBinder ss (lit h' l))
   h' (NamedBinder ss name b) = h (NamedBinder ss name (h' b))
   h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
   h' (TypedBinder t b) = h (TypedBinder t (h' b))
@@ -136,7 +136,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
   f' other = f other
 
   g' :: Expr -> m Expr
-  g' (Literal l) = Literal <$> litM (g >=> g') l
+  g' (Literal ss l) = Literal ss <$> litM (g >=> g') l
   g' (UnaryMinus ss v) = UnaryMinus ss <$> (g v >>= g')
   g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
   g' (Parens v) = Parens <$> (g v >>= g')
@@ -156,7 +156,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
   g' other = g other
 
   h' :: Binder -> m Binder
-  h' (LiteralBinder l) = LiteralBinder <$> litM (h >=> h') l
+  h' (LiteralBinder ss l) = LiteralBinder ss <$> litM (h >=> h') l
   h' (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h' <=< h) bs
   h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')
   h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')
@@ -205,7 +205,7 @@ everywhereOnValuesM f g h = (f', g', h')
   f' other = f other
 
   g' :: Expr -> m Expr
-  g' (Literal l) = (Literal <$> litM g' l) >>= g
+  g' (Literal ss l) = (Literal ss <$> litM g' l) >>= g
   g' (UnaryMinus ss v) = (UnaryMinus ss <$> g' v) >>= g
   g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
   g' (Parens v) = (Parens <$> g' v) >>= g
@@ -225,7 +225,7 @@ everywhereOnValuesM f g h = (f', g', h')
   g' other = g other
 
   h' :: Binder -> m Binder
-  h' (LiteralBinder l) = (LiteralBinder <$> litM h' l) >>= h
+  h' (LiteralBinder ss l) = (LiteralBinder ss <$> litM h' l) >>= h
   h' (ConstructorBinder ss ctor bs) = (ConstructorBinder ss ctor <$> traverse h' bs) >>= h
   h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h
   h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h
@@ -277,7 +277,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
   f' d = f d
 
   g' :: Expr -> r
-  g' v@(Literal l) = lit (g v) g' l
+  g' v@(Literal _ l) = lit (g v) g' l
   g' v@(UnaryMinus _ v1) = g v <> g' v1
   g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
   g' v@(Parens v1) = g v <> g' v1
@@ -297,7 +297,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
   g' v = g v
 
   h' :: Binder -> r
-  h' b@(LiteralBinder l) = lit (h b) h' l
+  h' b@(LiteralBinder _ l) = lit (h b) h' l
   h' b@(ConstructorBinder _ _ bs) = foldl (<>) (h b) (fmap h' bs)
   h' b@(BinaryNoParensBinder b1 b2 b3) = h b <> h' b1 <> h' b2 <> h' b3
   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'
   g'' s v = let (s', r) = g s v in r <> g' s' v
 
   g' :: s -> Expr -> r
-  g' s (Literal l) = lit g'' s l
+  g' s (Literal _ l) = lit g'' s l
   g' s (UnaryMinus _ v1) = g'' s v1
   g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
   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'
   h'' s b = let (s', r) = h s b in r <> h' s' b
 
   h' :: s -> Binder -> r
-  h' s (LiteralBinder l) = lit h'' s l
+  h' s (LiteralBinder _ l) = lit h'' s l
   h' s (ConstructorBinder _ _ bs) = foldl (<>) r0 (fmap (h'' s) bs)
   h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <> h'' s b2 <> h'' s b3
   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
 
   g'' s = uncurry g' <=< g s
 
-  g' s (Literal l) = Literal <$> lit g'' s l
+  g' s (Literal ss l) = Literal ss <$> lit g'' s l
   g' s (UnaryMinus ss v) = UnaryMinus ss <$> g'' s v
   g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
   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
 
   h'' s = uncurry h' <=< h s
 
-  h' s (LiteralBinder l) = LiteralBinder <$> lit h'' s l
+  h' s (LiteralBinder ss l) = LiteralBinder ss <$> lit h'' s l
   h' s (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h'' s) bs
   h' s (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> h'' s b1 <*> h'' s b2 <*> h'' s b3
   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)
   g'' s a = g s a <> g' s a
 
   g' :: S.Set Ident -> Expr -> r
-  g' s (Literal l) = lit g'' s l
+  g' s (Literal _ l) = lit g'' s l
   g' s (UnaryMinus _ v1) = g'' s v1
   g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
   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)
   h'' s a = h s a <> h' s a
 
   h' :: S.Set Ident -> Binder -> r
-  h' s (LiteralBinder l) = lit h'' s l
+  h' s (LiteralBinder _ l) = lit h'' s l
   h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs
   h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]
   h' s (ParensInBinder b) = h'' s b

diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
@@ -177,7 +177,7 @@ moduleToJs (Module coms mn _ imps exps foreigns decls) foreign_ =
 
   valueToJs' :: Expr Ann -> m AST
   valueToJs' (Literal (pos, _, _, _) l) =
-    rethrowWithPosition pos $ literalToValueJS l
+    rethrowWithPosition pos $ literalToValueJS pos l
   valueToJs' (Var (_, _, _, Just (IsConstructor _ [])) name) =
     return $ accessorString "value" $ qualifiedToJS id name
   valueToJs' (Var (_, _, _, Just (IsConstructor _ _)) name) =
@@ -255,14 +255,14 @@ moduleToJs (Module coms mn _ imps exps foreigns decls) foreign_ =
   iife :: Text -> [AST] -> AST
   iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
 
-  literalToValueJS :: Literal (Expr Ann) -> m AST
-  literalToValueJS (NumericLiteral (Left i)) = return $ AST.NumericLiteral Nothing (Left i)
-  literalToValueJS (NumericLiteral (Right n)) = return $ AST.NumericLiteral Nothing (Right n)
-  literalToValueJS (StringLiteral s) = return $ AST.StringLiteral Nothing s
-  literalToValueJS (CharLiteral c) = return $ AST.StringLiteral Nothing (fromString [c])
-  literalToValueJS (BooleanLiteral b) = return $ AST.BooleanLiteral Nothing b
-  literalToValueJS (ArrayLiteral xs) = AST.ArrayLiteral Nothing <$> mapM valueToJs xs
-  literalToValueJS (ObjectLiteral ps) = AST.ObjectLiteral Nothing <$> mapM (sndM valueToJs) ps
+  literalToValueJS :: SourceSpan -> Literal (Expr Ann) -> m AST
+  literalToValueJS ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)
+  literalToValueJS ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)
+  literalToValueJS ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s
+  literalToValueJS ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])
+  literalToValueJS ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b
+  literalToValueJS ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToJs xs
+  literalToValueJS ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToJs) ps
 
   -- | Shallow copy an object.
   extendObj :: AST -> [(PSString, AST)] -> m AST

diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -73,7 +73,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
 
   -- | Desugars expressions from AST to CoreFn representation.
   exprToCoreFn :: SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
-  exprToCoreFn ss com ty (A.Literal lit) =
+  exprToCoreFn _ com ty (A.Literal ss lit) =
     Literal (ss, com, ty, Nothing) (fmap (exprToCoreFn ss com Nothing) lit)
   exprToCoreFn ss com ty (A.Accessor name v) =
     Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
@@ -101,9 +101,9 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
     exprToCoreFn ss com (Just ty) v
   exprToCoreFn ss com ty (A.Let ds v) =
     Let (ss, com, ty, Nothing) (concatMap declToCoreFn ds) (exprToCoreFn ss [] Nothing v)
-  exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ lit@(A.Literal (A.ObjectLiteral _)) _)) =
+  exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ lit@(A.Literal _ (A.ObjectLiteral _)) _)) =
     exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name lit)
-  exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.Literal (A.ObjectLiteral vs))) =
+  exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.Literal _ (A.ObjectLiteral vs))) =
     let args = fmap (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
         ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
     in foldl (App (ss, com, Nothing, Nothing)) ctor args
@@ -133,7 +133,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
 
   -- | Desugars case binders from AST to CoreFn representation.
   binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann
-  binderToCoreFn ss com (A.LiteralBinder lit) =
+  binderToCoreFn _ com (A.LiteralBinder ss lit) =
     LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)
   binderToCoreFn ss com A.NullBinder =
     NullBinder (ss, com, Nothing, Nothing)

diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs
@@ -167,7 +167,7 @@ handleDecls
   -> m ()
 handleDecls ds = do
   st <- gets (updateLets (++ ds))
-  let m = createTemporaryModule False st (P.Literal (P.ObjectLiteral []))
+  let m = createTemporaryModule False st (P.Literal P.nullSourceSpan (P.ObjectLiteral []))
   e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m
   case e of
     Left err -> printErrors err

diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs
@@ -126,12 +126,12 @@ missingCasesSingle env mn NullBinder cb@(ConstructorBinder ss con _) =
 missingCasesSingle env mn cb@(ConstructorBinder ss con bs) (ConstructorBinder _ con' bs')
   | con == con' = let (bs'', pr) = missingCasesMultiple env mn bs bs' in (map (ConstructorBinder ss con) bs'', pr)
   | otherwise = ([cb], return False)
-missingCasesSingle env mn NullBinder (LiteralBinder (ObjectLiteral bs)) =
-  (map (LiteralBinder . ObjectLiteral . zip (map fst bs)) allMisses, pr)
+missingCasesSingle env mn NullBinder (LiteralBinder ss (ObjectLiteral bs)) =
+  (map (LiteralBinder ss . ObjectLiteral . zip (map fst bs)) allMisses, pr)
   where
   (allMisses, pr) = missingCasesMultiple env mn (initialize $ length bs) (map snd bs)
-missingCasesSingle env mn (LiteralBinder (ObjectLiteral bs)) (LiteralBinder (ObjectLiteral bs')) =
-  (map (LiteralBinder . ObjectLiteral . zip sortedNames) allMisses, pr)
+missingCasesSingle env mn (LiteralBinder _ (ObjectLiteral bs)) (LiteralBinder ss (ObjectLiteral bs')) =
+  (map (LiteralBinder ss . ObjectLiteral . zip sortedNames) allMisses, pr)
   where
   (allMisses, pr) = uncurry (missingCasesMultiple env mn) (unzip binders)
 
@@ -148,10 +148,10 @@ missingCasesSingle env mn (LiteralBinder (ObjectLiteral bs)) (LiteralBinder (Obj
   compBS e s b b' = (s, compB e b b')
 
   (sortedNames, binders) = unzip $ genericMerge (compBS NullBinder) sbs sbs'
-missingCasesSingle _ _ NullBinder (LiteralBinder (BooleanLiteral b)) = ([LiteralBinder . BooleanLiteral $ not b], return True)
-missingCasesSingle _ _ (LiteralBinder (BooleanLiteral bl)) (LiteralBinder (BooleanLiteral br))
+missingCasesSingle _ _ NullBinder (LiteralBinder ss (BooleanLiteral b)) = ([LiteralBinder ss . BooleanLiteral $ not b], return True)
+missingCasesSingle _ _ (LiteralBinder ss (BooleanLiteral bl)) (LiteralBinder _ (BooleanLiteral br))
   | bl == br = ([], return True)
-  | otherwise = ([LiteralBinder $ BooleanLiteral bl], return False)
+  | otherwise = ([LiteralBinder ss $ BooleanLiteral bl], return False)
 missingCasesSingle env mn b (PositionedBinder _ _ cb) = missingCasesSingle env mn b cb
 missingCasesSingle env mn b (TypedBinder _ cb) = missingCasesSingle env mn b cb
 missingCasesSingle _ _ b _ = ([b], Left Unknown)
@@ -337,8 +337,8 @@ checkExhaustiveExpr initSS env mn = onExpr initSS
 
   onExpr :: SourceSpan -> Expr -> m Expr
   onExpr _ (UnaryMinus ss e) = UnaryMinus ss <$> onExpr ss e
-  onExpr ss (Literal (ArrayLiteral es)) = Literal . ArrayLiteral <$> mapM (onExpr ss) es
-  onExpr ss (Literal (ObjectLiteral es)) = Literal . ObjectLiteral <$> mapM (sndM (onExpr ss)) es
+  onExpr _ (Literal ss (ArrayLiteral es)) = Literal ss . ArrayLiteral <$> mapM (onExpr ss) es
+  onExpr _ (Literal ss (ObjectLiteral es)) = Literal ss . ObjectLiteral <$> mapM (sndM (onExpr ss)) es
   onExpr ss (TypeClassDictionaryConstructorApp x e) = TypeClassDictionaryConstructorApp x <$> onExpr ss e
   onExpr ss (Accessor x e) = Accessor x <$> onExpr ss e
   onExpr ss (ObjectUpdate o es) = ObjectUpdate <$> onExpr ss o <*> mapM (sndM (onExpr ss)) es

diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
@@ -438,12 +438,12 @@ parseLet = do
 parseValueAtom :: TokenParser Expr
 parseValueAtom = withSourceSpan PositionedValue $ P.choice
                  [ parseAnonymousArgument
-                 , Literal <$> parseNumericLiteral
-                 , Literal <$> parseCharLiteral
-                 , Literal <$> parseStringLiteral
-                 , Literal <$> parseBooleanLiteral
-                 , Literal <$> parseArrayLiteral parseValue
-                 , Literal <$> parseObjectLiteral parseIdentifierAndValue
+                 , withSourceSpan' Literal $ parseNumericLiteral
+                 , withSourceSpan' Literal $ parseCharLiteral
+                 , withSourceSpan' Literal $ parseStringLiteral
+                 , withSourceSpan' Literal $ parseBooleanLiteral
+                 , withSourceSpan' Literal $ parseArrayLiteral parseValue
+                 , withSourceSpan' Literal $ parseObjectLiteral parseIdentifierAndValue
                  , parseAbs
                  , P.try parseConstructor
                  , P.try parseVar
@@ -551,7 +551,8 @@ parseAnonymousArgument :: TokenParser Expr
 parseAnonymousArgument = underscore *> pure AnonymousArgument
 
 parseNumberLiteral :: TokenParser Binder
-parseNumberLiteral = LiteralBinder . NumericLiteral <$> (sign <*> number)
+parseNumberLiteral = withSourceSpanF $
+  (\n ss -> LiteralBinder ss (NumericLiteral n)) <$> (sign <*> number)
   where
   sign :: TokenParser (Either Integer Double -> Either Integer Double)
   sign = (symbol' "-" >> return (negate +++ negate))
@@ -570,8 +571,8 @@ parseConstructorBinder = withSourceSpanF $
     <*> many (indented *> parseBinderNoParens)
 
 parseObjectBinder:: TokenParser Binder
-parseObjectBinder =
-  LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
+parseObjectBinder = withSourceSpanF $
+  flip LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
   where
     parseEntry :: TokenParser (PSString, Binder)
     parseEntry = var <|> (,) <$> stringLiteral <*> rest
@@ -583,7 +584,8 @@ parseObjectBinder =
         rest = indented *> colon *> indented *> parseBinder
 
 parseArrayBinder :: TokenParser Binder
-parseArrayBinder = LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
+parseArrayBinder = withSourceSpanF $
+  flip LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
 
 parseVarOrNamedBinder :: TokenParser Binder
 parseVarOrNamedBinder = withSourceSpanF $ do
@@ -619,9 +621,9 @@ parseBinderAtom :: TokenParser Binder
 parseBinderAtom = withSourceSpan PositionedBinder
   (P.choice
    [ parseNullBinder
-   , LiteralBinder <$> parseCharLiteral
-   , LiteralBinder <$> parseStringLiteral
-   , LiteralBinder <$> parseBooleanLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
    , parseNumberLiteral
    , parseVarOrNamedBinder
    , parseConstructorBinder
@@ -635,9 +637,9 @@ parseBinderNoParens :: TokenParser Binder
 parseBinderNoParens = withSourceSpan PositionedBinder
   (P.choice
     [ parseNullBinder
-    , LiteralBinder <$> parseCharLiteral
-    , LiteralBinder <$> parseStringLiteral
-    , LiteralBinder <$> parseBooleanLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
     , parseNumberLiteral
     , parseVarOrNamedBinder
     , parseNullaryConstructorBinder