{-# 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.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (isJust, maybeToList)
import Data.Void
import GHC.Data.Strict qualified as Strict
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
import Ormolu.Utils

p_dataDecl ::
  -- | Whether to format as data family
  FamilyStyle ->
  -- | Type constructor
  LocatedN RdrName ->
  -- | Type variables
  [tyVar] ->
  -- | Get location information for type variables
  (tyVar -> SrcSpan) ->
  -- | How to print type variables
  (tyVar -> R ()) ->
  -- | Lexical fixity
  LexicalFixity ->
  -- | Data definition
  HsDataDefn GhcPs ->
  R ()
p_dataDecl :: forall tyVar.
FamilyStyle
-> LocatedN RdrName
-> [tyVar]
-> (tyVar -> SrcSpan)
-> (tyVar -> R ())
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl FamilyStyle
style LocatedN RdrName
name [tyVar]
tyVars tyVar -> SrcSpan
getTyVarLoc tyVar -> R ()
p_tyVar LexicalFixity
fixity HsDataDefn {HsDeriving GhcPs
Maybe (LHsContext GhcPs)
Maybe (XRec GhcPs (HsType GhcPs))
Maybe (XRec GhcPs CType)
DataDefnCons (LConDecl GhcPs)
XCHsDataDefn GhcPs
dd_ext :: XCHsDataDefn GhcPs
dd_ctxt :: Maybe (LHsContext GhcPs)
dd_cType :: Maybe (XRec GhcPs CType)
dd_kindSig :: Maybe (XRec GhcPs (HsType GhcPs))
dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_derivs :: HsDeriving GhcPs
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
..} = do
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case DataDefnCons (LConDecl GhcPs)
dd_cons of
    NewTypeCon LConDecl GhcPs
_ -> Text
"newtype"
    DataTypeCons Bool
False [LConDecl GhcPs]
_ -> Text
"data"
    DataTypeCons Bool
True [LConDecl GhcPs]
_ -> Text
"type 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 a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (CType SourceText
prag Maybe Header
header (SourceText
type_, FastString
_)) -> do
      R ()
space
      SourceText -> R ()
p_sourceText SourceText
prag
      case Maybe Header
header of
        Maybe Header
Nothing -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (Header SourceText
h FastString
_) -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceText -> R ()
p_sourceText SourceText
h
      R ()
space
      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]
: (tyVar -> SrcSpan) -> [tyVar] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap tyVar -> SrcSpan
getTyVarLoc [tyVar]
tyVars
      sigSpans :: [SrcSpan]
