Merge pull request #95 from eborden/datadecl

Format data declarations

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)
+
+
 ###############################################################################
 ###############################################################################
 ###############################################################################

src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs

@@ -103,7 +103,7 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
       _ -> briDocByExact ld
 
   _ -> briDocByExactNoComment ld
- where
+
 createContextDoc :: HsContext RdrName -> ToBriDocM BriDocNumbered
 createContextDoc [] = docEmpty
 createContextDoc [t] =
@@ -114,6 +114,7 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
   , docLit (Text.pack ") =>")
   , docSeparator
   ]
+
 createBndrDoc :: [LHsTyVarBndr RdrName] -> ToBriDocM BriDocNumbered
 createBndrDoc bs = do
   tyVarDocs <- bs `forM` \case
@@ -135,6 +136,7 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
             , kind
             , docLit (Text.pack ")")
             ]
+
 createDerivingPar
   :: HsDeriving RdrName
   -> ToBriDocM BriDocNumbered
@@ -143,17 +145,21 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
   case mDerivs of
     Nothing                 -> docLines [mainDoc]
     Just (L _ [(HsIB _ t)]) -> do
-        docAddBaseY BrIndentRegular $ docPar mainDoc $ docSeq
+      docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
-          [docLit $ Text.pack "deriving", docSeparator, layoutType t]
+        [docDeriving, docSeparator, layoutType t]
     Just (L _ ts          ) -> do
-        docAddBaseY BrIndentRegular $ docPar mainDoc $ docSeq
+      docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
-          [ docLit $ Text.pack "deriving"
+        [ docDeriving
         , docSeparator
         , docLit $ Text.pack "("
         , docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
           layoutType t
         , docLit $ Text.pack ")"
         ]
+
+docDeriving :: ToBriDocM BriDocNumbered
+docDeriving = docLit $ Text.pack "deriving"
+
 createDetailsDoc
   :: Text -> HsConDeclDetails RdrName -> (ToBriDocM BriDocNumbered)
 createDetailsDoc consNameStr details = case details of
@@ -162,25 +168,31 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
     , docSeparator
     , docSeq $ List.intersperse docSeparator $ args <&> layoutType
     ]
-    RecCon    (L _ fields) -> docSeq
+  RecCon (L _ []) -> docEmpty
-      [ appSep $ docLit $ Text.pack "{"
+  RecCon (L _ [L _ (ConDeclField names t _)]) -> docSeq
-      , docSeq
+    [ docLit consNameStr
-        $   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 "::"
+    , appSep $ docLit $ Text.pack "{"
+    , createNamesAndTypeDoc names t
     , docSeparator
-                , layoutType t
-                ]
     , 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
@@ -188,6 +200,7 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
     , docSeparator
     , layoutType arg2
     ]
+
 createForallDoc :: Maybe (LHsQTyVars RdrName) -> ToBriDocM BriDocNumbered
 createForallDoc Nothing                   = docEmpty
 createForallDoc (Just (HsQTvs _ bs _)) = do
@@ -199,3 +212,16 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
     , 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
+  ]