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

Merge pull request #95 from eborden/datadecl 

Format data declarations
pull/105/head
Lennart Spitzner 2018-01-13 17:10:32 +01:00 committed by GitHub
parent 2dad7f82fe cde1399c4f
commit 55f636fcf2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 160 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src-literatetests/tests-context-free.blt
View File

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

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

@ -103,19 +103,20 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
_ -> briDocByExact ld
_ -> briDocByExactNoComment ld
where
createContextDoc :: HsContext RdrName -> ToBriDocM BriDocNumbered
createContextDoc [] = docEmpty
createContextDoc [t] =
createContextDoc :: HsContext RdrName -> ToBriDocM BriDocNumbered
createContextDoc [] = docEmpty
createContextDoc [t] =
docSeq [layoutType t, docSeparator, docLit (Text.pack "=>"), docSeparator]
createContextDoc ts = docSeq
createContextDoc ts = docSeq
[ docLit (Text.pack "(")
, docSeq $ List.intersperse docCommaSep (layoutType <$> ts)
, docLit (Text.pack ") =>")
, docSeparator
]
createBndrDoc :: [LHsTyVarBndr RdrName] -> ToBriDocM BriDocNumbered
createBndrDoc bs = do
createBndrDoc :: [LHsTyVarBndr RdrName] -> ToBriDocM BriDocNumbered
createBndrDoc bs = do
tyVarDocs <- bs `forM` \case
(L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do
@ -135,40 +136,85 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
, kind
, docLit (Text.pack ")")
]
createDerivingPar
createDerivingPar
:: HsDeriving RdrName
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
createDerivingPar mDerivs mainDoc = do
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]
docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
[docDeriving, docSeparator, layoutType t]
Just (L _ ts ) -> do
docAddBaseY BrIndentRegular $ docPar mainDoc $ docSeq
[ docLit $ Text.pack "deriving"
docPar mainDoc $ docEnsureIndent BrIndentRegular $ docSeq
[ docDeriving
, docSeparator
, docLit $ Text.pack "("
, docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
layoutType t
, docLit $ Text.pack ")"
]
createDetailsDoc
docDeriving :: ToBriDocM BriDocNumbered
docDeriving = docLit $ Text.pack "deriving"
createDetailsDoc
:: Text -> HsConDeclDetails RdrName -> (ToBriDocM BriDocNumbered)
createDetailsDoc consNameStr details = case details of
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
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
@ -179,23 +225,3 @@ layoutDataDecl ld name (HsQTvs _ bndrs _) defn = case defn of
, 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
]