From 011b108558373fda757316e2207f409be5e404f4 Mon Sep 17 00:00:00 2001
From: Evan Rutledge Borden <evan@evan-borden.com>
Date: Sat, 30 Dec 2017 21:28:01 -0500
Subject: [PATCH] Work in progress, add record formatting tests.

---
 src-literatetests/tests-context-free.blt      |  41 ++++
 .../Brittany/Internal/Layouters/DataDecl.hs   | 208 ++++++++++--------
 2 files changed, 160 insertions(+), 89 deletions(-)

diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt
index 804511b..65053d0 100644
--- a/src-literatetests/tests-context-free.blt
+++ b/src-literatetests/tests-context-free.blt
@@ -312,6 +312,47 @@ func = f
   f = id
 
 
+###############################################################################
+###############################################################################
+###############################################################################
+#group data type declarations
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test single record
+data Foo = Bar { foo :: Baz }
+
+#test record multiple names
+data Foo = Bar { foo, bar :: Baz }
+
+#test record multiple types
+data Foo = Bar
+  { foo :: Baz
+  , bar :: Bizzz
+  }
+
+#test record multiple types and names
+data Foo = Bar
+  { foo, biz :: Baz
+  , bar :: Bizzz
+  }
+
+#test record multiple types deriving
+data Foo = Bar
+  { foo :: Baz
+  , bar :: Bizzz
+  }
+  deriving Show
+
+#test record multiple types deriving
+data Foo = Bar
+  { foo :: Baz
+  , bar :: Bizzz
+  }
+  deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
+
+
 ###############################################################################
 ###############################################################################
 ###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
index 8820bda..891b841 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
@@ -103,99 +103,129 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
       _ -> briDocByExact ld
 
   _ -> briDocByExactNoComment ld
- where
-  createContextDoc :: HsContext RdrName -> 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
-    ]
-  createBndrDoc :: [LHsTyVarBndr RdrName] -> ToBriDocM BriDocNumbered
-  createBndrDoc bs = do
-    tyVarDocs <- bs `forM` \case
-      (L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing)
-      (L _ (KindedTyVar lrdrName kind)) -> do
-        d <- docSharedWrapper layoutType kind
-        return $ (lrdrNameToText lrdrName, Just $ d)
-    docSeq
-      $   List.intersperse docSeparator
-      $   tyVarDocs
-      <&> \(vname, mKind) -> case mKind of
-            Nothing   -> docLit vname
-            Just kind -> docSeq
-              [ docLit (Text.pack "(")
-              , docLit vname
-              , docSeparator
-              , docLit (Text.pack "::")
-              , docSeparator
-              , kind
-              , docLit (Text.pack ")")
-              ]
-  createDerivingPar
-    :: HsDeriving RdrName
-    -> ToBriDocM BriDocNumbered
-    -> ToBriDocM BriDocNumbered
-  createDerivingPar mDerivs mainDoc = do
-    case mDerivs of
-      Nothing                 -> docLines [mainDoc]
-      Just (L _ [(HsIB _ t)]) -> do
-        docAddBaseY BrIndentRegular $ docPar mainDoc $ docSeq
-          [docLit $ Text.pack "deriving", docSeparator, layoutType t]
-      Just (L _ ts          ) -> do
-        docAddBaseY BrIndentRegular $ docPar mainDoc $ docSeq
-          [ docLit $ Text.pack "deriving"
+
+createContextDoc :: HsContext RdrName -> 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
+  ]
+
+createBndrDoc :: [LHsTyVarBndr RdrName] -> ToBriDocM BriDocNumbered
+createBndrDoc bs = do
+  tyVarDocs <- bs `forM` \case
+    (L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing)
+    (L _ (KindedTyVar lrdrName kind)) -> do
+      d <- docSharedWrapper layoutType kind
+      return $ (lrdrNameToText lrdrName, Just $ d)
+  docSeq
+    $   List.intersperse docSeparator
+    $   tyVarDocs
+    <&> \(vname, mKind) -> case mKind of
+          Nothing   -> docLit vname
+          Just kind -> docSeq
+            [ docLit (Text.pack "(")
+            , docLit vname
+            , docSeparator
+            , docLit (Text.pack "::")
+            , docSeparator
+            , kind
+            , docLit (Text.pack ")")
+            ]
+
+createDerivingPar
+  :: HsDeriving RdrName
+  -> ToBriDocM BriDocNumbered
+  -> ToBriDocM BriDocNumbered
+createDerivingPar mDerivs mainDoc = do
+  case mDerivs of
+    Nothing                 -> docLines [mainDoc]
+    Just (L _ [(HsIB _ t)]) -> do
+      docAlt
+        [ docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
+          [docDeriving, docSeparator, layoutType t]
+        ]
+    Just (L _ ts          ) -> do
+      docAlt
+        [ docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
+          [ docDeriving
           , docSeparator
           , docLit $ Text.pack "("
           , docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
             layoutType t
           , docLit $ Text.pack ")"
           ]
-  createDetailsDoc
-    :: Text -> HsConDeclDetails RdrName -> (ToBriDocM BriDocNumbered)
-  createDetailsDoc consNameStr details = case details of
-    PrefixCon args         -> docSeq
-      [ docLit consNameStr
-      , docSeparator
-      , docSeq $ List.intersperse docSeparator $ args <&> layoutType
-      ]
-    RecCon    (L _ fields) -> docSeq
-      [ appSep $ docLit $ Text.pack "{"
-      , docSeq
-        $   List.intersperse docSeparator
-        $   fields
-        <&> \(L _ (ConDeclField names t _)) -> do
-              docSeq
-                [ docSeq
-                  $   List.intersperse docCommaSep
-                  $   names
-                  <&> \(L _ (FieldOcc fieldName _)) ->
-                        docLit =<< lrdrNameToTextAnn fieldName
-                , docSeparator
-                , docLit $ Text.pack "::"
-                , docSeparator
-                , layoutType t
-                ]
-      , docLit $ Text.pack "}"
-      ]
-    InfixCon arg1 arg2     -> docSeq
-      [ layoutType arg1
-      , docSeparator
-      , docLit consNameStr
-      , docSeparator
-      , layoutType arg2
-      ]
-  createForallDoc :: Maybe (LHsQTyVars RdrName) -> ToBriDocM BriDocNumbered
-  createForallDoc Nothing                   = docEmpty
-  createForallDoc (Just (HsQTvs _ bs _)) = do
-    tDoc <- fmap return $ createBndrDoc bs
-    docSeq
-      [ docLit (Text.pack "forall ")
-      , tDoc
-      , docLit (Text.pack " .")
-      , docSeparator
-      ]
+        ]
 
