{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Renedring of data type declarations.
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 ::
  -- | Whether to format as data family
  FamilyStyle ->
  -- | Type constructor
  LocatedN RdrName ->
  -- | Type patterns
  HsTyPats GhcPs ->
  -- | Lexical fixity
  LexicalFixity ->
  -- | Data definition
  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 CType)
Maybe (LHsKind GhcPs)
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 (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 (GenLocated SrcSpanAnnP CType)
Maybe (XRec GhcPs 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 [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
HsTyPats 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 (GenLocated SrcSpanAnnA (HsType GhcPs))
Maybe (LHsKind 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)
          (HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> R ()
LHsTypeArg 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
<$> [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
HsTyPats 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 (GenLocated SrcSpanAnnA (HsType GhcPs))
Maybe (LHsKind 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 (GenLocated SrcSpanAnnA (HsType GhcPs))
Maybe (LHsKind 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) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl 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 [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl 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)) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl 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
<$> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl 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)) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl 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 [GenLocated SrcSpan (HsDerivingClause GhcPs)]
HsDeriving 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) [GenLocated SrcSpan (HsDerivingClause GhcPs)]
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
LHsKind 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 :: 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 [LocatedN RdrName]
[LIdP GhcPs]
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 GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (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
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnContext))
     [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext 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 (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsKind 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField 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 LocatedN RdrName
LIdP GhcPs
c
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedN RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LocatedN RdrName]
[LIdP GhcPs]
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 [LocatedN RdrName]
[LIdP GhcPs]
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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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 GenLocated (SrcSpanAnn' a1) (HsType pass)
LHsType pass
b GenLocated (SrcSpanAnn' a1) (HsType pass)
LHsType 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind GhcPs
con_res_ty [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsKind 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
r GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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
<$> GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
qs) GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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 GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (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 GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs) GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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 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
    (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 EpAnn [AddEpAnn]
XConDeclH98 GhcPs
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 [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr 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
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnContext))
     [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext 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 LocatedN RdrName
LIdP GhcPs
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 (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsKind 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField 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 (GenLocated SrcSpanAnnA (HsType GhcPs))
HsScaled GhcPs (LHsKind GhcPs)
x, HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
HsScaled GhcPs (LHsKind 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 [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr 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
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnContext))
     [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
con_mb_cxt GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
LHsContext 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 LocatedN RdrName
LIdP GhcPs
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 (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsKind 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 (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsKind 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 LocatedN RdrName
LIdP GhcPs
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 GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
l [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()
[LConDeclField 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 GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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 LocatedN RdrName
LIdP GhcPs
con_name
            R ()
space
            GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
LHsKind 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 GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctx [GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()
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 = GenLocated (SrcSpanAnn' (EpAnn AnnContext)) (DerivClauseTys GhcPs)
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated (SrcSpanAnn' (EpAnn AnnContext)) (DerivClauseTys GhcPs)
LDerivClauseTys 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 GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType 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)
              [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
[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 _ 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 GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
sigTy HsSigType GhcPs -> R ()
p_hsSigType

----------------------------------------------------------------------------
-- Helpers

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 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
..} = Maybe LHsDocString -> Bool
forall a. Maybe a -> Bool
isJust Maybe LHsDocString
con_doc
    f ConDecl pass
_ = Bool
False