From 0fed8ae2f2288008c316c03563f6b466e989a215 Mon Sep 17 00:00:00 2001
From: Gary Burgess <gary.burgess@gmail.com>
Date: Sun, 11 Mar 2018 13:41:43 +0000
Subject: [PATCH 1/2] Add source spans for literals
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This fixes the IntOutOfRange error (again 😄)
---
 src/Language/PureScript/AST/Binders.hs        |  8 +--
 src/Language/PureScript/AST/Declarations.hs   |  4 +-
 src/Language/PureScript/AST/Traversals.hs     | 28 +++++------
 src/Language/PureScript/CodeGen/JS.hs         | 18 +++----
 src/Language/PureScript/CoreFn/Desugar.hs     |  8 +--
 src/Language/PureScript/Interactive.hs        |  2 +-
 src/Language/PureScript/Linter/Exhaustive.hs  | 18 +++----
 .../PureScript/Parser/Declarations.hs         | 34 +++++++------
 src/Language/PureScript/Pretty/Values.hs      |  6 +--
 .../PureScript/Sugar/CaseDeclarations.hs      |  6 +--
 .../PureScript/Sugar/ObjectWildcards.hs       |  2 +-
 src/Language/PureScript/Sugar/TypeClasses.hs  |  2 +-
 .../PureScript/Sugar/TypeClasses/Deriving.hs  |  4 +-
 .../PureScript/TypeChecker/Entailment.hs      | 10 ++--
 src/Language/PureScript/TypeChecker/Types.hs  | 50 +++++++++----------
 15 files changed, 101 insertions(+), 99 deletions(-)

diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
index e7bbd29fbb..dd31894b52 100644
--- 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
index adc8f95c54..ba35e2062b 100644
--- 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
index 88f87eca54..a7c8297e91 100644
--- 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
index 4cf389f76b..bad739c11e 100644
--- 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
index decef9f1f7..c28f8c8120 100644
--- 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
index facde9e992..61782de7d3 100644
--- 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
index 53615b8aec..179497db47 100644
--- 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
index 71ecd20cc9..f167468182 100644
--- 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
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index 82832c0cb1..89dc52f875 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -87,7 +87,7 @@ prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =
     text "#dict-accessor " <> text (T.unpack (runProperName (disqualify className))) <> text "." <> text (T.unpack (showIdent ident)) <> text ">"
 prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val
 prettyPrintValue d (PositionedValue _ _ val) = prettyPrintValue d val
-prettyPrintValue d (Literal l) = prettyPrintLiteralValue d l
+prettyPrintValue d (Literal _ l) = prettyPrintLiteralValue d l
 prettyPrintValue _ (Hole name) = text "?" <> textT name
 prettyPrintValue d expr@AnonymousArgument{} = prettyPrintValueAtom d expr
 prettyPrintValue d expr@Constructor{} = prettyPrintValueAtom d expr
@@ -99,7 +99,7 @@ prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr
 
 -- | Pretty-print an atomic expression, adding parentheses if necessary.
 prettyPrintValueAtom :: Int -> Expr -> Box
-prettyPrintValueAtom d (Literal l) = prettyPrintLiteralValue d l
+prettyPrintValueAtom d (Literal _ l) = prettyPrintLiteralValue d l
 prettyPrintValueAtom _ AnonymousArgument = text "_"
 prettyPrintValueAtom _ (Constructor _ name) = text $ T.unpack $ runProperName (disqualify name)
 prettyPrintValueAtom _ (Var _ ident) = text $ T.unpack $ showIdent (disqualify ident)
@@ -185,7 +185,7 @@ prettyPrintDoNotationElement d (PositionedDoNotationElement _ _ el) = prettyPrin
 
 prettyPrintBinderAtom :: Binder -> Text
 prettyPrintBinderAtom NullBinder = "_"
