hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Improve data decl layouting 

- Fix bug in BackendUtil/lowest level of brittany about
  alignment being ignored after a comment,
- Properly layout large (more than single-line) types in
  record fields and in data decl rhs arguments,
- Properly layout data decl constructors with large "heads"
  (forall, constraints),
- Add a config flag to control single-line layout of record
  definition,
pull/259/head
Lennart Spitzner 2019-11-25 11:59:25 +01:00 committed by Evan Rutledge Borden
parent 80f370a8e1
commit 5a49277eba
9 changed files with 368 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src-literatetests/10-tests.blt
View File

@ -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]
###############################################################################
###############################################################################

8
src-literatetests/30-tests-context-free.blt
View File

@ -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

1
src-literatetests/Main.hs
View File

@ -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

1
src-unittests/TestUtils.hs
View File

@ -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

8
src/Language/Haskell/Brittany/Internal/BackendUtils.hs
View File

@ -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

2
src/Language/Haskell/Brittany/Internal/Config.hs
View File

@ -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

8
src/Language/Haskell/Brittany/Internal/Config/Types.hs
View File

@ -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)

4
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -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

327
src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
View File

@ -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
)