The context is as follows: I am working on a code action in haskell-language-server to automatically fix “Data constructor is not in scope” errors. To give an example, in the following code
module Parser where
data ParseError
data NestedBrackets
= Empty
| Nested NestedBrackets
| Concat NestedBrackets NestedBrackets
parseBrackets :: Int -> String -> Either ParseError NestedBrackets
parseBrackets depth chars = case chars of
[] ->
if depth == 0
then pure Empty
else Left $ UnexpectedEof depth
token UnexpectedEof
is going to be highlighted with red squiggly lines in VSCode, and the error message suffices to make it possible to add a new data constructor to ParseError
automatically. The core part of the code that does the transformation looks as follows:
addConstructor :: MissingConstructor -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
addConstructor mc decl = case unLoc decl of
TyClD a (DataDecl {tcdDataDefn=tcdDataDefn, tcdLName=tcdLName, ..}) ->
case tcdDataDefn of
HsDataDefn {dd_cons=(DataTypeCons b cs), ..} -> flip mapLoc decl $ \_ ->
let newConBuilder :: DataConBuilder = PrefixDataConBuilder (toOL $ _conArgTypes mc) (_conName mc) in
let newCon :: ConDecl GhcPs = ConDeclH98 EpAnnNotUsed (_conName mc) False [] Nothing (dataConBuilderDetails newConBuilder) Nothing in
let dataDefn = HsDataDefn { dd_cons=DataTypeCons b (L noSrcSpanA newCon : cs), .. } in
TyClD a (DataDecl { tcdDataDefn = dataDefn, .. })
_ -> decl
_ -> decl
createTransform :: HasDecls a => MissingConstructor -> a -> TransformT Maybe a
createTransform mc a = do
decls <- hsDecls a
(prefix, right : suffix) <- pure $ break (isRightDecl mc) decls
replaceDecls a (prefix ++ addConstructor mc right : suffix)
The problem is that when I use the modified tree to get the concrete text out of it, it does not render correctly. Specifically, the “source” I get in the end looks like that:
data ParseErrorUnexpectedEofInt
I was expecting the contract of ghc-exactprint
to be that if I have a modified tree that it’s going to be printed to a correct syntax, is that not the case? Or maybe I’m breaking some invariants by constructing the parse tree the way that I do and I should use some smart constructors instead?
I have looked around for documentation on how to perform the transformations, but haven’t found anything so far. Haddock is not particularly informative.