{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.Declaration.Data
( p_dataDecl,
)
where
import Control.Monad
import Data.Maybe (isJust, maybeToList)
import Data.Void
import GHC.Hs
import GHC.Types.Fixity
import GHC.Types.ForeignCall
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Type
p_dataDecl ::
FamilyStyle ->
LocatedN RdrName ->
HsTyPats GhcPs ->
LexicalFixity ->
HsDataDefn GhcPs ->
R ()
p_dataDecl :: FamilyStyle
-> LocatedN RdrName
-> HsTyPats GhcPs
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl FamilyStyle
style LocatedN RdrName
name HsTyPats GhcPs
tpats LexicalFixity
fixity HsDataDefn {[LConDecl GhcPs]
HsDeriving GhcPs
Maybe (LHsContext GhcPs)
Maybe (XRec GhcPs (HsType GhcPs))
Maybe (XRec GhcPs CType)
NewOrData
XCHsDataDefn GhcPs
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_derivs :: HsDeriving GhcPs
dd_cons :: [LConDecl GhcPs]
dd_kindSig :: Maybe (XRec GhcPs (HsType GhcPs))
dd_cType :: Maybe (XRec GhcPs CType)
dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ND :: NewOrData
dd_ext :: XCHsDataDefn GhcPs
..} = do
Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ case NewOrData
dd_ND of
NewOrData
NewType -> Text
"newtype"
NewOrData
DataType -> Text
"data"
Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ case FamilyStyle
style of
FamilyStyle
Associated -> forall a. Monoid a => a
mempty
FamilyStyle
Free -> Text
" instance"
case forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (XRec GhcPs CType)
dd_cType of
Maybe CType
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (CType SourceText
prag Maybe Header
header (SourceText
type_, FastString
_)) -> do
SourceText -> R ()
p_sourceText SourceText
prag
case Maybe Header
header of
Maybe Header
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Header SourceText
h FastString
_) -> R ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceText -> R ()
p_sourceText SourceText
h
SourceText -> R ()
p_sourceText SourceText
type_
Text -> R ()
txt Text
" #-}"
let constructorSpans :: [SrcSpan]
constructorSpans = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (pass :: Pass). LHsTypeArg (GhcPass pass) -> SrcSpan
lhsTypeArgSrcSpan HsTyPats GhcPs
tpats
sigSpans :: [SrcSpan]
sigSpans = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall a b. (a -> b) -> a -> b
$ Maybe (XRec GhcPs (HsType GhcPs))
dd_kindSig
declHeaderSpans :: [SrcSpan]
declHeaderSpans = [SrcSpan]
constructorSpans forall a. [a] -> [a] -> [a]
++ [SrcSpan]
sigSpans
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
declHeaderSpans forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
constructorSpans forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
(LexicalFixity -> Bool
isInfix LexicalFixity
fixity)
Bool
True
(LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name)
(LHsTypeArg GhcPs -> R ()
p_lhsTypeArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsTyPats GhcPs
tpats)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (XRec GhcPs (HsType GhcPs))
dd_kindSig forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsType GhcPs)
k -> do
R ()
space
Text -> R ()
txt Text
"::"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
k HsType GhcPs -> R ()
p_hsType
let gadt :: Bool
gadt = forall a. Maybe a -> Bool
isJust Maybe (XRec GhcPs (HsType GhcPs))
dd_kindSig Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConDecl GhcPs -> Bool
isGadt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LConDecl GhcPs]
dd_cons
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl GhcPs]
dd_cons) forall a b. (a -> b) -> a -> b
$
if Bool
gadt
then R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
declHeaderSpans forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
False)) [LConDecl GhcPs]
dd_cons
else [SrcSpan] -> R () -> R ()
switchLayout (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name forall a. a -> [a] -> [a]
: (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LConDecl GhcPs]
dd_cons)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
let singleConstRec :: Bool
singleConstRec = [LConDecl GhcPs] -> Bool
isSingleConstRec [LConDecl GhcPs]
dd_cons
if [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
then R ()
newline
else
if Bool
singleConstRec
then R ()
space
else R ()
breakpoint
R ()
equals
R ()
space
Layout
layout <- R Layout
getLayout
let s :: R ()
s =
if Layout
layout forall a. Eq a => a -> a -> Bool
== Layout
MultiLine Bool -> Bool -> Bool
|| [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
then R ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
else R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
sitcc' :: R () -> R ()
sitcc' =
if [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
singleConstRec
then R () -> R ()
sitcc
else forall a. a -> a
id
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
s (R () -> R ()
sitcc' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec)) [LConDecl GhcPs]
dd_cons
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null HsDeriving GhcPs
dd_derivs) R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) HsDeriving GhcPs
dd_derivs
p_conDecl ::
Bool ->
ConDecl GhcPs ->
R ()
p_conDecl :: Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec = \case
ConDeclGADT {[LIdP GhcPs]
Maybe LHsDocString
Maybe (LHsContext GhcPs)
HsConDeclGADTDetails GhcPs
XConDeclGADT GhcPs
XRec GhcPs (HsType GhcPs)
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_doc :: Maybe LHsDocString
con_res_ty :: XRec GhcPs (HsType GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_names :: [LIdP GhcPs]
con_g_ext :: XConDeclGADT GhcPs
..} -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True) Maybe LHsDocString
con_doc
let conDeclSpn :: [SrcSpan]
conDeclSpn =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LIdP GhcPs]
con_names
forall a. Semigroup a => a -> a -> a
<> [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs]
forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
con_mb_cxt)
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conArgsSpans
where
conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDeclGADTDetails GhcPs
con_g_args of
PrefixConGADT [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs
RecConGADT XRec GhcPs [LConDeclField GhcPs]
x -> [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
x]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn forall a b. (a -> b) -> a -> b
$ do
case [LIdP GhcPs]
con_names of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(LIdP GhcPs
c : [LIdP GhcPs]
cs) -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
R ()
commaDel
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
cs
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
R ()
space
Text -> R ()
txt Text
"::"
let interArgBreak :: R ()
interArgBreak =
if HsType GhcPs -> Bool
hasDocStrings (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsType GhcPs)
con_res_ty)
then R ()
newline
else R ()
breakpoint
R ()
interArgBreak
let conTy :: GenLocated SrcSpanAnnA (HsType GhcPs)
conTy = case HsConDeclGADTDetails GhcPs
con_g_args of
PrefixConGADT [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs ->
let go :: HsScaled pass (GenLocated (SrcSpanAnn' a1) (HsType pass))
-> GenLocated (SrcSpanAnn' a1) (HsType pass)
-> GenLocated (SrcAnn ann) (HsType pass)
go (HsScaled HsArrow pass
a GenLocated (SrcSpanAnn' a1) (HsType pass)
b) GenLocated (SrcSpanAnn' a1) (HsType pass)
t = forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA GenLocated (SrcSpanAnn' a1) (HsType pass)
t GenLocated (SrcSpanAnn' a1) (HsType pass)
b (forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy forall ann. EpAnn ann
EpAnnNotUsed HsArrow pass
a GenLocated (SrcSpanAnn' a1) (HsType pass)
b GenLocated (SrcSpanAnn' a1) (HsType pass)
t)
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {pass} {ann} {a1} {ann}.
(XFunTy pass ~ EpAnn ann,
XRec pass (HsType pass)
~ GenLocated (SrcSpanAnn' a1) (HsType pass)) =>
HsScaled pass (GenLocated (SrcSpanAnn' a1) (HsType pass))
-> GenLocated (SrcSpanAnn' a1) (HsType pass)
-> GenLocated (SrcAnn ann) (HsType pass)
go XRec GhcPs (HsType GhcPs)
con_res_ty [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs
RecConGADT XRec GhcPs [LConDeclField GhcPs]
r ->
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA XRec GhcPs [LConDeclField GhcPs]
r XRec GhcPs (HsType GhcPs)
con_res_ty forall a b. (a -> b) -> a -> b
$
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy
forall ann. EpAnn ann
EpAnnNotUsed
(forall pass. IsUnicodeSyntax -> HsArrow pass
HsUnrestrictedArrow IsUnicodeSyntax
NormalSyntax)
(forall ann1 a2 ann2. LocatedAn ann1 a2 -> LocatedAn ann2 a2
la2la forall a b. (a -> b) -> a -> b
$ forall pass. XRecTy pass -> [LConDeclField pass] -> HsType pass
HsRecTy forall ann. EpAnn ann
EpAnnNotUsed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XRec GhcPs [LConDeclField GhcPs]
r)
XRec GhcPs (HsType GhcPs)
con_res_ty
qualTy :: GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy = case Maybe (LHsContext GhcPs)
con_mb_cxt of
Maybe (LHsContext GhcPs)
Nothing -> GenLocated SrcSpanAnnA (HsType GhcPs)
conTy
Just LHsContext GhcPs
qs ->
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsContext GhcPs
qs GenLocated SrcSpanAnnA (HsType GhcPs)
conTy forall a b. (a -> b) -> a -> b
$
forall pass.
XQualTy pass
-> Maybe (LHsContext pass) -> LHsType pass -> HsType pass
HsQualTy NoExtField
NoExtField (forall a. a -> Maybe a
Just LHsContext GhcPs
qs) GenLocated SrcSpanAnnA (HsType GhcPs)
conTy
quantifiedTy :: GenLocated (SrcAnn Any) (HsType GhcPs)
quantifiedTy =
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy forall a b. (a -> b) -> a -> b
$
HsOuterSigTyVarBndrs GhcPs
-> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
hsOuterTyVarBndrsToHsType (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs) GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy
HsType GhcPs -> R ()
p_hsType (forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn Any) (HsType GhcPs)
quantifiedTy)
ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe LHsDocString
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_doc :: Maybe LHsDocString
con_args :: HsConDeclH98Details GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_forall :: Bool
con_name :: LIdP GhcPs
con_ext :: XConDeclH98 GhcPs
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True) Maybe LHsDocString
con_doc
let conDeclWithContextSpn :: [SrcSpan]
conDeclWithContextSpn =
[RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
real forall a. Maybe a
Nothing | AddEpAnn AnnKeywordId
AnnForall (EpaSpan RealSrcSpan
real) <- EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns XConDeclH98 GhcPs
con_ext]
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs
forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
con_mb_cxt)
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conDeclSpn
conDeclSpn :: [SrcSpan]
conDeclSpn = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
con_name forall a. a -> [a] -> [a]
: [SrcSpan]
conArgsSpans
where
conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDeclH98Details GhcPs
con_args of
PrefixCon [] [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs
PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
_ -> forall a. Void -> a
absurd Void
v
RecCon XRec GhcPs [LConDeclField GhcPs]
l -> [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
l]
InfixCon HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
x HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
y -> forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
x, HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
y]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclWithContextSpn forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
con_forall forall a b. (a -> b) -> a -> b
$ do
forall a. ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R ()
p_forallBndrs ForAllVisibility
ForAllInvis forall flag.
IsInferredTyVarBndr flag =>
HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs
R ()
breakpoint
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
con_mb_cxt LHsContext GhcPs -> R ()
p_lhsContext
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn forall a b. (a -> b) -> a -> b
$ case HsConDeclH98Details GhcPs
con_args of
PrefixCon [] [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
con_name
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs) R ()
breakpoint
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsTypePostDoc) (forall pass a. HsScaled pass a -> a
hsScaledThing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs)
PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
_ -> forall a. Void -> a
absurd Void
v
RecCon XRec GhcPs [LConDeclField GhcPs]
l -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
con_name
R ()
breakpoint
Bool -> R () -> R ()
inciIf (Bool -> Bool
not Bool
singleConstRec) (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LConDeclField GhcPs]
l [LConDeclField GhcPs] -> R ()
p_conDeclFields)
InfixCon (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType GhcPs)
x) (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType GhcPs)
y) -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
x HsType GhcPs -> R ()
p_hsType
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
con_name
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
y HsType GhcPs -> R ()
p_hsType
p_lhsContext ::
LHsContext GhcPs ->
R ()
p_lhsContext :: LHsContext GhcPs -> R ()
p_lhsContext = \case
L SrcSpanAnnC
_ [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
LHsContext GhcPs
ctx -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsContext GhcPs
ctx HsContext GhcPs -> R ()
p_hsContext
R ()
space
Text -> R ()
txt Text
"=>"
R ()
breakpoint
isGadt :: ConDecl GhcPs -> Bool
isGadt :: ConDecl GhcPs -> Bool
isGadt = \case
ConDeclGADT {} -> Bool
True
ConDeclH98 {} -> Bool
False
p_hsDerivingClause ::
HsDerivingClause GhcPs ->
R ()
p_hsDerivingClause :: HsDerivingClause GhcPs -> R ()
p_hsDerivingClause HsDerivingClause {Maybe (LDerivStrategy GhcPs)
XCHsDerivingClause GhcPs
LDerivClauseTys GhcPs
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_ext :: XCHsDerivingClause GhcPs
..} = do
Text -> R ()
txt Text
"deriving"
let derivingWhat :: R ()
derivingWhat = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LDerivClauseTys GhcPs
deriv_clause_tys forall a b. (a -> b) -> a -> b
$ \case
DctSingle NoExtField
XDctSingle GhcPs
NoExtField LHsSigType GhcPs
sigTy -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
sigTy HsSigType GhcPs -> R ()
p_hsSigType
DctMulti NoExtField
XDctMulti GhcPs
NoExtField [LHsSigType GhcPs]
sigTys ->
BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
(R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsSigType GhcPs -> R ()
p_hsSigType)
[LHsSigType GhcPs]
sigTys
R ()
space
case Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy of
Maybe (LDerivStrategy GhcPs)
Nothing -> do
R ()
breakpoint
R () -> R ()
inci R ()
derivingWhat
Just (L SrcSpan
_ DerivStrategy GhcPs
a) -> case DerivStrategy GhcPs
a of
StockStrategy XStockStrategy GhcPs
_ -> do
Text -> R ()
txt Text
"stock"
R ()
breakpoint
R () -> R ()
inci R ()
derivingWhat
AnyclassStrategy XAnyClassStrategy GhcPs
_ -> do
Text -> R ()
txt Text
"anyclass"
R ()
breakpoint
R () -> R ()
inci R ()
derivingWhat
NewtypeStrategy XNewtypeStrategy GhcPs
_ -> do
Text -> R ()
txt Text
"newtype"
R ()
breakpoint
R () -> R ()
inci R ()
derivingWhat
ViaStrategy (XViaStrategyPs EpAnn [AddEpAnn]
_ LHsSigType GhcPs
sigTy) -> do
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
R ()
derivingWhat
R ()
breakpoint
Text -> R ()
txt Text
"via"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
sigTy HsSigType GhcPs -> R ()
p_hsSigType
isInfix :: LexicalFixity -> Bool
isInfix :: LexicalFixity -> Bool
isInfix = \case
LexicalFixity
Infix -> Bool
True
LexicalFixity
Prefix -> Bool
False
isSingleConstRec :: [LConDecl GhcPs] -> Bool
isSingleConstRec :: [LConDecl GhcPs] -> Bool
isSingleConstRec [(L SrcSpanAnnA
_ ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe LHsDocString
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_doc :: Maybe LHsDocString
con_args :: HsConDeclH98Details GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_forall :: Bool
con_name :: LIdP GhcPs
con_ext :: XConDeclH98 GhcPs
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..})] =
case HsConDeclH98Details GhcPs
con_args of
RecCon XRec GhcPs [LConDeclField GhcPs]
_ -> Bool
True
HsConDeclH98Details GhcPs
_ -> Bool
False
isSingleConstRec [LConDecl GhcPs]
_ = Bool
False
hasHaddocks :: [LConDecl GhcPs] -> Bool
hasHaddocks :: [LConDecl GhcPs] -> Bool
hasHaddocks = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall pass. ConDecl pass -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
where
f :: ConDecl pass -> Bool
f ConDeclH98 {Bool
[LHsTyVarBndr Specificity pass]
Maybe LHsDocString
Maybe (LHsContext pass)
XConDeclH98 pass
LIdP pass
HsConDeclH98Details pass
con_doc :: Maybe LHsDocString
con_args :: HsConDeclH98Details pass
con_mb_cxt :: Maybe (LHsContext pass)
con_ex_tvs :: [LHsTyVarBndr Specificity pass]
con_forall :: Bool
con_name :: LIdP pass
con_ext :: XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} = forall a. Maybe a -> Bool
isJust Maybe LHsDocString
con_doc
f ConDecl pass
_ = Bool
False