diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 0a3140b..2e46148 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -324,10 +324,14 @@ data Foo = Bar {} data Biz = Baz #test single record -data Foo = Bar { foo :: Baz } +data Foo = Bar + { foo :: Baz + } #test record multiple names -data Foo = Bar { foo, bar :: Baz } +data Foo = Bar + { foo, bar :: Baz + } #test record multiple types data Foo = Bar @@ -348,6 +352,91 @@ data Foo = Bar } deriving Show +#test record long field names +data MyRecord = MyConstructor + { bar1, bar2 + :: Loooooooooooooooooooooooooooooooong + -> Loooooooooooooooooooooooooooooooong + , foo1, foo2 + :: Loooooooooooooooooooooooooooooooonger + -> Loooooooooooooooooooooooooooooooonger + } + +#test record with DataTypeContexts +{-# LANGUAGE DatatypeContexts #-} +data + ( LooooooooooooooooooooongConstraint a + , LooooooooooooooooooooongConstraint b + ) => + MyRecord a b + = MyConstructor + { foo1, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + +#test record single line layout +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int } + +#test record no matching single line layout +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => Bar + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a + . LooooooooooooooooooooongConstraint a => + LoooooooooooongConstructor + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline more +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { a :: a + , b :: b + } + +#test plain with forall and constraint +{-# LANGUAGE ScopedTypeVariables #-} +data MyStruct + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + +#test record with many features +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { foo, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + deriving Show + #test record multiple types deriving data Foo = Bar { foo :: Baz @@ -382,7 +471,9 @@ data Foo = Bar #test single record existential {-# LANGUAGE ExistentialQuantification #-} -data Foo = forall a . Show a => Bar { foo :: a } +data Foo = forall a . Show a => Bar + { foo :: a + } #test record multiple types existential {-# LANGUAGE ExistentialQuantification #-} @@ -415,8 +506,8 @@ data Foo = Bar -- a data Foo = Bar { -- a foo -- b - :: -- c - Baz -- d + :: -- c + Baz -- d , -- e bars :: Bizzz } @@ -467,16 +558,19 @@ data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse #test normal records on multi line indent policy free -- brittany {lconfig_indentPolicy: IndentPolicyFree } +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy free 2 +-- brittany {lconfig_indentPolicy: IndentPolicyFree } data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse - Types.Company - [EnterpriseGrantResponse] + Types.Company + [EnterpriseGrantResponse] #test normal records on multi line indent policy multiple -- brittany {lconfig_indentPolicy: IndentPolicyMultiple } -data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse - Types.Company - [EnterpriseGrantResponse] - +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] ############################################################################### ############################################################################### diff --git a/src-literatetests/30-tests-context-free.blt b/src-literatetests/30-tests-context-free.blt index 9a09fde..ba84a7c 100644 --- a/src-literatetests/30-tests-context-free.blt +++ b/src-literatetests/30-tests-context-free.blt @@ -321,10 +321,14 @@ func = f ############################################################################### #test single record -data Foo = Bar { foo :: Baz } +data Foo = Bar + { foo :: Baz + } #test record multiple names -data Foo = Bar { foo, bar :: Baz } +data Foo = Bar + { foo, bar :: Baz + } #test record multiple types data Foo = Bar diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index 82f97cb..d0b9094 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -214,6 +214,7 @@ defaultTestConfig = Config , _lconfig_allowSingleLineExportList = coerce True , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + , _lconfig_allowSinglelineRecord = coerce False } , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_omit_output_valid_check = coerce True } , _conf_preprocessor = _conf_preprocessor staticDefaultConfig diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs index d9555cc..f2dc542 100644 --- a/src-unittests/TestUtils.hs +++ b/src-unittests/TestUtils.hs @@ -61,6 +61,7 @@ defaultTestConfig = Config , _lconfig_allowSingleLineExportList = coerce True , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + , _lconfig_allowSinglelineRecord = coerce False } , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 508a18c..bf30a4e 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -245,9 +245,10 @@ layoutWriteEnsureAbsoluteN -> m () layoutWriteEnsureAbsoluteN n = do state <- mGet - let diff = case _lstate_curYOrAddNewline state of - Left i -> n - i - Right{} -> n + let diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of + (Just c , _ ) -> n - c + (Nothing, Left i ) -> n - i + (Nothing, Right{}) -> n traceLocal ("layoutWriteEnsureAbsoluteN", n, diff) when (diff > 0) $ do mSet $ state { _lstate_addSepSpace = Just diff -- this always sets to @@ -557,6 +558,7 @@ layoutWritePostComments ast = do ) -> do replicateM_ x layoutWriteNewline layoutWriteAppend $ Text.pack $ replicate y ' ' + mModify $ \s -> s { _lstate_addSepSpace = Nothing } layoutWriteAppendMultiline $ Text.pack $ comment layoutIndentRestorePostComment diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs index 5d220fd..9dac6b7 100644 --- a/src/Language/Haskell/Brittany/Internal/Config.hs +++ b/src/Language/Haskell/Brittany/Internal/Config.hs @@ -77,6 +77,7 @@ staticDefaultConfig = Config , _lconfig_allowSingleLineExportList = coerce False , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + , _lconfig_allowSinglelineRecord = coerce False } , _conf_errorHandling = ErrorHandlingConfig { _econf_produceOutputOnErrors = coerce False @@ -181,6 +182,7 @@ cmdlineConfigParser = do , _lconfig_allowSingleLineExportList = mempty , _lconfig_allowHangingQuasiQuotes = mempty , _lconfig_experimentalSemicolonNewlines = mempty + , _lconfig_allowSinglelineRecord = mempty } , _conf_errorHandling = ErrorHandlingConfig { _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 29711c5..526afef 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -142,6 +142,14 @@ data CLayoutConfig f = LayoutConfig -- The implementation for this is a bit hacky and not tested; it might -- break output syntax or not work properly for every kind of brace. So -- far I have considered `do` and `case-of`. + , _lconfig_allowSinglelineRecord :: f (Last Bool) + -- if true, layouts record data decls as a single line when possible, e.g. + -- > MyPoint { x :: Double, y :: Double } + -- if false, always use the multi-line layout + -- > MyPoint + -- > { x :: Double + -- > , y :: Double + -- > } } deriving (Generic) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index d7acf16..d46421e 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -13,6 +13,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , filterAnns , docEmpty , docLit + , docLitS , docAlt , CollectAltM , addAlternativeCond @@ -481,6 +482,9 @@ docEmpty = allocateNode BDFEmpty docLit :: Text -> ToBriDocM BriDocNumbered docLit t = allocateNode $ BDFLit t +docLitS :: String -> ToBriDocM BriDocNumbered +docLitS s = allocateNode $ BDFLit $ Text.pack s + docExt :: (ExactPrint.Annotate.Annotate ast) => Located ast diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index 4bb2a98..e11acfa 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -59,17 +59,17 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of consNameStr <- lrdrNameToTextAnn consName tyVarLine <- fmap return $ createBndrDoc bndrs -- headDoc <- fmap return $ docSeq - -- [ appSep $ docLit (Text.pack "newtype") + -- [ appSep $ docLitS "newtype") -- , appSep $ docLit nameStr -- , appSep tyVarLine -- ] rhsDoc <- fmap return $ createDetailsDoc consNameStr details createDerivingPar mDerivs $ docSeq - [ appSep $ docLit (Text.pack "newtype") + [ appSep $ docLitS "newtype" , appSep $ docLit nameStr , appSep tyVarLine , docSeparator - , docLit (Text.pack "=") + , docLitS "=" , docSeparator , rhsDoc ] @@ -88,7 +88,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of nameStr <- lrdrNameToTextAnn name tyVarLine <- fmap return $ createBndrDoc bndrs createDerivingPar mDerivs $ docSeq - [ appSep $ docLit (Text.pack "data") + [ appSep $ docLitS "data" , lhsContextDoc , appSep $ docLit nameStr , appSep tyVarLine @@ -112,22 +112,115 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName tyVarLine <- fmap return $ createBndrDoc bndrs - forallDoc <- docSharedWrapper createForallDoc qvars - rhsContextDoc <- case mRhsContext of - Nothing -> return docEmpty - Just (L _ ctxt) -> docSharedWrapper createContextDoc ctxt + forallDocMay <- case createForallDoc qvars of + Nothing -> pure Nothing + Just x -> Just . pure <$> x + rhsContextDocMay <- case mRhsContext of + Nothing -> pure Nothing + Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt rhsDoc <- fmap return $ createDetailsDoc consNameStr details - createDerivingPar mDerivs $ docSeq - [ appSep $ docLit (Text.pack "data") - , lhsContextDoc - , appSep $ docLit nameStr - , appSep tyVarLine - , docSeparator - , docLit (Text.pack "=") - , docSeparator - , forallDoc - , rhsContextDoc - , rhsDoc + consDoc <- 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, 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 + [ appSep $ docLitS "data" + , docForceSingleline $ lhsContextDoc + , appSep $ docLit nameStr + , appSep tyVarLine + , docSeparator + , docLitS "=" + , docSeparator + , 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 + ( docSeq + [ appSep $ docLitS "data" + , docForceSingleline lhsContextDoc + , appSep $ docLit nameStr + , tyVarLine + ] + ) + ( docSeq + [ docLitS "=" + , docSeparator + , 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 + ( 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 + , docSeq + [ appSep $ docLit nameStr + , tyVarLine + ] + , consDoc + ] + ) ] _ -> briDocByExactNoComment ltycl @@ -136,13 +229,25 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered createContextDoc [] = docEmpty createContextDoc [t] = - docSeq [layoutType t, docSeparator, docLit (Text.pack "=>"), docSeparator] -createContextDoc ts = docSeq - [ docLit (Text.pack "(") - , docSeq $ List.intersperse docCommaSep (layoutType <$> ts) - , docLit (Text.pack ") =>") - , docSeparator - ] + docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator] +createContextDoc (t1 : tR) = do + t1Doc <- docSharedWrapper layoutType t1 + tRDocs <- tR `forM` docSharedWrapper layoutType + docAlt + [ docSeq + [ docLitS "(" + , docForceSingleline $ docSeq $ List.intersperse docCommaSep + (t1Doc : tRDocs) + , docLitS ") =>" + , docSeparator + ] + , docLines $ join + [ [docSeq [docLitS "(", docSeparator, t1Doc]] + , tRDocs + <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc] + , [docLitS ") =>", docSeparator] + ] + ] createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered createBndrDoc bs = do @@ -165,13 +270,13 @@ createBndrDoc bs = do <&> \(vname, mKind) -> case mKind of Nothing -> docLit vname Just kind -> docSeq - [ docLit (Text.pack "(") + [ docLitS "(" , docLit vname , docSeparator - , docLit (Text.pack "::") + , docLitS "::" , docSeparator , kind - , docLit (Text.pack ")") + , docLitS ")" ] createDerivingPar @@ -179,7 +284,7 @@ createDerivingPar createDerivingPar derivs mainDoc = do case derivs of #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - (L _ []) -> docLines [mainDoc] + (L _ []) -> mainDoc (L _ types) -> docPar mainDoc $ docEnsureIndent BrIndentRegular @@ -188,7 +293,7 @@ createDerivingPar derivs mainDoc = do $ derivingClauseDoc <$> types #else - Nothing -> docLines [mainDoc] + Nothing -> mainDoc Just types -> docPar mainDoc $ docEnsureIndent BrIndentRegular @@ -213,7 +318,7 @@ derivingClauseDoc types = case types of let tsLength = length ts whenMoreThan1Type val = - if tsLength > 1 then docLit (Text.pack val) else docLit (Text.pack "") + if tsLength > 1 then docLitS val else docLitS "" #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy #else @@ -243,15 +348,15 @@ derivingClauseDoc types = case types of #if MIN_VERSION_ghc(8,2,0) /* ghc-8.6 */ where strategyLeftRight = \case - (L _ StockStrategy ) -> (docLit $ Text.pack " stock", docEmpty) - (L _ AnyclassStrategy ) -> (docLit $ Text.pack " anyclass", docEmpty) - (L _ NewtypeStrategy ) -> (docLit $ Text.pack " newtype", docEmpty) + (L _ StockStrategy ) -> (docLitS " stock", docEmpty) + (L _ AnyclassStrategy ) -> (docLitS " anyclass", docEmpty) + (L _ NewtypeStrategy ) -> (docLitS " newtype", docEmpty) #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ lVia@(L _ (ViaStrategy viaTypes) ) -> ( docEmpty , case viaTypes of HsIB _ext t -> docSeq - [ docWrapNode lVia $ docLit $ Text.pack " via" + [ docWrapNode lVia $ docLitS " via" , docSeparator , layoutType t ] @@ -261,62 +366,109 @@ derivingClauseDoc types = case types of #endif docDeriving :: ToBriDocM BriDocNumbered -docDeriving = docLit $ Text.pack "deriving" +docDeriving = docLitS "deriving" createDetailsDoc :: Text -> HsConDeclDetails GhcPs -> (ToBriDocM BriDocNumbered) createDetailsDoc consNameStr details = case details of PrefixCon args -> do - indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack + indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack let singleLine = docSeq [ docLit consNameStr , docSeparator - , docSeq $ List.intersperse docSeparator $ args <&> layoutType + , docForceSingleline + $ docSeq + $ List.intersperse docSeparator + $ args <&> layoutType ] leftIndented = docSetParSpacing . docAddBaseY BrIndentRegular . docPar (docLit consNameStr) . docLines $ layoutType <$> args - multiIndented = docSetParSpacing - . docSetBaseAndIndent - . docPar (docLit consNameStr) - . docLines - $ layoutType - <$> args + multiAppended = docSeq + [ docLit consNameStr + , docSeparator + , docSetBaseY $ docLines $ layoutType <$> args + ] + multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + (docLit consNameStr) + (docLines $ layoutType <$> args) case indentPolicy of IndentPolicyLeft -> docAlt [singleLine, leftIndented] - IndentPolicyMultiple -> docAlt [singleLine, multiIndented] - IndentPolicyFree -> docAlt [singleLine, multiIndented] + IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented] + IndentPolicyFree -> + docAlt [singleLine, multiAppended, multiIndented, leftIndented] RecCon (L _ []) -> docSeq [docLit consNameStr, docSeparator, docLit $ Text.pack "{}"] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ - RecCon lRec@(L _ [lField@(L _ (ConDeclField _ext names t _))]) -> -#else - RecCon lRec@(L _ [lField@(L _ (ConDeclField names t _))]) -> -#endif - docSetIndentLevel $ docSeq - [ docLit consNameStr - , docSeparator - , docWrapNodePrior lRec $ docLit $ Text.pack "{" - , docSeparator - , docWrapNodeRest lRec $ docSeq $ fmap docForceSingleline $ createNamesAndTypeDoc lField names t - , docSeparator - , docLit $ Text.pack "}" - ] RecCon lRec@(L _ fields@(_:_)) -> do - let (fDoc1 : fDocR) = mkFieldDocs fields - docAddBaseY BrIndentRegular $ docSetIndentLevel $ docPar - (docLit consNameStr) - (docWrapNodePrior lRec $ docLines - [ docCols ColRecDecl - $ appSep (docLit (Text.pack "{")) - : fDoc1 - , docWrapNodeRest lRec $ docLines $ fDocR <&> \f -> - docCols ColRecDecl $ docCommaSep : f - , docLit $ Text.pack "}" - ] - ) + let ((fName1, fType1) : fDocR) = mkFieldDocs fields + allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack + docAddBaseY BrIndentRegular + $ docSetIndentLevel + $ runFilteredAlternative + $ do + -- single-line: { i :: Int, b :: Bool } + addAlternativeCond allowSingleline $ docSeq + [ docLit consNameStr + , docSeparator + , docWrapNodePrior lRec $ docLitS "{" + , docSeparator + , docWrapNodeRest lRec + $ docForceSingleline + $ docSeq + $ join + $ [fName1, docSeparator, docLitS "::", docSeparator, fType1] + : [ [ docLitS "," + , docSeparator + , fName + , docSeparator + , docLitS "::" + , docSeparator + , fType + ] + | (fName, fType) <- fDocR + ] + , docSeparator + , docLitS "}" + ] + addAlternative $ docPar + (docLit consNameStr) + (docWrapNodePrior lRec $ docLines + [ docAlt + [ docCols ColRecDecl + [ appSep (docLitS "{") + , appSep $ docForceSingleline fName1 + , docSeq [docLitS "::", docSeparator] + , docForceSingleline $ fType1 + ] + , docSeq + [ docLitS "{" + , docSeparator + , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + fName1 + (docSeq [docLitS "::", docSeparator, fType1]) + ] + ] + , docWrapNodeRest lRec $ docLines $ fDocR <&> \(fName, fType) -> + docAlt + [ docCols ColRecDecl + [ docCommaSep + , appSep $ docForceSingleline fName + , docSeq [docLitS "::", docSeparator] + , docForceSingleline fType + ] + , docSeq + [ docLitS "," + , docSeparator + , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + fName + (docSeq [docLitS "::", docSeparator, fType]) + ] + ] + , docLitS "}" + ] + ) InfixCon arg1 arg2 -> docSeq [ layoutType arg1 , docSeparator @@ -325,7 +477,9 @@ createDetailsDoc consNameStr details = case details of , layoutType arg2 ] where - mkFieldDocs :: [LConDeclField GhcPs] -> [[ToBriDocM BriDocNumbered]] + mkFieldDocs + :: [LConDeclField GhcPs] + -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)] mkFieldDocs = fmap $ \lField -> case lField of #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t @@ -334,23 +488,19 @@ createDetailsDoc consNameStr details = case details of L _ (ConDeclField names t _) -> createNamesAndTypeDoc lField names t #endif -createForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered -createForallDoc [] = docEmpty -createForallDoc lhsTyVarBndrs = docSeq - [ docLit (Text.pack "forall ") - , createBndrDoc lhsTyVarBndrs - , docLit (Text.pack " .") - , docSeparator - ] +createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered) +createForallDoc [] = Nothing +createForallDoc lhsTyVarBndrs = Just $ docSeq + [docLitS "forall ", createBndrDoc lhsTyVarBndrs] createNamesAndTypeDoc :: Data.Data.Data ast => Located ast -> [GenLocated t (FieldOcc GhcPs)] -> Located (HsType GhcPs) - -> [ToBriDocM BriDocNumbered] + -> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered) createNamesAndTypeDoc lField names t = - [ docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq + ( docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq [ docSeq $ List.intersperse docCommaSep $ names @@ -362,11 +512,6 @@ createNamesAndTypeDoc lField names t = L _ (FieldOcc fieldName _) -> #endif docLit =<< lrdrNameToTextAnn fieldName - , docSeparator ] - , docWrapNodeRest lField $ docSeq - [ docLit $ Text.pack "::" - , docSeparator - , layoutType t - ] - ] + , docWrapNodeRest lField $ layoutType t + )