purescript · purefunctor · Apr 30, 2023
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -15,6 +15,7 @@ import Data.Functor.Identity (Identity(..))
 
 import Data.Aeson.TH (Options(..), SumEncoding(..), defaultOptions, deriveJSON)
 import Data.Map qualified as M
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.List.NonEmpty qualified as NEL
 import GHC.Generics (Generic)
@@ -339,6 +340,8 @@ unwrapTypeDeclaration td = (tydeclIdent td, tydeclType td)
 -- In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression.
 data ValueDeclarationData a = ValueDeclarationData
   { valdeclSourceAnn :: !SourceAnn
+  , valdeclTypeDeclAnn :: !(Maybe SourceAnn)
+  -- ^ The matching type declaration's annotation
   , valdeclIdent :: !Ident
   -- ^ The declared value's name
   , valdeclName :: !NameKind
@@ -351,9 +354,9 @@ getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
 getValueDeclaration (ValueDeclaration d) = Just d
 getValueDeclaration _ = Nothing
 
-pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
-pattern ValueDecl sann ident name binders expr
-  = ValueDeclaration (ValueDeclarationData sann ident name binders expr)
+pattern ValueDecl :: SourceAnn -> Maybe SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
+pattern ValueDecl sann tann ident name binders expr
+  = ValueDeclaration (ValueDeclarationData sann tann ident name binders expr)
 
 data DataConstructorDeclaration = DataConstructorDeclaration
   { dataCtorAnn :: !SourceAnn
@@ -405,7 +408,7 @@ data Declaration
   -- |
   -- A minimal mutually recursive set of value declarations
   --
-  | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr))
+  | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Maybe SourceAnn, Ident), NameKind, Expr))
   -- |
   -- A foreign import declaration (name, type)
   --
@@ -488,9 +491,9 @@ declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa
 declSourceAnn (KindDeclaration sa _ _ _) = sa
 declSourceAnn (RoleDeclaration rd) = rdeclSourceAnn rd
 declSourceAnn (TypeDeclaration td) = tydeclSourceAnn td
-declSourceAnn (ValueDeclaration vd) = valdeclSourceAnn vd
+declSourceAnn (ValueDeclaration vd) = fromMaybe (valdeclSourceAnn vd) (valdeclTypeDeclAnn vd)
 declSourceAnn (BoundValueDeclaration sa _ _) = sa
-declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa
+declSourceAnn (BindingGroupDeclaration ds) = let ((sa, ta, _), _, _) = NEL.head ds in fromMaybe sa ta
 declSourceAnn (ExternDeclaration sa _ _) = sa
 declSourceAnn (ExternDataDeclaration sa _ _) = sa
 declSourceAnn (FixityDeclaration sa _) = sa

diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
@@ -57,8 +57,8 @@ everywhereOnValues f g h = (f', g', h')
   where
   f' :: Declaration -> Declaration
   f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (fmap f' ds))
-  f' (ValueDecl sa name nameKind bs val) =
-     f (ValueDecl sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))
+  f' (ValueDecl sa ta name nameKind bs val) =
+     f (ValueDecl sa ta name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))
   f' (BoundValueDeclaration sa b expr) = f (BoundValueDeclaration sa (h' b) (g' expr))
   f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (fmap (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
   f' (TypeClassDeclaration sa name args implies deps ds) = f (TypeClassDeclaration sa name args implies deps (fmap f' ds))
@@ -131,8 +131,8 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
 
   f' :: Declaration -> m Declaration
   f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds
-  f' (ValueDecl sa name nameKind bs val) =
-     ValueDecl sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val
+  f' (ValueDecl sa ta name nameKind bs val) =
+     ValueDecl sa ta name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val
   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (name, nameKind, ) <$> (g val >>= g')) ds
   f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds
   f' (TypeInstanceDeclaration sa na ch idx name cs className args ds) = TypeInstanceDeclaration sa na ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
@@ -200,8 +200,8 @@ everywhereOnValuesM f g h = (f', g', h')
 
   f' :: Declaration -> m Declaration
   f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f
-  f' (ValueDecl sa name nameKind bs val) =
-    ValueDecl sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val >>= f
+  f' (ValueDecl sa ta name nameKind bs val) =
+    ValueDecl sa ta name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val >>= f
   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (name, nameKind, ) <$> g' val) ds) >>= f
   f' (BoundValueDeclaration sa b expr) = (BoundValueDeclaration sa <$> h' b <*> g' expr) >>= f
   f' (TypeClassDeclaration sa name args implies deps ds) = (TypeClassDeclaration sa name args implies deps <$> traverse f' ds) >>= f
@@ -461,8 +461,8 @@ everywhereWithContextOnValuesM s0 f g h i j k = (f'' s0, g'' s0, h'' s0, i'' s0,
   f'' s = uncurry f' <=< f s
 
   f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds
-  f' s (ValueDecl sa name nameKind bs val) =
-    ValueDecl sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val
+  f' s (ValueDecl sa ta name nameKind bs val) =
+    ValueDecl sa ta name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val
   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds
   f' s (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f'' s) ds
   f' s (TypeInstanceDeclaration sa na ch idx name cs className args ds) = TypeInstanceDeclaration sa na ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds
@@ -561,12 +561,12 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
   f' s (DataBindingGroupDeclaration ds) =
     let s' = S.union s (S.fromList (map ToplevelIdent (mapMaybe getDeclIdent (NEL.toList ds))))
     in foldMap (f'' s') ds
-  f' s (ValueDecl _ name _ bs val) =
+  f' s (ValueDecl _ _ name _ bs val) =
     let s' = S.insert (ToplevelIdent name) s
         s'' = S.union s' (S.fromList (concatMap localBinderNames bs))
     in foldMap (h'' s') bs <> foldMap (l' s'') val
   f' s (BindingGroupDeclaration ds) =
-    let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, name), _, _) -> ToplevelIdent name) ds)))
+    let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, _, name), _, _) -> ToplevelIdent name) ds)))
     in foldMap (\(_, _, val) -> g'' s' val) ds
   f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldMap (f'' s) ds
   f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds

diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs
@@ -621,7 +621,7 @@ convertValueBindingFields fileName ann (ValueBindingFields a bs c) = do
   let
     bs' = convertBinder fileName <$> bs
     cs' = convertGuarded fileName c
-  AST.ValueDeclaration $ AST.ValueDeclarationData ann (ident $ nameValue a) Env.Public bs' cs'
+  AST.ValueDeclaration $ AST.ValueDeclarationData ann Nothing (ident $ nameValue a) Env.Public bs' cs'
 
 convertImportDecl
   :: String

diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -6,7 +6,7 @@ import Protolude (ordNub, orEmpty)
 import Control.Arrow (second)
 
 import Data.Function (on)
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Tuple (swap)
 import Data.List.NonEmpty qualified as NEL
 import Data.Map qualified as M
@@ -76,10 +76,15 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
       in NonRec (ssA ss) (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
   declToCoreFn (A.DataBindingGroupDeclaration ds) =
     concatMap declToCoreFn ds
-  declToCoreFn (A.ValueDecl (ss, com) name _ _ [A.MkUnguarded e]) =
-    [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]
-  declToCoreFn (A.BindingGroupDeclaration ds) =
-    [Rec . NEL.toList $ fmap (\(((ss, com), name), _, e) -> ((ssA ss, name), exprToCoreFn ss com Nothing e)) ds]
+  declToCoreFn (A.ValueDecl sa ta name _ _ [A.MkUnguarded e]) =
+    let (ss, com) = fromMaybe sa ta
+    in [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]
+  declToCoreFn (A.BindingGroupDeclaration ds) = do
+    let 
+      toBinding ((sa, ta, name), _, e) =
+        let (ss, com) = fromMaybe sa ta
+        in ((ssA ss, name), exprToCoreFn ss com Nothing e)
+    [Rec . NEL.toList $ toBinding <$> ds]
   declToCoreFn _ = []
 
   -- Desugars expressions from AST to CoreFn representation.

diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs
@@ -156,12 +156,14 @@ basicDeclaration :: P.SourceAnn -> Text -> DeclarationInfo -> Maybe Intermediate
 basicDeclaration sa title = Just . Right . mkDeclaration sa title
 
 convertDeclaration :: P.Declaration -> Text -> Maybe IntermediateDeclaration
-convertDeclaration (P.ValueDecl sa _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =
-  basicDeclaration sa title (ValueDeclaration (ty $> ()))
-convertDeclaration (P.ValueDecl sa _ _ _ _) title =
+convertDeclaration (P.ValueDecl sa ta _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =
+  let ann = fromMaybe sa ta in
+  basicDeclaration ann title (ValueDeclaration (ty $> ()))
+convertDeclaration (P.ValueDecl sa ta _ _ _ _) title =
   -- If no explicit type declaration was provided, insert a wildcard, so that
   -- the actual type will be added during type checking.
-  basicDeclaration sa title (ValueDeclaration (P.TypeWildcard () P.UnnamedWildcard))
+  let ann = fromMaybe sa ta in
+  basicDeclaration ann title (ValueDeclaration (P.TypeWildcard () P.UnnamedWildcard))
 convertDeclaration (P.ExternDeclaration sa _ ty) title =
   basicDeclaration sa title (ValueDeclaration (ty $> ()))
 convertDeclaration (P.DataDeclaration sa dtype _ args ctors) title =

diff --git a/src/Language/PureScript/Ide/SourceFile.hs b/src/Language/PureScript/Ide/SourceFile.hs
@@ -71,7 +71,7 @@ extractSpans
   -> [(IdeNamespaced, P.SourceSpan)]
   -- ^ Declarations and their source locations
 extractSpans d = case d of
-  P.ValueDecl (ss, _) i _ _ _ ->
+  P.ValueDecl (ss, _) _ i _ _ _ ->
     [(IdeNamespaced IdeNSValue (P.runIdent i), ss)]
   P.TypeSynonymDeclaration (ss, _) name _ _ ->
     [(IdeNamespaced IdeNSType (P.runProperName name), ss)]

diff --git a/src/Language/PureScript/Interactive/Module.hs b/src/Language/PureScript/Interactive/Module.hs
@@ -42,14 +42,14 @@ createTemporaryModule exec st val =
     supportImport = (fst (psciInteractivePrint st), P.Implicit, Just (P.ModuleName "$Support"))
     eval          = P.Var internalSpan (P.Qualified (P.ByModuleName (P.ModuleName "$Support")) (snd (psciInteractivePrint st)))
     mainValue     = P.App eval (P.Var internalSpan (P.Qualified P.ByNullSourcePos (P.Ident "it")))
-    itDecl        = P.ValueDecl (internalSpan, []) (P.Ident "it") P.Public [] [P.MkUnguarded val]
+    itDecl        = P.ValueDecl (internalSpan, []) Nothing (P.Ident "it") P.Public [] [P.MkUnguarded val]
     typeDecl      = P.TypeDeclaration
                       (P.TypeDeclarationData (internalSpan, []) (P.Ident "$main")
                         (P.srcTypeApp
                           (P.srcTypeConstructor
                             (P.Qualified (P.ByModuleName (P.ModuleName "$Effect")) (P.ProperName "Effect")))
                                   P.srcTypeWildcard))
-    mainDecl      = P.ValueDecl (internalSpan, []) (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]
+    mainDecl      = P.ValueDecl (internalSpan, []) Nothing (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]
     decls         = if exec then [itDecl, typeDecl, mainDecl] else [itDecl]
   in
     P.Module internalSpan

diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs
@@ -256,7 +256,7 @@ lintUnused (Module modSS _ mn modDecls exports) =
 
     -- (non-recursively, recursively) bound idents in decl
     declIdents :: Declaration -> (S.Set (SourceSpan, Ident), S.Set (SourceSpan, Ident))
-    declIdents (ValueDecl (ss,_) ident _ _ _) = (S.empty, S.singleton (ss, ident))
+    declIdents (ValueDecl (ss,_) _ ident _ _ _) = (S.empty, S.singleton (ss, ident))
     declIdents (BoundValueDeclaration _ binders _) = (S.fromList $ binderNamesWithSpans binders, S.empty)
     declIdents _ = (S.empty, S.empty)
 
@@ -274,7 +274,7 @@ lintUnused (Module modSS _ mn modDecls exports) =
         removeAndWarn letNamesRec errs''
 
     -- let f x = e  -- check the x in e (but not the f)
-    underDecl (ValueDecl _ _ _ binders gexprs) =
+    underDecl (ValueDecl _ _ _ _ binders gexprs) =
       let bindNewNames = S.fromList (concatMap binderNamesWithSpans binders)
           allExprs = concatMap unguard gexprs
       in

diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
@@ -130,12 +130,12 @@ prettyPrintDeclaration :: Int -> Declaration -> Box
 prettyPrintDeclaration d _ | d < 0 = ellipsis
 prettyPrintDeclaration d (TypeDeclaration td) =
   text (T.unpack (showIdent (tydeclIdent td)) ++ " :: ") <> typeAsBox d (tydeclType td)
-prettyPrintDeclaration d (ValueDecl _ ident _ [] [GuardedExpr [] val]) =
+prettyPrintDeclaration d (ValueDecl _ _ ident _ [] [GuardedExpr [] val]) =
   text (T.unpack (showIdent ident) ++ " = ") <> prettyPrintValue (d - 1) val
 prettyPrintDeclaration d (BindingGroupDeclaration ds) =
   vsep 1 left (NEL.toList (fmap (prettyPrintDeclaration (d - 1) . toDecl) ds))
   where
-  toDecl ((sa, nm), t, e) = ValueDecl sa nm t [] [GuardedExpr [] e]
+  toDecl ((sa, ta, nm), t, e) = ValueDecl sa ta nm t [] [GuardedExpr [] e]
 prettyPrintDeclaration _ _ = internalError "Invalid argument to prettyPrintDeclaration"
 
 prettyPrintCaseAlternative :: Int -> CaseAlternative -> Box

diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -160,8 +160,8 @@ flattenBindingGroups = concatMap go
   where
   go (DataBindingGroupDeclaration ds) = NEL.toList ds
   go (BindingGroupDeclaration ds) =
-    NEL.toList $ fmap (\((sa, ident), nameKind, val) ->
-      ValueDecl sa ident nameKind [] [MkUnguarded val]) ds
+    NEL.toList $ fmap (\((sa, ta, ident), nameKind, val) ->
+      ValueDecl sa ta ident nameKind [] [MkUnguarded val]) ds
   go other = [other]
 
 usedIdents :: ModuleName -> ValueDeclarationData Expr -> [Ident]
@@ -253,12 +253,12 @@ toBindingGroup moduleName (CyclicSCC ds') = do
   valueVerts :: [(ValueDeclarationData Expr, Ident, [Ident])]
   valueVerts = fmap (\d -> (d, valdeclIdent d, usedImmediateIdents moduleName (mkDeclaration d) `intersect` idents)) ds'
 
-  toBinding :: SCC (ValueDeclarationData Expr) -> m ((SourceAnn, Ident), NameKind, Expr)
+  toBinding :: SCC (ValueDeclarationData Expr) -> m ((SourceAnn, Maybe SourceAnn, Ident), NameKind, Expr)
   toBinding (AcyclicSCC d) = return $ fromValueDecl d
   toBinding (CyclicSCC ds) = throwError $ foldMap cycleError ds
 
   cycleError :: ValueDeclarationData Expr -> MultipleErrors
-  cycleError (ValueDeclarationData (ss, _) n _ _ _) = errorMessage' ss $ CycleInDeclaration n
+  cycleError (ValueDeclarationData (ss, _) _ n _ _ _) = errorMessage' ss $ CycleInDeclaration n
 
 toDataBindingGroup
   :: MonadError MultipleErrors m
@@ -300,6 +300,6 @@ isTypeSynonym _ = Nothing
 mkDeclaration :: ValueDeclarationData Expr -> Declaration
 mkDeclaration = ValueDeclaration . fmap (pure . MkUnguarded)
 
-fromValueDecl :: ValueDeclarationData Expr -> ((SourceAnn, Ident), NameKind, Expr)
-fromValueDecl (ValueDeclarationData sa ident nameKind [] val) = ((sa, ident), nameKind, val)
+fromValueDecl :: ValueDeclarationData Expr -> ((SourceAnn, Maybe SourceAnn, Ident), NameKind, Expr)
+fromValueDecl (ValueDeclarationData sa ta ident nameKind [] val) = ((sa, ta, ident), nameKind, val)
 fromValueDecl ValueDeclarationData{} = internalError "Binders should have been desugared"
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -65,7 +65,7 @@ desugarGuardedExprs ss (Case scrut alternatives)
     (scrut', scrut_decls) <- unzip <$> forM scrut (\e -> do
       scrut_id <- freshIdent'
       pure ( Var ss (Qualified ByNullSourcePos scrut_id)
-           , ValueDecl (ss, []) scrut_id Private [] [MkUnguarded e]
+           , ValueDecl (ss, []) Nothing scrut_id Private [] [MkUnguarded e]
            )
       )
     Let FromLet scrut_decls <$> desugarGuardedExprs ss (Case scrut' alternatives)
@@ -232,7 +232,7 @@ desugarGuardedExprs ss (Case scrut alternatives) =
           alt_fail n = [CaseAlternative (replicate n NullBinder) [MkUnguarded goto_rem_case]]
 
         pure $ Let FromLet [
-          ValueDecl (ss, []) rem_case_id Private []
+          ValueDecl (ss, []) Nothing rem_case_id Private []
             [MkUnguarded (Abs (VarBinder ss unused_binder) desugared)]
           ] (mk_body alt_fail)
 
@@ -329,10 +329,10 @@ desugarCases = desugarRest <=< fmap join . flip parU toDecls . groupBy inSameGro
     desugarRest :: [Declaration] -> m [Declaration]
     desugarRest (TypeInstanceDeclaration sa na cd idx name constraints className tys ds : rest) =
       (:) <$> (TypeInstanceDeclaration sa na cd idx name constraints className tys <$> traverseTypeInstanceBody desugarCases ds) <*> desugarRest rest
-    desugarRest (ValueDecl sa name nameKind bs result : rest) =
+    desugarRest (ValueDecl sa ta name nameKind bs result : rest) =
       let (_, f, _) = everywhereOnValuesTopDownM return go return
           f' = mapM (\(GuardedExpr gs e) -> GuardedExpr gs <$> f e)
-      in (:) <$> (ValueDecl sa name nameKind bs <$> f' result) <*> desugarRest rest
+      in (:) <$> (ValueDecl sa ta name nameKind bs <$> f' result) <*> desugarRest rest
       where
       go (Let w ds val') = Let w <$> desugarCases ds <*> pure val'
       go other = return other
@@ -344,19 +344,19 @@ inSameGroup (ValueDeclaration vd1) (ValueDeclaration vd2) = valdeclIdent vd1 ==
 inSameGroup _ _ = False
 
 toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
-toDecls [ValueDecl sa@(ss, _) ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do
+toDecls [ValueDecl sa@(ss, _) ta ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do
   args <- mapM fromVarBinder bs
   let body = foldr (Abs . VarBinder ss) val args
   guardWith (errorMessage' ss (OverlappingArgNames (Just ident))) $ length (ordNub args) == length args
-  return [ValueDecl sa ident nameKind [] [MkUnguarded body]]
+  return [ValueDecl sa ta ident nameKind [] [MkUnguarded body]]
   where
   fromVarBinder :: Binder -> m Ident
   fromVarBinder NullBinder = freshIdent'
   fromVarBinder (VarBinder _ name) = return name
   fromVarBinder (PositionedBinder _ _ b) = fromVarBinder b
   fromVarBinder (TypedBinder _ b) = fromVarBinder b
   fromVarBinder _ = internalError "fromVarBinder: Invalid argument"
-toDecls ds@(ValueDecl (ss, _) ident _ bs (result : _) : _) = do
+toDecls ds@(ValueDecl (ss, _) _ ident _ bs (result : _) : _) = do
   let tuples = map toTuple ds
 
       isGuarded (MkUnguarded _) = False
@@ -371,7 +371,7 @@ toDecls ds@(ValueDecl (ss, _) ident _ bs (result : _) : _) = do
 toDecls ds = return ds
 
 toTuple :: Declaration -> ([Binder], [GuardedExpr])
-toTuple (ValueDecl _ _ _ bs result) = (bs, result)
+toTuple (ValueDecl _ _ _ _ bs result) = (bs, result)
 toTuple _ = internalError "Not a value declaration"
 
 makeCaseDeclaration :: forall m. (MonadSupply m) => SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration
@@ -385,7 +385,7 @@ makeCaseDeclaration ss ident alternatives = do
       binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]
   let value = foldr (Abs . uncurry VarBinder) (Case vars binders) args
 
-  return $ ValueDecl (ss, []) ident Public [] [MkUnguarded value]
+  return $ ValueDecl (ss, []) Nothing ident Public [] [MkUnguarded value]
   where
   -- We will construct a table of potential names.
   -- VarBinders will become Just _ which is a potential name.

diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs
@@ -74,7 +74,7 @@ desugarDo d =
   go _ _ [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet
   go pos m (DoNotationLet ds : rest) = do
     let checkBind :: Declaration -> m ()
-        checkBind (ValueDecl (ss, _) i@(Ident name) _ _ _)
+        checkBind (ValueDecl (ss, _) _ i@(Ident name) _ _ _)
           | name `elem` [ C.S_bind, C.S_discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i
         checkBind _ = pure ()
     mapM_ checkBind ds