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