Type-fixing layoutDataDecl
parent
b4066c5141
commit
ed5bf856a9
|
@ -67,8 +67,8 @@ processDefault x = do
|
|||
briDocByExact
|
||||
::
|
||||
-- (ExactPrint.Annotate.Annotate ast)
|
||||
Data ast
|
||||
=> Located ast
|
||||
(Data ast, Data an)
|
||||
=> LocatedAn an ast
|
||||
-> ToBriDocM BriDocNumbered
|
||||
briDocByExact ast = do
|
||||
-- anns <- mAsk
|
||||
|
@ -86,8 +86,8 @@ briDocByExact ast = do
|
|||
briDocByExactNoComment
|
||||
::
|
||||
-- (ExactPrint.Annotate.Annotate ast)
|
||||
Data ast
|
||||
=> Located ast
|
||||
(Data ast, Data an)
|
||||
=> LocatedAn an ast
|
||||
-> ToBriDocM BriDocNumbered
|
||||
briDocByExactNoComment ast = do
|
||||
-- anns <- mAsk
|
||||
|
@ -477,7 +477,7 @@ docLitS s = allocateNode $ BDFLit $ Text.pack s
|
|||
docExt
|
||||
::
|
||||
-- (ExactPrint.Annotate.Annotate ast)
|
||||
Located ast
|
||||
LocatedAn an ast
|
||||
-- -> ExactPrint.Types.Anns
|
||||
-> Bool
|
||||
-> ToBriDocM BriDocNumbered
|
||||
|
@ -639,15 +639,15 @@ docNodeMoveToKWDP ast kw shouldRestoreIndent bdm =
|
|||
|
||||
class DocWrapable a where
|
||||
docWrapNode :: ( Data.Data.Data ast)
|
||||
=> Located ast
|
||||
=> LocatedAn an ast
|
||||
-> a
|
||||
-> a
|
||||
docWrapNodePrior :: ( Data.Data.Data ast)
|
||||
=> Located ast
|
||||
=> LocatedAn an ast
|
||||
-> a
|
||||
-> a
|
||||
docWrapNodeRest :: ( Data.Data.Data ast)
|
||||
=> Located ast
|
||||
=> LocatedAn an ast
|
||||
-> a
|
||||
-> a
|
||||
|
||||
|
|
|
@ -20,16 +20,16 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
|
||||
|
||||
layoutDataDecl
|
||||
:: Located (TyClDecl GhcPs)
|
||||
-> Located RdrName
|
||||
:: LocatedAn an1 (TyClDecl GhcPs)
|
||||
-> LocatedAn an2 RdrName
|
||||
-> LHsQTyVars GhcPs
|
||||
-> HsDataDefn GhcPs
|
||||
-> ToBriDocM BriDocNumbered
|
||||
layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
|
||||
-- newtype MyType a b = MyType ..
|
||||
HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs ->
|
||||
HsDataDefn _ext NewType _ctxt _ctype Nothing [cons] mDerivs ->
|
||||
case cons of
|
||||
(L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc))
|
||||
(L _ (ConDeclH98 _ext consName False _qvars (Just (L _ [])) details _conDoc))
|
||||
-> docWrapNode ltycl $ do
|
||||
nameStr <- lrdrNameToTextAnn name
|
||||
consNameStr <- lrdrNameToTextAnn consName
|
||||
|
@ -54,9 +54,9 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
|
|||
|
||||
-- data MyData a b
|
||||
-- (zero constructors)
|
||||
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs ->
|
||||
HsDataDefn _ext DataType mLhsContext _ctype Nothing [] mDerivs ->
|
||||
docWrapNode ltycl $ do
|
||||
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
|
||||
lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext
|
||||
nameStr <- lrdrNameToTextAnn name
|
||||
tyVarLine <- return <$> createBndrDoc bndrs
|
||||
createDerivingPar mDerivs $ docSeq
|
||||
|
@ -68,11 +68,11 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
|
|||
|
||||
-- data MyData = MyData ..
|
||||
-- data MyData = MyData { .. }
|
||||
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
|
||||
HsDataDefn _ext DataType mLhsContext _ctype Nothing [cons] mDerivs ->
|
||||
case cons of
|
||||
(L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc))
|
||||
(L _ (ConDeclH98 _ext consName _hasExt qvars mRhsContext details _conDoc))
|
||||
-> docWrapNode ltycl $ do
|
||||
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
|
||||
lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext
|
||||
nameStr <- lrdrNameToTextAnn name
|
||||
consNameStr <- lrdrNameToTextAnn consName
|
||||
tyVarLine <- return <$> createBndrDoc bndrs
|
||||
|
@ -81,7 +81,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
|
|||
Just x -> Just . pure <$> x
|
||||
rhsContextDocMay <- case mRhsContext of
|
||||
Nothing -> pure Nothing
|
||||
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
|
||||
Just lctxt -> Just . pure <$> createContextDoc (Just lctxt)
|
||||
rhsDoc <- return <$> createDetailsDoc consNameStr details
|
||||
consDoc <-
|
||||
fmap pure
|
||||
|
@ -200,11 +200,12 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
|
|||
|
||||
_ -> briDocByExactNoComment ltycl
|
||||
|
||||
createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered
|
||||
createContextDoc [] = docEmpty
|
||||
createContextDoc [t] =
|
||||
docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator]
|
||||
createContextDoc (t1 : tR) = do
|
||||
createContextDoc :: Maybe (LHsContext GhcPs) -> ToBriDocM BriDocNumbered
|
||||
createContextDoc Nothing = docEmpty
|
||||
createContextDoc (Just (L _ lhsContext)) = case lhsContext of
|
||||
[] -> docEmpty
|
||||
[t] -> docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator]
|
||||
(t1 : tR) -> do
|
||||
t1Doc <- docSharedWrapper layoutType t1
|
||||
tRDocs <- tR `forM` docSharedWrapper layoutType
|
||||
docAlt
|
||||
|
|
Loading…
Reference in New Issue