+docDeriving :: ToBriDocM BriDocNumbered
+docDeriving = docLit $ Text.pack "deriving"
+
+createDetailsDoc
+  :: Text -> HsConDeclDetails RdrName -> (ToBriDocM BriDocNumbered)
+createDetailsDoc consNameStr details = case details of
+  PrefixCon args -> docSeq
+    [ docLit consNameStr
+    , docSeparator
+    , docSeq $ List.intersperse docSeparator $ args <&> layoutType
+    ]
+  RecCon (L _ []) -> docEmpty
+  RecCon (L _ [L _ (ConDeclField names t _)]) -> docSeq
+    [ docLit consNameStr
+    , docSeparator
+    , appSep $ docLit $ Text.pack "{"
+    , createNamesAndTypeDoc names t
+    , docSeparator
+    , docLit $ Text.pack "}"
+    ]
+  RecCon (L _ (fstField:fields)) ->
+    docAddBaseY BrIndentRegular $ docPar
+      (docLit consNameStr)
+      (docLines
+        [ docSeq
+          [ docLit $ Text.pack "{ "
+          , let L _ (ConDeclField names t _) = fstField
+              in createNamesAndTypeDoc names t
+          ]
+        , docLines
+          $ (\(L _ (ConDeclField names t _)) -> 
+              docSeq [docCommaSep, createNamesAndTypeDoc names t])
+          <$> fields
+        , docLit $ Text.pack "}"
+        ]
+      )
+  InfixCon arg1 arg2 -> docSeq
+    [ layoutType arg1
+    , docSeparator
+    , docLit consNameStr
+    , docSeparator
+    , layoutType arg2
+    ]
+
+createForallDoc :: Maybe (LHsQTyVars RdrName) -> ToBriDocM BriDocNumbered
+createForallDoc Nothing                   = docEmpty
+createForallDoc (Just (HsQTvs _ bs _)) = do
+  tDoc <- fmap return $ createBndrDoc bs
+  docSeq
+    [ docLit (Text.pack "forall ")
+    , tDoc
+    , docLit (Text.pack " .")
+    , docSeparator
+    ]
+
+createNamesAndTypeDoc
+  :: [GenLocated t (FieldOcc u)] -> Located (HsType RdrName) -> ToBriDocM BriDocNumbered
+createNamesAndTypeDoc names t = docSeq
+  [ docSeq
+    $   List.intersperse docCommaSep
+    $   names
+    <&> \(L _ (FieldOcc fieldName _)) ->
+          docLit =<< lrdrNameToTextAnn fieldName
+  , docSeparator
+  , docLit $ Text.pack "::"
+  , docSeparator
+  , layoutType t
+  ]