{-# 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 qualified Data.Text as Text
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.Config
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 Bool
singleConstRec
then R ()
space
else
if [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
then R ()
newline
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 Bool
singleConstRec
then R () -> R ()
forall a. a -> a
id
else R () -> R ()
sitcc
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
Int
indent <- (forall (f :: * -> *). PrinterOpts f -> f Int) -> R Int
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (() -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (R () -> R ()) -> (Text -> R ()) -> Text -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.replicate (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
" "
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