{-# 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 {HsDeriving GhcPs
[LConDecl GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsKind GhcPs)
Maybe (XRec GhcPs CType)
NewOrData
XCHsDataDefn GhcPs
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs :: HsDeriving GhcPs
dd_cons :: [LConDecl GhcPs]
dd_kindSig :: Maybe (LHsKind GhcPs)
dd_cType :: Maybe (XRec GhcPs CType)
dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ND :: NewOrData
dd_ext :: XCHsDataDefn GhcPs
..} = do
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case NewOrData
dd_ND of
NewOrData
NewType -> Text
"newtype"
NewOrData
DataType -> Text
"data"
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case FamilyStyle
style of
FamilyStyle
Associated -> Text
forall a. Monoid a => a
mempty
FamilyStyle
Free -> Text
" instance"
case GenLocated SrcSpanAnnP CType -> CType
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnP CType -> CType)
-> Maybe (GenLocated SrcSpanAnnP CType) -> Maybe CType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
dd_cType of
Maybe CType
Nothing -> () -> R ()
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 -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Header SourceText
h FastString
_) -> R ()
space R () -> R () -> R ()
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 = LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> SrcSpan)
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> SrcSpan
forall (pass :: Pass). LHsTypeArg (GhcPass pass) -> SrcSpan
lhsTypeArgSrcSpan HsTyPats GhcPs
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tpats
sigSpans :: [SrcSpan]
sigSpans = Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe SrcSpan -> [SrcSpan])
-> (Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Maybe SrcSpan)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> [SrcSpan])
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ Maybe (LHsKind GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
dd_kindSig
declHeaderSpans :: [SrcSpan]
declHeaderSpans = [SrcSpan]
constructorSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
sigSpans
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
declHeaderSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
constructorSpans (R () -> R ()) -> R () -> R ()
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 ()
HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> R ()
p_lhsTypeArg (HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> R ())
-> [HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsTyPats GhcPs
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tpats)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsKind GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
dd_kindSig ((GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()) -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsType GhcPs)
k -> do
R ()
space
Text -> R ()
txt Text
"::"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
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 = Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsKind GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
dd_kindSig Bool -> Bool -> Bool
|| (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConDecl GhcPs -> Bool
isGadt (ConDecl GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
unLoc) [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
if Bool
gadt
then R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
declHeaderSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
(GenLocated SrcSpanAnnA (ConDecl GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((ConDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (ConDecl GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
False)) [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons
else [SrcSpan] -> R () -> R ()
switchLayout (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons)) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
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 Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
MultiLine Bool -> Bool -> Bool
|| [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
then R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
else R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
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 R () -> R ()
forall a. a -> a
id
R ()
-> (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
s (R () -> R ()
sitcc' (R () -> R ())
-> (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (ConDecl GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec)) [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpan (HsDerivingClause GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HsDeriving GhcPs
[GenLocated SrcSpan (HsDerivingClause GhcPs)]
dd_derivs) R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpan (HsDerivingClause GhcPs) -> R ())
-> [GenLocated SrcSpan (HsDerivingClause GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((HsDerivingClause GhcPs -> R ())
-> GenLocated SrcSpan (HsDerivingClause GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) HsDeriving GhcPs
[GenLocated SrcSpan (HsDerivingClause GhcPs)]
dd_derivs
p_conDecl ::
Bool ->
ConDecl GhcPs ->
R ()
p_conDecl :: Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec = \case
ConDeclGADT {[LIdP GhcPs]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclGADTDetails GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
LHsKind GhcPs
XConDeclGADT GhcPs
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_doc :: Maybe LHsDocString
con_res_ty :: LHsKind 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
(LHsDocString -> R ()) -> Maybe LHsDocString -> R ()
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 =
(LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LIdP GhcPs]
[LocatedN RdrName]
con_names
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
con_bndrs]
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList ((GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan)
-> Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt)
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conArgsSpans
where
conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDeclGADTDetails GhcPs
con_g_args of
PrefixConGADT [HsScaled GhcPs (LHsKind GhcPs)]
xs -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan)
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
hsScaledThing (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> SrcSpan)
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
RecConGADT XRec GhcPs [LConDeclField GhcPs]
x -> [GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
x]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
case [LIdP GhcPs]
con_names of
[] -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(LIdP GhcPs
c : [LIdP GhcPs]
cs) -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
c
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedN RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
[LocatedN RdrName]
cs) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
commaDel
R () -> (LocatedN RdrName -> R ()) -> [LocatedN RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[LocatedN RdrName]
cs
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Text -> R ()
txt Text
"::"
let interArgBreak :: R ()
interArgBreak =
if HsType GhcPs -> Bool
hasDocStrings (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsKind GhcPs
GenLocated SrcSpanAnnA (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 (LHsKind 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 = GenLocated (SrcSpanAnn' a1) (HsType pass)
-> GenLocated (SrcSpanAnn' a1) (HsType pass)
-> HsType pass
-> GenLocated (SrcAnn ann) (HsType pass)
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 (XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy pass
forall ann. EpAnn ann
EpAnnNotUsed HsArrow pass
a LHsType pass
GenLocated (SrcSpanAnn' a1) (HsType pass)
b LHsType pass
GenLocated (SrcSpanAnn' a1) (HsType pass)
t)
in (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass ann a1 ann.
(XFunTy pass ~ EpAnn ann,
LHsType pass ~ GenLocated (SrcSpanAnn' a1) (HsType pass)) =>
HsScaled pass (GenLocated (SrcSpanAnn' a1) (HsType pass))
-> GenLocated (SrcSpanAnn' a1) (HsType pass)
-> GenLocated (SrcAnn ann) (HsType pass)
go LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
con_res_ty [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
RecConGADT XRec GhcPs [LConDeclField GhcPs]
r ->
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsType GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
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]
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
r LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
con_res_ty (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$
XFunTy GhcPs
-> HsArrow GhcPs -> LHsKind GhcPs -> LHsKind GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy
XFunTy GhcPs
forall ann. EpAnn ann
EpAnnNotUsed
(IsUnicodeSyntax -> HsArrow GhcPs
forall pass. IsUnicodeSyntax -> HsArrow pass
HsUnrestrictedArrow IsUnicodeSyntax
NormalSyntax)
(LocatedAn AnnList (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall ann1 a2 ann2. LocatedAn ann1 a2 -> LocatedAn ann2 a2
la2la (LocatedAn AnnList (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> LocatedAn AnnList (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XRecTy GhcPs -> [LConDeclField GhcPs] -> HsType GhcPs
forall pass. XRecTy pass -> [LConDeclField pass] -> HsType pass
HsRecTy XRecTy GhcPs
forall ann. EpAnn ann
EpAnnNotUsed ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsType GhcPs)
-> GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> LocatedAn AnnList (HsType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XRec GhcPs [LConDeclField GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
r)
LHsKind 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 ->
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsType GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsContext GhcPs
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
qs GenLocated SrcSpanAnnA (HsType GhcPs)
conTy (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$
XQualTy GhcPs
-> Maybe (LHsContext GhcPs) -> LHsKind GhcPs -> HsType GhcPs
forall pass.
XQualTy pass
-> Maybe (LHsContext pass) -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
NoExtField (GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> Maybe a
Just LHsContext GhcPs
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
qs) LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
conTy
quantifiedTy :: GenLocated (SrcAnn Any) (HsType GhcPs)
quantifiedTy =
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsType GhcPs
-> GenLocated (SrcAnn Any) (HsType GhcPs)
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)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
con_bndrs GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy (HsType GhcPs -> GenLocated (SrcAnn Any) (HsType GhcPs))
-> HsType GhcPs -> GenLocated (SrcAnn Any) (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$
HsOuterSigTyVarBndrs GhcPs -> LHsKind GhcPs -> HsType GhcPs
hsOuterTyVarBndrsToHsType (GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> HsOuterSigTyVarBndrs GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
con_bndrs) LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy
HsType GhcPs -> R ()
p_hsType (GenLocated (SrcAnn Any) (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn Any) (HsType GhcPs)
quantifiedTy)
ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclH98Details GhcPs
LIdP GhcPs
XConDeclH98 GhcPs
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
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
(LHsDocString -> R ()) -> Maybe LHsDocString -> R ()
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 Maybe BufSpan
forall a. Maybe a
Nothing | AddEpAnn AnnKeywordId
AnnForall (EpaSpan RealSrcSpan
real) <- EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns XConDeclH98 GhcPs
EpAnn [AddEpAnn]
con_ext]
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
con_ex_tvs
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList ((GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan)
-> Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt)
[SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conDeclSpn
conDeclSpn :: [SrcSpan]
conDeclSpn = LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
con_name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
conArgsSpans
where
conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDeclH98Details GhcPs
con_args of
PrefixCon [] [HsScaled GhcPs (LHsKind GhcPs)]
xs -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan)
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
hsScaledThing (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> SrcSpan)
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (LHsKind GhcPs)]
_ -> Void -> [SrcSpan]
forall a. Void -> a
absurd Void
v
RecCon XRec GhcPs [LConDeclField GhcPs]
l -> [GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
l]
InfixCon HsScaled GhcPs (LHsKind GhcPs)
x HsScaled GhcPs (LHsKind GhcPs)
y -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan)
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
hsScaledThing (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> SrcSpan)
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (LHsKind GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
x, HsScaled GhcPs (LHsKind GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
y]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclWithContextSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
con_forall (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
ForAllVisibility
-> (HsTyVarBndr Specificity GhcPs -> R ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> R ()
forall a. ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R ()
p_forallBndrs ForAllVisibility
ForAllInvis HsTyVarBndr Specificity GhcPs -> R ()
forall flag.
IsInferredTyVarBndr flag =>
HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
con_ex_tvs
R ()
breakpoint
Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ())
-> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt LHsContext GhcPs -> R ()
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
p_lhsContext
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case HsConDeclH98Details GhcPs
con_args of
PrefixCon [] [HsScaled GhcPs (LHsKind GhcPs)]
xs -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
con_name
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs) R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsTypePostDoc) (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
hsScaledThing (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs)
PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (LHsKind GhcPs)]
_ -> Void -> R ()
forall a. Void -> a
absurd Void
v
RecCon XRec GhcPs [LConDeclField GhcPs]
l -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
con_name
R ()
breakpoint
Bool -> R () -> R ()
inciIf (Bool -> Bool
not Bool
singleConstRec) (GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LConDeclField GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList))
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
l [LConDeclField GhcPs] -> R ()
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()
p_conDeclFields)
InfixCon (HsScaled HsArrow GhcPs
_ LHsKind GhcPs
x) (HsScaled HsArrow GhcPs
_ LHsKind GhcPs
y) -> do
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x HsType GhcPs -> R ()
p_hsType
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
con_name
R ()
space
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y HsType GhcPs -> R ()
p_hsType
p_lhsContext ::
LHsContext GhcPs ->
R ()
p_lhsContext :: LHsContext GhcPs -> R ()
p_lhsContext = \case
L _ [] -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
LHsContext GhcPs
ctx -> do
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsContext GhcPs
GenLocated
(SrcSpanAnn' (EpAnn AnnContext))
[GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx HsContext GhcPs -> R ()
[GenLocated SrcSpanAnnA (HsType 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)
LDerivClauseTys GhcPs
XCHsDerivingClause GhcPs
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys 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 = GenLocated (SrcSpanAnn' (EpAnn AnnContext)) (DerivClauseTys GhcPs)
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LDerivClauseTys GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnContext)) (DerivClauseTys GhcPs)
deriv_clause_tys ((DerivClauseTys GhcPs -> R ()) -> R ())
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \case
DctSingle XDctSingle GhcPs
NoExtField LHsSigType GhcPs
sigTy -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sigTy HsSigType GhcPs -> R ()
p_hsSigType
DctMulti XDctMulti GhcPs
NoExtField [LHsSigType GhcPs]
sigTys ->
BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
(R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsSigType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsSigType GhcPs -> R ()
p_hsSigType)
[LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType 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 _ 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 _ sigTy) -> do
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
derivingWhat
R ()
breakpoint
Text -> R ()
txt Text
"via"
R ()
space
GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType 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 _ ConDeclH98 {..})] =
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 = (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConDecl GhcPs -> Bool
forall pass. ConDecl pass -> Bool
f (ConDecl GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
unLoc)
where
f :: ConDecl pass -> Bool
f ConDeclH98 {Bool
[LHsTyVarBndr Specificity pass]
Maybe (LHsContext pass)
Maybe LHsDocString
HsConDeclH98Details pass
LIdP pass
XConDeclH98 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_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
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
..} = Maybe LHsDocString -> Bool
forall a. Maybe a -> Bool
isJust Maybe LHsDocString
con_doc
f ConDecl pass
_ = Bool
False