Support sum type layouting #294
|
@ -607,6 +607,27 @@ data XIILqcacwiuNiu = XIILqcacwiuNiu
|
||||||
, jeyOcuesexaYoy_vpqn :: Jgtoyuh ()
|
, jeyOcuesexaYoy_vpqn :: Jgtoyuh ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#test normal data types in sum
|
||||||
|
-- brittany {lconfig_indentPolicy: IndentPolicyLeft }
|
||||||
|
data Foo
|
||||||
|
= Bar
|
||||||
|
| Baz
|
||||||
|
| Biz
|
||||||
|
|
||||||
|
#test records in sum
|
||||||
|
-- brittany {lconfig_indentPolicy: IndentPolicyLeft }
|
||||||
|
data Foo
|
||||||
|
= Bar
|
||||||
|
{ foo :: Int -- hello
|
||||||
|
, bar :: Foo
|
||||||
|
-- how are you
|
||||||
|
}
|
||||||
|
| Baz
|
||||||
|
| Biz
|
||||||
|
{ foo :: Int
|
||||||
|
, bar :: Foo
|
||||||
|
}
|
||||||
|
|
||||||
###############################################################################
|
###############################################################################
|
||||||
###############################################################################
|
###############################################################################
|
||||||
###############################################################################
|
###############################################################################
|
||||||
|
|
|
@ -23,6 +23,7 @@ import HsSyn
|
||||||
import Name
|
import Name
|
||||||
import BasicTypes
|
import BasicTypes
|
||||||
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
|
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
|
||||||
|
import Data.Traversable (for)
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.Layouters.Type
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
|
@ -97,21 +98,21 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
||||||
-- data MyData = MyData ..
|
-- data MyData = MyData ..
|
||||||
-- data MyData = MyData { .. }
|
-- data MyData = MyData { .. }
|
||||||
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
|
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
|
||||||
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
|
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing conss mDerivs ->
|
||||||
#else
|
#else
|
||||||
HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
|
HsDataDefn DataType (L _ lhsContext) _ctype Nothing conss mDerivs ->
|
||||||
#endif
|
|
||||||
case cons of
|
|
||||||
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
|
|
||||||
(L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) ->
|
|
||||||
#else
|
|
||||||
(L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) ->
|
|
||||||
#endif
|
#endif
|
||||||
docWrapNode ltycl $ do
|
docWrapNode ltycl $ do
|
||||||
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
|
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
|
||||||
nameStr <- lrdrNameToTextAnn name
|
nameStr <- lrdrNameToTextAnn name
|
||||||
consNameStr <- lrdrNameToTextAnn consName
|
|
||||||
tyVarLine <- fmap return $ createBndrDoc bndrs
|
tyVarLine <- fmap return $ createBndrDoc bndrs
|
||||||
|
consDocs <- for (filter (not . isGadt) conss) $ \case
|
||||||
|
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
|
||||||
|
(L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) -> do
|
||||||
|
#else
|
||||||
|
(L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) -> do
|
||||||
|
#endif
|
||||||
|
consNameStr <- lrdrNameToTextAnn consName
|
||||||
forallDocMay <- case createForallDoc qvars of
|
forallDocMay <- case createForallDoc qvars of
|
||||||
Nothing -> pure Nothing
|
Nothing -> pure Nothing
|
||||||
Just x -> Just . pure <$> x
|
Just x -> Just . pure <$> x
|
||||||
|
@ -119,87 +120,53 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
||||||
Nothing -> pure Nothing
|
Nothing -> pure Nothing
|
||||||
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
|
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
|
||||||
rhsDoc <- fmap return $ createDetailsDoc consNameStr details
|
rhsDoc <- fmap return $ createDetailsDoc consNameStr details
|
||||||
consDoc <- fmap pure
|
fmap pure
|
||||||
$ docNonBottomSpacing
|
$ docNonBottomSpacing
|
||||||
$ case (forallDocMay, rhsContextDocMay) of
|
$ case (forallDocMay, rhsContextDocMay) of
|
||||||
(Just forallDoc, Just rhsContextDoc) -> docLines
|
(Just forallDoc, Just rhsContextDoc) -> docAlt
|
||||||
[ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
|
[ docLines
|
||||||
|
[ docSeq [docForceSingleline forallDoc]
|
||||||
, docSeq
|
, docSeq
|
||||||
[ docLitS "."
|
[ docLitS "."
|
||||||
, docSeparator
|
, docSeparator
|
||||||
, docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
|
, docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
(Just forallDoc, Nothing) -> docLines
|
, docSeq
|
||||||
[ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
|
[ forallDoc
|
||||||
, docSeq [docLitS ".", docSeparator, rhsDoc]
|
|
||||||
]
|
|
||||||
(Nothing, Just rhsContextDoc) -> docSeq
|
|
||||||
[ docLitS "="
|
|
||||||
, docSeparator
|
|
||||||
, docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
|
|
||||||
]
|
|
||||||
(Nothing, Nothing) -> docSeq [docLitS "=", docSeparator, rhsDoc]
|
|
||||||
createDerivingPar mDerivs $ docAlt
|
|
||||||
[ -- data D = forall a . Show a => D a
|
|
||||||
docSeq
|
|
||||||
[ docNodeAnnKW ltycl (Just GHC.AnnData)
|
|
||||||
$ docSeq
|
|
||||||
[ appSep $ docLitS "data"
|
|
||||||
, docForceSingleline $ lhsContextDoc
|
|
||||||
, appSep $ docLit nameStr
|
|
||||||
, appSep tyVarLine
|
|
||||||
, docSeparator
|
|
||||||
]
|
|
||||||
, docLitS "="
|
|
||||||
, docSeparator
|
|
||||||
, docSetIndentLevel $ docSeq
|
|
||||||
[ case forallDocMay of
|
|
||||||
Nothing -> docEmpty
|
|
||||||
Just forallDoc -> docSeq
|
|
||||||
[ docForceSingleline forallDoc
|
|
||||||
, docSeparator
|
, docSeparator
|
||||||
, docLitS "."
|
, docLitS "."
|
||||||
, docSeparator
|
, docSeparator
|
||||||
]
|
, rhsContextDoc
|
||||||
, maybe docEmpty docForceSingleline rhsContextDocMay
|
|
||||||
, rhsDoc
|
, rhsDoc
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, -- data D
|
(Just forallDoc, Nothing) -> docLines
|
||||||
-- = forall a . Show a => D a
|
[ docSeq [docForceSingleline forallDoc]
|
||||||
docAddBaseY BrIndentRegular $ docPar
|
, docSeq [docLitS ".", docSeparator, rhsDoc]
|
||||||
( docNodeAnnKW ltycl (Just GHC.AnnData)
|
]
|
||||||
|
(Nothing, Just rhsContextDoc) -> docSeq
|
||||||
|
[ docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
|
||||||
|
]
|
||||||
|
(Nothing, Nothing) -> docSeq [rhsDoc]
|
||||||
|
createDerivingPar mDerivs $ docAlt
|
||||||
|
[ -- data D = forall a . Show a => D a
|
||||||
|
docAddBaseY BrIndentRegular
|
||||||
$ docSeq
|
$ docSeq
|
||||||
|
[ docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
|
||||||
[ appSep $ docLitS "data"
|
[ appSep $ docLitS "data"
|
||||||
, docForceSingleline lhsContextDoc
|
, docForceSingleline lhsContextDoc
|
||||||
, appSep $ docLit nameStr
|
, appSep $ docLit nameStr
|
||||||
, tyVarLine
|
, tyVarLine
|
||||||
]
|
]
|
||||||
)
|
, parConstructors consDocs
|
||||||
( docSeq
|
|
||||||
[ docLitS "="
|
|
||||||
, docSeparator
|
|
||||||
, docSetIndentLevel $ docSeq
|
|
||||||
[ case forallDocMay of
|
|
||||||
Nothing -> docEmpty
|
|
||||||
Just forallDoc -> docSeq
|
|
||||||
[ docForceSingleline forallDoc
|
|
||||||
, docSeparator
|
|
||||||
, docLitS "."
|
|
||||||
, docSeparator
|
|
||||||
]
|
]
|
||||||
, maybe docEmpty docForceSingleline rhsContextDocMay
|
|
||||||
, rhsDoc
|
|
||||||
]
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, -- data D
|
, -- data D
|
||||||
-- = forall a
|
-- = forall a
|
||||||
-- . Show a =>
|
-- . Show a =>
|
||||||
-- D a
|
-- D a
|
||||||
docAddBaseY BrIndentRegular $ docPar
|
docAddBaseY BrIndentRegular
|
||||||
( docNodeAnnKW ltycl (Just GHC.AnnData)
|
$ docPar ( docNodeAnnKW ltycl (Just GHC.AnnData)
|
||||||
$ docSeq
|
$ docSeq
|
||||||
[ appSep $ docLitS "data"
|
[ appSep $ docLitS "data"
|
||||||
, docForceSingleline lhsContextDoc
|
, docForceSingleline lhsContextDoc
|
||||||
|
@ -207,7 +174,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
||||||
, tyVarLine
|
, tyVarLine
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
consDoc
|
(parConstructors consDocs)
|
||||||
, -- data
|
, -- data
|
||||||
-- Show a =>
|
-- Show a =>
|
||||||
-- D
|
-- D
|
||||||
|
@ -228,14 +195,42 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
||||||
[ appSep $ docLit nameStr
|
[ appSep $ docLit nameStr
|
||||||
, tyVarLine
|
, tyVarLine
|
||||||
]
|
]
|
||||||
, consDoc
|
, parConstructors consDocs
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
_ -> briDocByExactNoComment ltycl
|
|
||||||
|
|
||||||
_ -> briDocByExactNoComment ltycl
|
_ -> briDocByExactNoComment ltycl
|
||||||
|
|
||||||
|
isGadt :: Located (ConDecl pass) -> Bool
|
||||||
|
isGadt (L _ ConDeclGADT{}) = True
|
||||||
|
isGadt (L _ ConDeclH98{}) = False
|
||||||
|
isGadt (L _ XConDecl{}) = False
|
||||||
|
|
||||||
|
parConstructors :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
|
||||||
|
parConstructors [] = docEmpty
|
||||||
|
parConstructors [cons] = docAlt
|
||||||
|
[ docSeq
|
||||||
|
[ docSeparator
|
||||||
|
, docLit (Text.pack "=")
|
||||||
|
, docSeparator
|
||||||
|
, cons
|
||||||
|
]
|
||||||
|
, docPar docEmpty
|
||||||
|
$ docSeq
|
||||||
|
[ docLit (Text.pack "=")
|
||||||
|
, docSeparator
|
||||||
|
, cons
|
||||||
|
]
|
||||||
|
]
|
||||||
|
parConstructors (cons:additional) =
|
||||||
|
docPar docEmpty
|
||||||
|
$ docLines
|
||||||
|
$ docSeq [docLit (Text.pack "=") , docSeparator , cons]
|
||||||
|
: toSum additional
|
||||||
|
where
|
||||||
|
toSum = map (\x -> docSeq [docLit (Text.pack "|"), docSeparator, x])
|
||||||
|
|
||||||
createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered
|
createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered
|
||||||
createContextDoc [] = docEmpty
|
createContextDoc [] = docEmpty
|
||||||
createContextDoc [t] =
|
createContextDoc [t] =
|
||||||
|
|
Loading…
Reference in New Issue