From b02077e0109dd379be23fd3b2d066b34dcf2fc24 Mon Sep 17 00:00:00 2001
From: Evan Rutledge Borden <eborden@frontrowed.com>
Date: Tue, 10 Jul 2018 00:50:41 -0400
Subject: [PATCH] Update DataDecl to latest master

This update includes necessary code for handling deriving strategies.
---
 src-literatetests/10-tests.blt                |  9 ++++
 src/Language/Haskell/Brittany/Internal.hs     |  1 -
 .../Brittany/Internal/Layouters/DataDecl.hs   | 48 ++++++++++++-------
 .../Brittany/Internal/Layouters/Decl.hs       |  3 ++
 4 files changed, 44 insertions(+), 17 deletions(-)

diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt
index 8709df9..6936613 100644
--- a/src-literatetests/10-tests.blt
+++ b/src-literatetests/10-tests.blt
@@ -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)
+
 
 ###############################################################################
 ###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs
index 930148c..61b43bc 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -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
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
index c785270..0dd343f 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
@@ -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,24 +139,39 @@ 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
-        [ docDeriving
-        , docSeparator
-        , docLit $ Text.pack "("
-        , docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
-          layoutType t
-        , docLit $ Text.pack ")"
-        ]
+    (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
+          , whenMoreThan1Type "("
+          , docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t _) ->
+            layoutType t
+          , whenMoreThan1Type ")"
+          ]
 
 docDeriving :: ToBriDocM BriDocNumbered
 docDeriving = docLit $ Text.pack "deriving"
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
index ee0596f..0f96afd 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
@@ -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.