-prettyPrintBinderAtom (LiteralBinder l) = prettyPrintLiteralBinder l
+prettyPrintBinderAtom (LiteralBinder _ l) = prettyPrintLiteralBinder l
 prettyPrintBinderAtom (VarBinder _ ident) = showIdent ident
 prettyPrintBinderAtom (ConstructorBinder _ ctor []) = runProperName (disqualify ctor)
 prettyPrintBinderAtom b@ConstructorBinder{} = parensT (prettyPrintBinder b)
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
index 5c7eb0edcc..7598bedac7 100644
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -71,7 +71,7 @@ desugarGuardedExprs ss (Case scrut alternatives)
     Let scrut_decls <$> desugarGuardedExprs ss (Case scrut' alternatives)
   where
     isTrivialExpr (Var _ _) = True
-    isTrivialExpr (Literal _) = True
+    isTrivialExpr (Literal _ _) = True
     isTrivialExpr (Accessor _ e) = isTrivialExpr e
     isTrivialExpr (Parens e) = isTrivialExpr e
     isTrivialExpr (PositionedValue _ _ e) = isTrivialExpr e
@@ -196,7 +196,7 @@ desugarGuardedExprs ss (Case scrut alternatives) =
       | isTrueExpr c = desugarGuard gs e match_failed
       | otherwise =
         Case [c]
-          (CaseAlternative [LiteralBinder (BooleanLiteral True)]
+          (CaseAlternative [LiteralBinder ss (BooleanLiteral True)]
             [MkUnguarded (desugarGuard gs e match_failed)] : match_failed)
 
     desugarGuard (PatternGuard vb g : gs) e match_failed =
@@ -227,7 +227,7 @@ desugarGuardedExprs ss (Case scrut alternatives) =
         let
           goto_rem_case :: Expr
           goto_rem_case = Var ss (Qualified Nothing rem_case_id)
-            `App` Literal (BooleanLiteral True)
+            `App` Literal ss (BooleanLiteral True)
           alt_fail = [CaseAlternative [NullBinder] [MkUnguarded goto_rem_case]]
 
         pure $ Let [
diff --git a/src/Language/PureScript/Sugar/ObjectWildcards.hs b/src/Language/PureScript/Sugar/ObjectWildcards.hs
index 31998c4bf6..c0bda4e7f1 100644
--- a/src/Language/PureScript/Sugar/ObjectWildcards.hs
+++ b/src/Language/PureScript/Sugar/ObjectWildcards.hs
@@ -41,7 +41,7 @@ desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d
     , BinaryNoParens op u val <- b'
     , isAnonymousArgument u = do arg <- freshIdent'
                                  return $ Abs (VarBinder nullSourceSpan arg) $ App (App op (Var nullSourceSpan (Qualified Nothing arg))) val
-  desugarExpr (Literal (ObjectLiteral ps)) = wrapLambdaAssoc (Literal . ObjectLiteral) ps
+  desugarExpr (Literal ss (ObjectLiteral ps)) = wrapLambdaAssoc (Literal ss . ObjectLiteral) ps
   desugarExpr (ObjectUpdateNested obj ps) = transformNestedUpdate obj ps
   desugarExpr (Accessor prop u)
     | Just props <- peelAnonAccessorChain u = do
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index b143fa9803..d9588dc66f 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -297,7 +297,7 @@ typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls =
             , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs
             ]
 
-      let props = Literal $ ObjectLiteral $ map (first mkString) (members ++ superclasses)
+      let props = Literal ss $ ObjectLiteral $ map (first mkString) (members ++ superclasses)
           dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys
           constrainedTy = quantify (foldr ConstrainedType dictTy deps)
           dict = TypeClassDictionaryConstructorApp className props
diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
index 1e76cc4db8..1d8100f1fe 100755
--- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
@@ -463,7 +463,7 @@ deriveEq ss mn syns ds tyConNm = do
       | length xs /= 1 = xs ++ [catchAll]
       | otherwise = xs -- Avoid redundant case
       where
-      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (Literal (BooleanLiteral False)))
+      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (Literal ss (BooleanLiteral False)))
 
     mkCtorClause :: (ProperName 'ConstructorName, [Type]) -> m CaseAlternative
     mkCtorClause (ctorName, tys) = do
@@ -476,7 +476,7 @@ deriveEq ss mn syns ds tyConNm = do
       caseBinder idents = ConstructorBinder ss (Qualified (Just mn) ctorName) (map (VarBinder ss) idents)
 
     conjAll :: [Expr] -> Expr
-    conjAll [] = Literal (BooleanLiteral True)
+    conjAll [] = Literal ss (BooleanLiteral True)
     conjAll xs = foldl1 preludeConj xs
 
     toEqTest :: Expr -> Expr -> Type -> Expr
diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
index 823a3b47f4..f882dfe170 100644
--- a/src/Language/PureScript/TypeChecker/Entailment.hs
+++ b/src/Language/PureScript/TypeChecker/Entailment.hs
@@ -371,14 +371,14 @@ entails SolverOptions{..} constraint context hints =
               -- So pass an empty placeholder (undefined) instead.
               return valUndefined
             mkDictionary (IsSymbolInstance sym) _ =
-              let fields = [ ("reflectSymbol", Abs (VarBinder nullSourceSpan UnusedIdent) (Literal (StringLiteral sym))) ] in
-              return $ TypeClassDictionaryConstructorApp C.IsSymbol (Literal (ObjectLiteral fields))
+              let fields = [ ("reflectSymbol", Abs (VarBinder nullSourceSpan UnusedIdent) (Literal nullSourceSpan (StringLiteral sym))) ] in
+              return $ TypeClassDictionaryConstructorApp C.IsSymbol (Literal nullSourceSpan (ObjectLiteral fields))
             mkDictionary CompareSymbolInstance _ =
-              return $ TypeClassDictionaryConstructorApp C.CompareSymbol (Literal (ObjectLiteral []))
+              return $ TypeClassDictionaryConstructorApp C.CompareSymbol (Literal nullSourceSpan (ObjectLiteral []))
             mkDictionary ConsSymbolInstance _ =
-              return $ TypeClassDictionaryConstructorApp C.ConsSymbol (Literal (ObjectLiteral []))
+              return $ TypeClassDictionaryConstructorApp C.ConsSymbol (Literal nullSourceSpan (ObjectLiteral []))
             mkDictionary AppendSymbolInstance _ =
-              return $ TypeClassDictionaryConstructorApp C.AppendSymbol (Literal (ObjectLiteral []))
+              return $ TypeClassDictionaryConstructorApp C.AppendSymbol (Literal nullSourceSpan (ObjectLiteral []))
 
         -- Turn a DictionaryValue into a Expr
         subclassDictionaryValue :: Expr -> Qualified (ProperName 'ClassName) -> Integer -> Expr
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 309111f9fa..d12e711179 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -305,20 +305,20 @@ infer'
    . (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
   => Expr
   -> m Expr
-infer' v@(Literal (NumericLiteral (Left _))) = return $ TypedValue True v tyInt
-infer' v@(Literal (NumericLiteral (Right _))) = return $ TypedValue True v tyNumber
-infer' v@(Literal (StringLiteral _)) = return $ TypedValue True v tyString
-infer' v@(Literal (CharLiteral _)) = return $ TypedValue True v tyChar
-infer' v@(Literal (BooleanLiteral _)) = return $ TypedValue True v tyBoolean
-infer' (Literal (ArrayLiteral vals)) = do
+infer' v@(Literal _ (NumericLiteral (Left _))) = return $ TypedValue True v tyInt
+infer' v@(Literal _ (NumericLiteral (Right _))) = return $ TypedValue True v tyNumber
+infer' v@(Literal _ (StringLiteral _)) = return $ TypedValue True v tyString
+infer' v@(Literal _ (CharLiteral _)) = return $ TypedValue True v tyChar
+infer' v@(Literal _ (BooleanLiteral _)) = return $ TypedValue True v tyBoolean
+infer' (Literal ss (ArrayLiteral vals)) = do
   ts <- traverse infer vals
   els <- freshType
   ts' <- forM ts $ \(TypedValue ch val t) -> do
     (val', t') <- instantiatePolyTypeWithUnknowns val t
     unifyTypes els t'
     return (TypedValue ch val' t')
-  return $ TypedValue True (Literal (ArrayLiteral ts')) (TypeApp tyArray els)
-infer' (Literal (ObjectLiteral ps)) = do
+  return $ TypedValue True (Literal ss (ArrayLiteral ts')) (TypeApp tyArray els)
+infer' (Literal ss (ObjectLiteral ps)) = do
   ensureNoDuplicateProperties ps
   -- We make a special case for Vars in record labels, since these are the
   -- only types of expressions for which 'infer' can return a polymorphic type.
@@ -337,7 +337,7 @@ infer' (Literal (ObjectLiteral ps)) = do
         pure (name, valAndType)
   fields <- forM ps inferProperty
   let ty = TypeApp tyRecord $ rowFromList (map (Label *** snd) fields, REmpty)
-  return $ TypedValue True (Literal (ObjectLiteral (map (fmap (uncurry (TypedValue True))) fields))) ty
+  return $ TypedValue True (Literal ss (ObjectLiteral (map (fmap (uncurry (TypedValue True))) fields))) ty
 infer' (ObjectUpdate o ps) = do
   ensureNoDuplicateProperties ps
   row <- freshType
@@ -464,11 +464,11 @@ inferBinder
   -> Binder
   -> m (M.Map Ident Type)
 inferBinder _ NullBinder = return M.empty
-inferBinder val (LiteralBinder (StringLiteral _)) = unifyTypes val tyString >> return M.empty
-inferBinder val (LiteralBinder (CharLiteral _)) = unifyTypes val tyChar >> return M.empty
-inferBinder val (LiteralBinder (NumericLiteral (Left _))) = unifyTypes val tyInt >> return M.empty
-inferBinder val (LiteralBinder (NumericLiteral (Right _))) = unifyTypes val tyNumber >> return M.empty
-inferBinder val (LiteralBinder (BooleanLiteral _)) = unifyTypes val tyBoolean >> return M.empty
+inferBinder val (LiteralBinder _ (StringLiteral _)) = unifyTypes val tyString >> return M.empty
+inferBinder val (LiteralBinder _ (CharLiteral _)) = unifyTypes val tyChar >> return M.empty
+inferBinder val (LiteralBinder _ (NumericLiteral (Left _))) = unifyTypes val tyInt >> return M.empty
+inferBinder val (LiteralBinder _ (NumericLiteral (Right _))) = unifyTypes val tyNumber >> return M.empty
+inferBinder val (LiteralBinder _ (BooleanLiteral _)) = unifyTypes val tyBoolean >> return M.empty
 inferBinder val (VarBinder _ name) = return $ M.singleton name val
 inferBinder val (ConstructorBinder ss ctor binders) = do
   env <- getEnv
@@ -487,7 +487,7 @@ inferBinder val (ConstructorBinder ss ctor binders) = do
     where
     go args (TypeApp (TypeApp fn arg) ret) | fn == tyFunction = go (arg : args) ret
     go args ret = (args, ret)
-inferBinder val (LiteralBinder (ObjectLiteral props)) = do
+inferBinder val (LiteralBinder _ (ObjectLiteral props)) = do
   row <- freshType
   rest <- freshType
   m1 <- inferRowProperties row rest props
@@ -501,7 +501,7 @@ inferBinder val (LiteralBinder (ObjectLiteral props)) = do
     m1 <- inferBinder propTy binder
     m2 <- inferRowProperties nrow (RCons (Label name) propTy row) binders
     return $ m1 `M.union` m2
-inferBinder val (LiteralBinder (ArrayLiteral binders)) = do
+inferBinder val (LiteralBinder _ (ArrayLiteral binders)) = do
   el <- freshType
   m1 <- M.unions <$> traverse (inferBinder el) binders
   unifyTypes val (TypeApp tyArray el)
@@ -630,19 +630,19 @@ check' val u@(TUnknown _) = do
   (val'', ty') <- instantiatePolyTypeWithUnknowns val' ty
   unifyTypes ty' u
   return $ TypedValue True val'' ty'
-check' v@(Literal (NumericLiteral (Left _))) t | t == tyInt =
+check' v@(Literal _ (NumericLiteral (Left _))) t | t == tyInt =
   return $ TypedValue True v t
-check' v@(Literal (NumericLiteral (Right _))) t | t == tyNumber =
+check' v@(Literal _ (NumericLiteral (Right _))) t | t == tyNumber =
   return $ TypedValue True v t
-check' v@(Literal (StringLiteral _)) t | t == tyString =
+check' v@(Literal _ (StringLiteral _)) t | t == tyString =
   return $ TypedValue True v t
-check' v@(Literal (CharLiteral _)) t | t == tyChar =
+check' v@(Literal _ (CharLiteral _)) t | t == tyChar =
   return $ TypedValue True v t
-check' v@(Literal (BooleanLiteral _)) t | t == tyBoolean =
+check' v@(Literal _ (BooleanLiteral _)) t | t == tyBoolean =
   return $ TypedValue True v t
-check' (Literal (ArrayLiteral vals)) t@(TypeApp a ty) = do
+check' (Literal ss (ArrayLiteral vals)) t@(TypeApp a ty) = do
   unifyTypes a tyArray
-  array <- Literal . ArrayLiteral <$> forM vals (`check` ty)
+  array <- Literal ss . ArrayLiteral <$> forM vals (`check` ty)
   return $ TypedValue True array t
 check' (Abs binder ret) ty@(TypeApp (TypeApp t argTy) retTy)
   | VarBinder ss arg <- binder = do
@@ -692,10 +692,10 @@ check' (IfThenElse cond th el) ty = do
   th' <- check th ty
   el' <- check el ty
   return $ TypedValue True (IfThenElse cond' th' el') ty
-check' e@(Literal (ObjectLiteral ps)) t@(TypeApp obj row) | obj == tyRecord = do
+check' e@(Literal ss (ObjectLiteral ps)) t@(TypeApp obj row) | obj == tyRecord = do
   ensureNoDuplicateProperties ps
   ps' <- checkProperties e ps row False
-  return $ TypedValue True (Literal (ObjectLiteral ps')) t
+  return $ TypedValue True (Literal ss (ObjectLiteral ps')) t
 check' (TypeClassDictionaryConstructorApp name ps) t = do
   ps' <- check' ps t
   return $ TypedValue True (TypeClassDictionaryConstructorApp name ps') t

From 856ee366b64a8b11ff7b3e1fb190f60a08bdd173 Mon Sep 17 00:00:00 2001
From: Gary Burgess <gary.burgess@gmail.com>
Date: Sun, 11 Mar 2018 14:07:22 +0000
Subject: [PATCH 2/2] Don't parenthesise flipped constructors

---
 src/Language/PureScript/Parser/Declarations.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index f167468182..1e84c952f1 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -572,7 +572,7 @@ parseConstructorBinder = withSourceSpanF $
 
 parseObjectBinder:: TokenParser Binder
 parseObjectBinder = withSourceSpanF $
-  (flip LiteralBinder) <$> parseObjectLiteral (indented *> parseEntry)
+  flip LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
   where
     parseEntry :: TokenParser (PSString, Binder)
     parseEntry = var <|> (,) <$> stringLiteral <*> rest
@@ -585,7 +585,7 @@ parseObjectBinder = withSourceSpanF $
 
 parseArrayBinder :: TokenParser Binder
 parseArrayBinder = withSourceSpanF $
-  (flip LiteralBinder) <$> parseArrayLiteral (indented *> parseBinder)
+  flip LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
 
 parseVarOrNamedBinder :: TokenParser Binder
 parseVarOrNamedBinder = withSourceSpanF $ do
@@ -621,9 +621,9 @@ parseBinderAtom :: TokenParser Binder
 parseBinderAtom = withSourceSpan PositionedBinder
   (P.choice
    [ parseNullBinder
-   , withSourceSpanF $ (flip LiteralBinder) <$> parseCharLiteral
-   , withSourceSpanF $ (flip LiteralBinder) <$> parseStringLiteral
-   , withSourceSpanF $ (flip LiteralBinder) <$> parseBooleanLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
+   , withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
    , parseNumberLiteral
    , parseVarOrNamedBinder
    , parseConstructorBinder
@@ -637,9 +637,9 @@ parseBinderNoParens :: TokenParser Binder
 parseBinderNoParens = withSourceSpan PositionedBinder
   (P.choice
     [ parseNullBinder
-    , withSourceSpanF $ (flip LiteralBinder) <$> parseCharLiteral
-    , withSourceSpanF $ (flip LiteralBinder) <$> parseStringLiteral
-    , withSourceSpanF $ (flip LiteralBinder) <$> parseBooleanLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseCharLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseStringLiteral
+    , withSourceSpanF $ flip LiteralBinder <$> parseBooleanLiteral
     , parseNumberLiteral
     , parseVarOrNamedBinder
     , parseNullaryConstructorBinder