Update DataDecl to latest master
This update includes necessary code for handling deriving strategies.remotes/ChickenProp/datadecl
parent
33fb0ef0ec
commit
b02077e010
|
@ -350,6 +350,15 @@ data Foo = Bar
|
|||
}
|
||||
deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
|
||||
|
||||
#test record multiple deriving strategies
|
||||
data Foo = Bar
|
||||
{ foo :: Baz
|
||||
, bars :: Bizzz
|
||||
}
|
||||
deriving Show
|
||||
deriving anyclass (Show, Eq, Monad, Functor)
|
||||
deriving newtype (Traversable, Foldable)
|
||||
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
|
|
|
@ -40,7 +40,6 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Module
|
||||
import Language.Haskell.Brittany.Internal.Layouters.DataDecl
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
import Language.Haskell.Brittany.Internal.Backend
|
||||
import Language.Haskell.Brittany.Internal.BackendUtils
|
||||
|
|
|
@ -17,6 +17,7 @@ import Language.Haskell.Brittany.Internal.Config.Types
|
|||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
||||
import BasicTypes (DerivStrategy(..))
|
||||
import qualified GHC
|
||||
import HsSyn
|
||||
import Name
|
||||
|
@ -138,23 +139,38 @@ createBndrDoc bs = do
|
|||
]
|
||||
|
||||
createDerivingPar
|
||||
:: HsDeriving RdrName
|
||||
-> ToBriDocM BriDocNumbered
|
||||
-> ToBriDocM BriDocNumbered
|
||||
:: HsDeriving RdrName -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
createDerivingPar mDerivs mainDoc = do
|
||||
case mDerivs of
|
||||
Nothing -> docLines [mainDoc]
|
||||
Just (L _ [(HsIB _ t)]) -> do
|
||||
docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
|
||||
[docDeriving, docSeparator, layoutType t]
|
||||
Just (L _ ts ) -> do
|
||||
docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
|
||||
(L _ []) -> docLines [mainDoc]
|
||||
(L _ types) ->
|
||||
docPar mainDoc
|
||||
$ docEnsureIndent BrIndentRegular
|
||||
$ docLines
|
||||
$ derivingClause
|
||||
<$> types
|
||||
where
|
||||
handleStrategy = \case
|
||||
(L _ StockStrategy ) -> docLit $ Text.pack ""
|
||||
(L _ AnyclassStrategy) -> docLit $ Text.pack "anyclass"
|
||||
(L _ NewtypeStrategy ) -> docLit $ Text.pack "newtype"
|
||||
derivingClause (L _ (HsDerivingClause mStrategy types)) = case types of
|
||||
(L _ []) -> docSeq []
|
||||
(L _ ts) ->
|
||||
let
|
||||
tsLength = length ts
|
||||
whenMoreThan1Type val =
|
||||
if tsLength > 1 then docLit (Text.pack val) else docLit (Text.pack "")
|
||||
in
|
||||
docSeq
|
||||
[ docDeriving
|
||||
, docSeq
|
||||
$ maybe [] ((docSeparator :) . pure . handleStrategy) mStrategy
|
||||
, docSeparator
|
||||
, docLit $ Text.pack "("
|
||||
, docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
|
||||
, whenMoreThan1Type "("
|
||||
, docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t _) ->
|
||||
layoutType t
|
||||
, docLit $ Text.pack ")"
|
||||
, whenMoreThan1Type ")"
|
||||
]
|
||||
|
||||
docDeriving :: ToBriDocM BriDocNumbered
|
||||
|
|
|
@ -41,6 +41,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
|
|||
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||
import Language.Haskell.Brittany.Internal.Layouters.DataDecl
|
||||
|
||||
import Bag ( mapBagM )
|
||||
|
||||
|
@ -52,6 +53,8 @@ layoutDecl d@(L loc decl) = case decl of
|
|||
ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
|
||||
Left ns -> docLines $ return <$> ns
|
||||
Right n -> return n
|
||||
TyClD (DataDecl name tyVars _ dataDefn _ _) ->
|
||||
withTransformedAnns d $ layoutDataDecl d name tyVars dataDefn
|
||||
InstD (TyFamInstD{}) -> do
|
||||
-- this is a (temporary (..)) workaround for "type instance" decls
|
||||
-- that do not round-trip through exactprint properly.
|
||||
|
|
Loading…
Reference in New Issue