Work in progress, add record formatting tests.
Evan Rutledge Borden
parent
2dad7f82fe
commit
011b108558
|
|
@ -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)
|
||||
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in New Issue