diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 88f3598..4591f41 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -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 + } + ############################################################################### ############################################################################### ############################################################################### diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index 00453b3..c50a4e1 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -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 -> + HsDataDefn DataType (L _ lhsContext) _ctype Nothing conss mDerivs -> #endif - case cons of + docWrapNode ltycl $ do + lhsContextDoc <- docSharedWrapper createContextDoc lhsContext + nameStr <- lrdrNameToTextAnn name + 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)) -> + (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) -> do #else - (L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) -> + (L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) -> do #endif - docWrapNode ltycl $ do - lhsContextDoc <- docSharedWrapper createContextDoc lhsContext - nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName - tyVarLine <- fmap return $ createBndrDoc bndrs forallDocMay <- case createForallDoc qvars of Nothing -> pure Nothing Just x -> Just . pure <$> x @@ -119,123 +120,117 @@ 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] - , docSeq - [ docLitS "." - , docSeparator - , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc] + (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 + , rhsContextDoc + , rhsDoc ] - , maybe docEmpty docForceSingleline rhsContextDocMay - , rhsDoc + ] + (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 ] + , parConstructors consDocs ] - , -- data D - -- = forall a . Show a => D a - docAddBaseY BrIndentRegular $ docPar - ( 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 - ] - , maybe docEmpty docForceSingleline rhsContextDocMay - , rhsDoc - ] - ] - ) - , -- data D - -- = forall a - -- . Show a => - -- D a - docAddBaseY BrIndentRegular $ docPar - ( docNodeAnnKW ltycl (Just GHC.AnnData) - $ docSeq - [ appSep $ docLitS "data" - , docForceSingleline lhsContextDoc - , appSep $ docLit nameStr - , tyVarLine - ] - ) - consDoc - , -- data - -- Show a => - -- D - -- = forall a - -- . Show a => - -- D a - -- This alternative is only for -XDatatypeContexts. - -- But I think it is rather unlikely this will trigger without - -- -XDataTypeContexts, especially with the `docNonBottomSpacing` - -- above, so while not strictly necessary, this should not - -- hurt. - docAddBaseY BrIndentRegular $ docPar - (docLitS "data") - ( docLines - [ lhsContextDoc - , docNodeAnnKW ltycl (Just GHC.AnnData) - $ docSeq - [ appSep $ docLit nameStr - , tyVarLine - ] - , consDoc - ] - ) + , -- data D + -- = forall a + -- . Show a => + -- D a + docAddBaseY BrIndentRegular + $ docPar ( docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLitS "data" + , docForceSingleline lhsContextDoc + , appSep $ docLit nameStr + , tyVarLine + ] + ) + (parConstructors consDocs) + , -- data + -- Show a => + -- D + -- = forall a + -- . Show a => + -- D a + -- This alternative is only for -XDatatypeContexts. + -- But I think it is rather unlikely this will trigger without + -- -XDataTypeContexts, especially with the `docNonBottomSpacing` + -- above, so while not strictly necessary, this should not + -- hurt. + docAddBaseY BrIndentRegular $ docPar + (docLitS "data") + ( docLines + [ lhsContextDoc + , docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLit nameStr + , tyVarLine + ] + , 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] =