Support sum type layouting #294
|
|
@ -607,6 +607,27 @@ data XIILqcacwiuNiu = XIILqcacwiuNiu
|
|||
, 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 BasicTypes
|
||||
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
|
||||
import Data.Traversable (for)
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||
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 { .. }
|
||||
#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
|
||||
HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] 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)) ->
|
||||
HsDataDefn DataType (L _ lhsContext) _ctype Nothing conss mDerivs ->
|
||||
#endif
|
||||
docWrapNode ltycl $ do
|
||||
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
|
||||
nameStr <- lrdrNameToTextAnn name
|
||||
consNameStr <- lrdrNameToTextAnn consName
|
||||
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
|
||||
Nothing -> pure Nothing
|
||||
Just x -> Just . pure <$> x
|
||||
|
|
@ -119,87 +120,53 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
|||
Nothing -> pure Nothing
|
||||
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
|
||||
rhsDoc <- fmap return $ createDetailsDoc consNameStr details
|
||||
consDoc <- fmap pure
|
||||
fmap pure
|
||||
$ docNonBottomSpacing
|
||||
$ case (forallDocMay, rhsContextDocMay) of
|
||||
(Just forallDoc, Just rhsContextDoc) -> docLines
|
||||
[ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
|
||||
(Just forallDoc, Just rhsContextDoc) -> docAlt
|
||||
[ docLines
|
||||
[ docSeq [docForceSingleline forallDoc]
|
||||
, docSeq
|
||||
[ docLitS "."
|
||||
, docSeparator
|
||||
, docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
|
||||
]
|
||||
]
|
||||
(Just forallDoc, Nothing) -> docLines
|
||||
[ docSeq [docLitS "=", docSeparator, docForceSingleline 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
|
||||
, docSeq
|
||||
[ forallDoc
|
||||
, docSeparator
|
||||
, docLitS "."
|
||||
, docSeparator
|
||||
]
|
||||
, maybe docEmpty docForceSingleline rhsContextDocMay
|
||||
, rhsContextDoc
|
||||
, rhsDoc
|
||||
]
|
||||
]
|
||||
, -- data D
|
||||
-- = forall a . Show a => D a
|
||||
docAddBaseY BrIndentRegular $ docPar
|
||||
( docNodeAnnKW ltycl (Just GHC.AnnData)
|
||||
(Just forallDoc, Nothing) -> docLines
|
||||
[ docSeq [docForceSingleline forallDoc]
|
||||
, docSeq [docLitS ".", docSeparator, rhsDoc]
|
||||
]
|
||||
(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
|
||||
[ docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
|
||||
[ appSep $ docLitS "data"
|
||||
, docForceSingleline lhsContextDoc
|
||||
, appSep $ docLit nameStr
|
||||
, tyVarLine
|
||||
]
|
||||
)
|
||||
( docSeq
|
||||
[ docLitS "="
|
||||
, docSeparator
|
||||
, docSetIndentLevel $ docSeq
|
||||
[ case forallDocMay of
|
||||
Nothing -> docEmpty
|
||||
Just forallDoc -> docSeq
|
||||
[ docForceSingleline forallDoc
|
||||
, docSeparator
|
||||
, docLitS "."
|
||||
, docSeparator
|
||||
, parConstructors consDocs
|
||||
]
|
||||
, maybe docEmpty docForceSingleline rhsContextDocMay
|
||||
, rhsDoc
|
||||
]
|
||||
]
|
||||
)
|
||||
, -- data D
|
||||
-- = forall a
|
||||
-- . Show a =>
|
||||
-- D a
|
||||
docAddBaseY BrIndentRegular $ docPar
|
||||
( docNodeAnnKW ltycl (Just GHC.AnnData)
|
||||
docAddBaseY BrIndentRegular
|
||||
$ docPar ( docNodeAnnKW ltycl (Just GHC.AnnData)
|
||||
$ docSeq
|
||||
[ appSep $ docLitS "data"
|
||||
, docForceSingleline lhsContextDoc
|
||||
|
|
@ -207,7 +174,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
|||
, tyVarLine
|
||||
]
|
||||
)
|
||||
consDoc
|
||||
(parConstructors consDocs)
|
||||
, -- data
|
||||
-- Show a =>
|
||||
-- D
|
||||
|
|
@ -228,14 +195,42 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
|
|||
[ appSep $ docLit nameStr
|
||||
, tyVarLine
|
||||
]
|
||||
, consDoc
|
||||
, parConstructors consDocs
|
||||
]
|
||||
)
|
||||
]
|
||||
_ -> 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 [] = docEmpty
|
||||
createContextDoc [t] =
|
||||
|
|
|
|||
Loading…
Reference in New Issue