sigSpans = Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe SrcSpan -> [SrcSpan])
-> (Maybe (XRec GhcPs (HsType GhcPs)) -> Maybe SrcSpan)
-> Maybe (XRec GhcPs (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 a b. (a -> b) -> Maybe a -> Maybe b
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 (XRec GhcPs (HsType GhcPs)) -> [SrcSpan])
-> Maybe (XRec GhcPs (HsType GhcPs)) -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ Maybe (XRec GhcPs (HsType GhcPs))
dd_kindSig
      declHeaderSpans :: [SrcSpan]
declHeaderSpans =
        Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> SrcSpan)
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
dd_ctxt) [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [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
      case Maybe (LHsContext GhcPs)
dd_ctxt of
        Maybe (LHsContext GhcPs)
Nothing -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just LHsContext GhcPs
ctxt -> do
          GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctxt [GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()
HsContext GhcPs -> R ()
p_hsContext
          R ()
space
          Text -> R ()
txt Text
"=>"
          R ()
breakpoint
      [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)
          (tyVar -> R ()
p_tyVar (tyVar -> R ()) -> [tyVar] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [tyVar]
tyVars)
      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 (XRec GhcPs (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 dd_cons' :: [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons' = case DataDefnCons (LConDecl GhcPs)
dd_cons of
        NewTypeCon LConDecl GhcPs
a -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)
LConDecl GhcPs
a]
        DataTypeCons Bool
_ [LConDecl GhcPs]
as -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl GhcPs]
as
      gadt :: Bool
gadt = Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
Maybe (XRec GhcPs (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) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [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)) [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
<$> [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 [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl GhcPs]
dd_cons'
        if [LConDecl GhcPs] -> Bool
hasHaddocks [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[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 [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl GhcPs]
dd_cons'
                then R ()
newline R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
                else R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
            sitcc' :: R () -> R ()
sitcc' =
              if [LConDecl GhcPs] -> Bool
hasHaddocks [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[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)) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
HsDeriving GhcPs
dd_derivs) R ()
breakpoint
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs) -> R ())
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((HsDerivingClause GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
HsDeriving GhcPs
dd_derivs

p_conDecl ::
  Bool ->
  ConDecl GhcPs ->
  R ()
p_conDecl :: Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec = \case
  ConDeclGADT {Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
NonEmpty (LIdP GhcPs)
HsConDeclGADTDetails GhcPs
XConDeclGADT GhcPs
XRec GhcPs (HsType GhcPs)
LHsUniToken "::" "\8759" GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_g_ext :: XConDeclGADT GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_dcolon :: LHsUniToken "::" "\8759" GhcPs
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_res_ty :: XRec GhcPs (HsType GhcPs)
con_doc :: Maybe (LHsDoc GhcPs)
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_dcolon :: forall pass. ConDecl pass -> LHsUniToken "::" "\8759" pass
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
..} -> do
    (LHsDoc GhcPs -> R ()) -> Maybe (LHsDoc GhcPs) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe Bool
True) Maybe (LHsDoc GhcPs)
con_doc
    let conDeclSpn :: [SrcSpan]
conDeclSpn =
          (LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
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 (NonEmpty (LocatedN RdrName) -> [LocatedN RdrName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LocatedN RdrName)
NonEmpty (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 SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> SrcSpan)
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe SrcSpan
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe
  (GenLocated SrcSpanAnnC [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 (XRec GhcPs (HsType 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 (XRec GhcPs (HsType GhcPs))]
xs
              RecConGADT XRec GhcPs [LConDeclField GhcPs]
x LHsUniToken "->" "\8594" GhcPs
_ -> [GenLocated
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated
  (SrcAnn 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
      let LIdP GhcPs
c :| [LIdP GhcPs]
cs = NonEmpty (LIdP GhcPs)
con_names
      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 a. [a] -> 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
        let conTy :: GenLocated SrcSpanAnnA (HsType GhcPs)
conTy = case HsConDeclGADTDetails GhcPs
con_g_args of
              PrefixConGADT [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs ->
                let go :: HsScaled pass (GenLocated (SrcSpanAnn' a2) (HsType pass))
-> GenLocated (SrcSpanAnn' a2) (HsType pass)
-> GenLocated (SrcAnn ann) (HsType pass)
go (HsScaled HsArrow pass
a GenLocated (SrcSpanAnn' a2) (HsType pass)
b) GenLocated (SrcSpanAnn' a2) (HsType pass)
t = GenLocated (SrcSpanAnn' a2) (HsType pass)
-> GenLocated (SrcSpanAnn' a2) (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' a2) (HsType pass)
t GenLocated (SrcSpanAnn' a2) (HsType pass)
b (XFunTy pass
-> HsArrow pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy EpAnn ann
XFunTy pass
forall ann. EpAnn ann
EpAnnNotUsed HsArrow pass
a GenLocated (SrcSpanAnn' a2) (HsType pass)
XRec pass (HsType pass)
b GenLocated (SrcSpanAnn' a2) (HsType pass)
XRec pass (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 a b. (a -> b -> b) -> b -> [a] -> b
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} {a2} {ann}.
(XFunTy pass ~ EpAnn ann,
 XRec pass (HsType pass)
 ~ GenLocated (SrcSpanAnn' a2) (HsType pass)) =>
HsScaled pass (GenLocated (SrcSpanAnn' a2) (HsType pass))
-> GenLocated (SrcSpanAnn' a2) (HsType pass)
-> GenLocated (SrcAnn ann) (HsType pass)
go GenLocated SrcSpanAnnA (HsType GhcPs)
XRec GhcPs (HsType GhcPs)
con_res_ty [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs
              RecConGADT XRec GhcPs [LConDeclField GhcPs]
r LHsUniToken "->" "\8594" GhcPs
_ ->
                GenLocated
  (SrcAnn 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
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
r GenLocated SrcSpanAnnA (HsType GhcPs)
XRec GhcPs (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
-> XRec GhcPs (HsType GhcPs)
-> XRec GhcPs (HsType GhcPs)
-> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy
                    EpAnn NoEpAnns
XFunTy GhcPs
forall ann. EpAnn ann
EpAnnNotUsed
                    (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow GenLocated TokenLocation (HsUniToken "->" "\8594")
LHsUniToken "->" "\8594" GhcPs
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok)
                    (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 EpAnn AnnList
XRecTy GhcPs
forall ann. EpAnn ann
EpAnnNotUsed ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsType GhcPs)
-> GenLocated
     (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> LocatedAn AnnList (HsType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
r)
                    XRec GhcPs (HsType GhcPs)
con_res_ty
            qualTy :: GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy = case Maybe (LHsContext GhcPs)
con_mb_cxt of
              Maybe (LHsContext GhcPs)
Nothing -> GenLocated SrcSpanAnnA (HsType GhcPs)
conTy
              Just LHsContext GhcPs
qs ->
                GenLocated SrcSpanAnnC [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 SrcSpanAnnC [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
-> LHsContext GhcPs -> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
NoExtField LHsContext GhcPs
qs GenLocated SrcSpanAnnA (HsType GhcPs)
XRec GhcPs (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 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
-> XRec GhcPs (HsType 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)
XRec GhcPs (HsType GhcPs)
qualTy
        R ()
space
        Text -> R ()
txt Text
"::"
        if HsType GhcPs -> Bool
hasDocStrings (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
XRec GhcPs (HsType GhcPs)
con_res_ty)
          then R ()
newline
          else R ()
breakpoint
        GenLocated (SrcAnn Any) (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated (SrcAnn Any) (HsType GhcPs)
quantifiedTy HsType GhcPs -> R ()
p_hsType
  ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
..} -> do
    (LHsDoc GhcPs -> R ()) -> Maybe (LHsDoc GhcPs) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe Bool
True) Maybe (LHsDoc GhcPs)
con_doc
    let conDeclWithContextSpn :: [SrcSpan]
conDeclWithContextSpn =
          [ RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
real Maybe BufSpan
forall a. Maybe a
Strict.Nothing
            | Just (EpaSpan RealSrcSpan
real Maybe BufSpan
_) <- AnnKeywordId -> AddEpAnn -> Maybe EpaLocation
matchAddEpAnn AnnKeywordId
AnnForall (AddEpAnn -> Maybe EpaLocation)
-> [AddEpAnn] -> [Maybe EpaLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 a b. (a -> b) -> [a] -> [b]
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 SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> SrcSpan)
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe SrcSpan
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA Maybe
  (GenLocated SrcSpanAnnC [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 (XRec GhcPs (HsType 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 (XRec GhcPs (HsType GhcPs))]
xs
              PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
_ -> Void -> [SrcSpan]
forall a. Void -> a
absurd Void
v
              RecCon XRec GhcPs [LConDeclField GhcPs]
l -> [GenLocated
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
l]
              InfixCon HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
x HsScaled GhcPs (XRec GhcPs (HsType 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 (XRec GhcPs (HsType GhcPs))
x, HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
HsScaled GhcPs (XRec GhcPs (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 l a.
HasSrcSpan l =>
ForAllVisibility -> (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrs ForAllVisibility
ForAllInvis HsTyVarBndr Specificity GhcPs -> R ()
forall flag. IsTyVarBndrFlag flag => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity GhcPs]
con_ex_tvs
        R ()
breakpoint
      Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> R ())
-> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
con_mb_cxt GenLocated SrcSpanAnnC [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 (XRec GhcPs (HsType GhcPs))]
xs -> do
          LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
LIdP GhcPs
con_name
          let args :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
args = 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 (XRec GhcPs (HsType GhcPs))]
xs
              argsHaveDocs :: Bool
argsHaveDocs = HsContext GhcPs -> Bool
conArgsHaveHaddocks [GenLocated SrcSpanAnnA (HsType GhcPs)]
HsContext GhcPs
args
              delimiter :: R ()
delimiter = if Bool
argsHaveDocs then R ()
newline else R ()
breakpoint
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs) R ()
delimiter
          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 ()
delimiter (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_hsType) [GenLocated SrcSpanAnnA (HsType GhcPs)]
args
        PrefixCon (Void
v : [Void]
_) [HsScaled GhcPs (XRec GhcPs (HsType 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
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  (SrcAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
l [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()
[LConDeclField GhcPs] -> R ()
p_conDeclFields)
        InfixCon (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType GhcPs)
x) (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType 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)
XRec GhcPs (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 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)
XRec GhcPs (HsType GhcPs)
y HsType GhcPs -> R ()
p_hsType

p_lhsContext ::
  LHsContext GhcPs ->
  R ()
p_lhsContext :: LHsContext GhcPs -> R ()
p_lhsContext = \case
  L SrcSpanAnnC
_ [] -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LHsContext GhcPs
ctx -> do
    GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnC [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_ext :: XCHsDerivingClause GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_tys :: LDerivClauseTys 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
..} = do
  Text -> R ()
txt Text
"deriving"
  let derivingWhat :: R ()
derivingWhat = GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
LDerivClauseTys GhcPs
deriv_clause_tys ((DerivClauseTys GhcPs -> R ()) -> R ())
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \case
        DctSingle NoExtField
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 NoExtField
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 SrcAnn NoEpAnns
_ DerivStrategy GhcPs
a) -> case DerivStrategy GhcPs
a of
      StockStrategy XStockStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"stock"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      AnyclassStrategy XAnyClassStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"anyclass"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      NewtypeStrategy XNewtypeStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"newtype"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      ViaStrategy (XViaStrategyPs EpAnn [AddEpAnn]
_ LHsSigType GhcPs
sigTy) -> do
        R ()
breakpoint
        R () -> R ()
inci (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 SrcSpanAnnA
_ ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
..})] =
  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
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 GhcPs -> Bool
f ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
..} =
      Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsDoc GhcPs)
con_doc Bool -> Bool -> Bool
|| case HsConDeclH98Details GhcPs
con_args of
        PrefixCon [] [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs ->
          HsContext GhcPs -> Bool
conArgsHaveHaddocks (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 (XRec GhcPs (HsType GhcPs))]
xs)
        HsConDeclH98Details GhcPs
_ -> Bool
False
    f ConDecl GhcPs
_ = Bool
False

conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool
conArgsHaveHaddocks :: HsContext GhcPs -> Bool
conArgsHaveHaddocks HsContext GhcPs
xs =
  let hasDocs :: HsType pass -> Bool
hasDocs = \case
        HsDocTy {} -> Bool
True
        HsType pass
_ -> Bool
False
   in (GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsType GhcPs -> Bool
forall {pass}. HsType pass -> Bool
hasDocs (HsType GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (HsType GhcPs)]
HsContext GhcPs
xs