{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

-- | Renedring of data type declarations.
module Ormolu.Printer.Meat.Declaration.Data
  ( p_dataDecl,
  )
where

import Control.Monad
import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With)
import Data.Choice qualified as Choice
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (isJust, isNothing, maybeToList)
import Data.Text qualified 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
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
-> GenLocated SrcSpanAnnN RdrName
-> [tyVar]
-> (tyVar -> SrcSpan)
-> (tyVar -> R ())
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl FamilyStyle
style GenLocated SrcSpanAnnN RdrName
name [tyVar]
tyVars tyVar -> SrcSpan
getTyVarLoc tyVar -> R ()
p_tyVar LexicalFixity
fixity HsDataDefn {HsDeriving GhcPs
Maybe (LHsContext GhcPs)
Maybe (XRec GhcPs CType)
Maybe (XRec GhcPs (HsType GhcPs))
XCHsDataDefn GhcPs
DataDefnCons (LConDecl 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_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn 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"
  let constructorSpans :: [SrcSpan]
constructorSpans = GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnN 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. HasLoc a => GenLocated 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
      contextSpans :: [SrcSpan]
contextSpans = Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe SrcSpan -> [SrcSpan])
-> (Maybe (LHsContext GhcPs) -> Maybe SrcSpan)
-> Maybe (LHsContext GhcPs)
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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. HasLoc a => GenLocated a e -> SrcSpan
getLocA (Maybe (LHsContext GhcPs) -> [SrcSpan])
-> Maybe (LHsContext GhcPs) -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ Maybe (LHsContext GhcPs)
dd_ctxt
      ctypeSpans :: [SrcSpan]
ctypeSpans = Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe SrcSpan -> [SrcSpan])
-> (Maybe (XRec GhcPs CType) -> Maybe SrcSpan)
-> Maybe (XRec GhcPs CType)
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnP CType -> SrcSpan)
-> Maybe (GenLocated SrcSpanAnnP CType) -> 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 SrcSpanAnnP CType -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (Maybe (XRec GhcPs CType) -> [SrcSpan])
-> Maybe (XRec GhcPs CType) -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ Maybe (XRec GhcPs CType)
dd_cType
      declHeaderSpans :: [SrcSpan]
declHeaderSpans =
        [SrcSpan]
constructorSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
sigSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
contextSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
ctypeSpans
  [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
declHeaderSpans (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
    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 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 ()
breakpoint
        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
" #-}"
    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 (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
dd_ctxt LHsContext GhcPs -> R ()
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
p_lhsContext
    [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
        (GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName GenLocated SrcSpanAnnN 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 (XRec GhcPs (HsType 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
      R ()
token'dcolon
      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. HasLoc 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 -> [LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
a]
        DataTypeCons Bool
_ [LConDecl GhcPs]
as -> [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as
      gadt :: Bool
gadt = Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (XRec GhcPs (HsType 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) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
  case [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons' of
    [] -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    GenLocated SrcSpanAnnA (ConDecl GhcPs)
first_dd_cons : [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
_ ->
      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. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (Choice "singleRecCon" -> ConDecl GhcPs -> R ()
p_conDecl (Label "singleRecCon" -> Choice "singleRecCon"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "singleRecCon"
#singleRecCon))) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
        else [SrcSpan] -> R () -> R ()
switchLayout (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated 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 singleRecCon :: Choice "singleRecCon"
singleRecCon =
                case [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons' of
                  [L SrcSpanAnnA
_ ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = RecCon {}}] -> Label "singleRecCon" -> Choice "singleRecCon"
forall (a :: Symbol). Label a -> Choice a
Is Label "singleRecCon"
#singleRecCon
                  [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
_ -> Label "singleRecCon" -> Choice "singleRecCon"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "singleRecCon"
#singleRecCon
              compactLayoutAroundEquals :: Bool
compactLayoutAroundEquals =
                SrcSpan -> SrcSpan -> Bool
onTheSameLine
                  (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnN RdrName
name)
                  (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (ConDecl GhcPs -> NonEmpty SrcSpan
conDeclConsSpans (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ConDecl GhcPs)
first_dd_cons)))
              conDeclConsSpans :: ConDecl GhcPs -> NonEmpty SrcSpan
conDeclConsSpans = \case
                ConDeclGADT {Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
NonEmpty (LIdP GhcPs)
XConDeclGADT GhcPs
XRec GhcPs (HsType GhcPs)
XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
HsConDeclGADTDetails GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_bndrs :: XRec GhcPs (HsOuterTyVarBndrs Specificity 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_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
..} -> GenLocated SrcSpanAnnN (IdP GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated SrcSpanAnnN (IdP GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnN (IdP GhcPs))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LIdP GhcPs)
NonEmpty (GenLocated SrcSpanAnnN (IdP GhcPs))
con_names
                ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
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 :: HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_doc :: Maybe (LHsDoc GhcPs)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
..} -> GenLocated SrcSpanAnnN (IdP GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN (IdP GhcPs)
con_name SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| []
          if [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
            then R ()
newline
            else
              if Choice "singleRecCon" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "singleRecCon"
singleRecCon Bool -> Bool -> Bool
&& Bool
compactLayoutAroundEquals
                then R ()
space
                else R ()
breakpoint
          R ()
equals
          R ()
space
          Layout
layout <- R Layout
getLayout
          let s :: R ()
s =
                if Layout
layout Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
MultiLine Bool -> Bool -> Bool
|| [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl 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 [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons' Bool -> Bool -> Bool
|| Choice "singleRecCon" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isFalse Choice "singleRecCon"
singleRecCon
                  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. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (Choice "singleRecCon" -> ConDecl GhcPs -> R ()
p_conDecl Choice "singleRecCon"
singleRecCon)) [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons'
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated EpAnnCO (HsDerivingClause GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HsDeriving GhcPs
[GenLocated EpAnnCO (HsDerivingClause GhcPs)]
dd_derivs) R ()
breakpoint

  Bool
sortDerivingClauses <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poSortDerivingClauses
  let sortedDeriving :: [GenLocated EpAnnCO (HsDerivingClause GhcPs)]
sortedDeriving = if Bool
sortDerivingClauses then (GenLocated EpAnnCO (HsDerivingClause GhcPs)
 -> DerivingClauseSortKey)
-> [GenLocated EpAnnCO (HsDerivingClause GhcPs)]
-> [GenLocated EpAnnCO (HsDerivingClause GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe (DerivStrategy GhcPs) -> DerivingClauseSortKey
forall {pass}.
Outputable (XViaStrategy pass) =>
Maybe (DerivStrategy pass) -> DerivingClauseSortKey
derivingStrategyKey (Maybe (DerivStrategy GhcPs) -> DerivingClauseSortKey)
-> (GenLocated EpAnnCO (HsDerivingClause GhcPs)
    -> Maybe (DerivStrategy GhcPs))
-> GenLocated EpAnnCO (HsDerivingClause GhcPs)
-> DerivingClauseSortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated EpAnnCO (DerivStrategy GhcPs) -> DerivStrategy GhcPs)
-> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs))
-> Maybe (DerivStrategy GhcPs)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated EpAnnCO (DerivStrategy GhcPs) -> DerivStrategy GhcPs
forall l e. GenLocated l e -> e
unLoc (Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs))
 -> Maybe (DerivStrategy GhcPs))
-> (GenLocated EpAnnCO (HsDerivingClause GhcPs)
    -> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs)))
-> GenLocated EpAnnCO (HsDerivingClause GhcPs)
-> Maybe (DerivStrategy GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDerivingClause GhcPs -> Maybe (LDerivStrategy GhcPs)
HsDerivingClause GhcPs
-> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs))
forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy (HsDerivingClause GhcPs
 -> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs)))
-> (GenLocated EpAnnCO (HsDerivingClause GhcPs)
    -> HsDerivingClause GhcPs)
-> GenLocated EpAnnCO (HsDerivingClause GhcPs)
-> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpAnnCO (HsDerivingClause GhcPs)
-> HsDerivingClause GhcPs
forall l e. GenLocated l e -> e
unLoc) HsDeriving GhcPs
[GenLocated EpAnnCO (HsDerivingClause GhcPs)]
dd_derivs else HsDeriving GhcPs
[GenLocated EpAnnCO (HsDerivingClause GhcPs)]
dd_derivs
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated EpAnnCO (HsDerivingClause GhcPs) -> R ())
-> [GenLocated EpAnnCO (HsDerivingClause GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((HsDerivingClause GhcPs -> R ())
-> GenLocated EpAnnCO (HsDerivingClause GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) [GenLocated EpAnnCO (HsDerivingClause GhcPs)]
sortedDeriving
  where
    derivingStrategyKey :: Maybe (DerivStrategy pass) -> DerivingClauseSortKey
derivingStrategyKey Maybe (DerivStrategy pass)
Nothing = DerivingClauseSortKey
ClauseNoStrategy
    derivingStrategyKey (Just DerivStrategy pass
strategy) = case DerivStrategy pass
strategy of
      StockStrategy XStockStrategy pass
_ -> DerivingClauseSortKey
ClauseStockStrategy
      NewtypeStrategy XNewtypeStrategy pass
_ -> DerivingClauseSortKey
ClauseNewtypeStrategy
      AnyclassStrategy XAnyClassStrategy pass
_ -> DerivingClauseSortKey
ClauseAnyclassStrategy
      ViaStrategy XViaStrategy pass
ty -> String -> DerivingClauseSortKey
ClauseViaStrategy (XViaStrategy pass -> String
forall o. Outputable o => o -> String
showOutputable XViaStrategy pass
ty)

data DerivingClauseSortKey
  = ClauseNoStrategy
  | ClauseStockStrategy
  | ClauseNewtypeStrategy
  | ClauseAnyclassStrategy
  | ClauseViaStrategy String
  deriving (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
(DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> Eq DerivingClauseSortKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
== :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
$c/= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
/= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
Eq, Eq DerivingClauseSortKey
Eq DerivingClauseSortKey =>
(DerivingClauseSortKey -> DerivingClauseSortKey -> Ordering)
-> (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> (DerivingClauseSortKey -> DerivingClauseSortKey -> Bool)
-> (DerivingClauseSortKey
    -> DerivingClauseSortKey -> DerivingClauseSortKey)
-> (DerivingClauseSortKey
    -> DerivingClauseSortKey -> DerivingClauseSortKey)
-> Ord DerivingClauseSortKey
DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
DerivingClauseSortKey -> DerivingClauseSortKey -> Ordering
DerivingClauseSortKey
-> DerivingClauseSortKey -> DerivingClauseSortKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DerivingClauseSortKey -> DerivingClauseSortKey -> Ordering
compare :: DerivingClauseSortKey -> DerivingClauseSortKey -> Ordering
$c< :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
< :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
$c<= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
<= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
$c> :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
> :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
$c>= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
>= :: DerivingClauseSortKey -> DerivingClauseSortKey -> Bool
$cmax :: DerivingClauseSortKey
-> DerivingClauseSortKey -> DerivingClauseSortKey
max :: DerivingClauseSortKey
-> DerivingClauseSortKey -> DerivingClauseSortKey
$cmin :: DerivingClauseSortKey
-> DerivingClauseSortKey -> DerivingClauseSortKey
min :: DerivingClauseSortKey
-> DerivingClauseSortKey -> DerivingClauseSortKey
Ord)

p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
p_conDecl Choice "singleRecCon"
_ ConDeclGADT {Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
NonEmpty (LIdP GhcPs)
XConDeclGADT GhcPs
XRec GhcPs (HsType GhcPs)
XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
HsConDeclGADTDetails GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext :: XConDeclGADT GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_bndrs :: XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_res_ty :: XRec GhcPs (HsType GhcPs)
con_doc :: Maybe (LHsDoc GhcPs)
..} = 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 -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
con_doc
  [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
    GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
c
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnN RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
[GenLocated SrcSpanAnnN 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 ()
-> (GenLocated SrcSpanAnnN RdrName -> R ())
-> [GenLocated SrcSpanAnnN RdrName]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
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 NoExtField
XPrefixConGADT GhcPs
NoExtField [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs ->
              let go :: HsScaled pass (XRec pass (HsType pass))
-> XRec pass (HsType pass) -> GenLocated l (HsType pass)
go (HsScaled HsArrow pass
a XRec pass (HsType pass)
b) XRec pass (HsType pass)
t = XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
-> GenLocated l (HsType pass)
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA XRec pass (HsType pass)
t XRec pass (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 XFunTy pass
NoExtField
NoExtField HsArrow pass
a XRec pass (HsType pass)
b XRec pass (HsType pass)
t)
               in (HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
 -> GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [HsScaled GhcPs (XRec GhcPs (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 (XRec GhcPs (HsType GhcPs))
-> XRec GhcPs (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall {pass} {l}.
(XFunTy pass ~ NoExtField, HasLoc (XRec pass (HsType pass)),
 HasAnnotation l) =>
HsScaled pass (XRec pass (HsType pass))
-> XRec pass (HsType pass) -> GenLocated l (HsType pass)
go XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
con_res_ty [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs
            RecConGADT XRecConGADT GhcPs
_ XRec GhcPs [LConDeclField GhcPs]
r ->
              GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsType GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
r XRec GhcPs (HsType 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
-> XRec GhcPs (HsType GhcPs)
-> XRec GhcPs (HsType GhcPs)
-> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy
                  XFunTy GhcPs
NoExtField
NoExtField
                  (XUnrestrictedArrow (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
-> HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
forall mult pass.
XUnrestrictedArrow mult pass -> HsArrowOf mult pass
HsUnrestrictedArrow TokRarrow
XUnrestrictedArrow (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
forall a. NoAnn a => a
noAnn)
                  (GenLocated SrcSpanAnnL (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la (GenLocated SrcSpanAnnL (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnL (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
AnnList ()
forall a. NoAnn a => a
noAnn ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsType GhcPs)
-> GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated SrcSpanAnnL (HsType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField 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 a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA LHsContext GhcPs
GenLocated SrcSpanAnnC [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
-> LHsContext GhcPs -> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy GhcPs
NoExtField
NoExtField LHsContext GhcPs
qs XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
conTy
          quantifiedTy :: LHsType GhcPs
          quantifiedTy :: XRec GhcPs (HsType GhcPs)
quantifiedTy =
            GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsType GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity GhcPs)
con_bndrs GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$
              HsOuterTyVarBndrs Specificity GhcPs
-> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
hsOuterTyVarBndrsToHsType (GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity GhcPs)
-> HsOuterTyVarBndrs Specificity GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity GhcPs)
con_bndrs) XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
qualTy
      XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation XRec GhcPs (HsType GhcPs)
quantifiedTy
  where
    conDeclSpn :: [SrcSpan]
conDeclSpn =
      (GenLocated SrcSpanAnnN RdrName -> SrcSpan)
-> [GenLocated SrcSpanAnnN RdrName] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LIdP GhcPs)
NonEmpty (GenLocated SrcSpanAnnN RdrName)
con_names)
        [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity GhcPs)
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs (HsOuterTyVarBndrs Specificity GhcPs)
GenLocated SrcSpanAnnA (HsOuterTyVarBndrs Specificity 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. HasLoc a => GenLocated a e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt)
        [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conArgsSpans
    conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDeclGADTDetails GhcPs
con_g_args of
      PrefixConGADT NoExtField
XPrefixConGADT GhcPs
NoExtField [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated 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 (XRec GhcPs (HsType GhcPs))]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
      RecConGADT XRecConGADT GhcPs
_ XRec GhcPs [LConDeclField GhcPs]
x -> [GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
x]
p_conDecl Choice "singleRecCon"
singleRecCon ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 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 :: HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_doc :: Maybe (LHsDoc GhcPs)
..} =
  case HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args of
    PrefixCon ([Void]
_ :: [Void]) [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> do
      R ()
renderConDoc
      R ()
renderContext
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
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 (XRec GhcPs (HsType GhcPs))]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
            argsHaveDocs :: Bool
argsHaveDocs = [XRec GhcPs (HsType GhcPs)] -> Bool
conArgsHaveHaddocks [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType 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 (XRec GhcPs (HsType GhcPs))]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (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. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [GenLocated SrcSpanAnnA (HsType GhcPs)]
args
    RecCon XRec GhcPs [LConDeclField GhcPs]
l -> do
      R ()
renderConDoc
      R ()
renderContext
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
        R ()
breakpoint
        Bool -> R () -> R ()
inciIf (Choice "singleRecCon" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isFalse Choice "singleRecCon"
singleRecCon) (GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
l [LConDeclField GhcPs] -> R ()
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> R ()
p_conDeclFields)
    InfixCon (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType GhcPs)
l) (HsScaled HsArrow GhcPs
_ XRec GhcPs (HsType GhcPs)
r) -> do
      -- manually render these
      let (GenLocated SrcSpanAnnA (HsType GhcPs)
lType, Maybe (LHsDoc GhcPs)
larg_doc) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs))
splitDocTy XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
l
      let (GenLocated SrcSpanAnnA (HsType GhcPs)
rType, Maybe (LHsDoc GhcPs)
rarg_doc) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs))
splitDocTy XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
r

      -- the constructor haddock can go on top of the entire constructor
      -- only if neither argument has haddocks
      let putConDocOnTop :: Bool
putConDocOnTop = Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsDoc GhcPs)
larg_doc Bool -> Bool -> Bool
&& Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsDoc GhcPs)
rarg_doc

      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
putConDocOnTop R ()
renderConDoc
      R ()
renderContext
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        -- the left arg haddock can use pipe only if the infix constructor has docs
        if Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsDoc GhcPs)
con_doc
          then 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 -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
larg_doc
            GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
lType HsType GhcPs -> R ()
p_hsType
            R ()
breakpoint
          else do
            GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
lType HsType GhcPs -> R ()
p_hsType
            case Maybe (LHsDoc GhcPs)
larg_doc of
              Just LHsDoc GhcPs
doc -> 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
>> HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Caret (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline) LHsDoc GhcPs
doc
              Maybe (LHsDoc GhcPs)
Nothing -> R ()
breakpoint
        R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
putConDocOnTop R ()
renderConDoc
          GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
          case Maybe (LHsDoc GhcPs)
rarg_doc of
            Just LHsDoc GhcPs
doc -> 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
>> HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline) LHsDoc GhcPs
doc
            Maybe (LHsDoc GhcPs)
Nothing -> R ()
breakpoint
          GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
rType HsType GhcPs -> R ()
p_hsType
  where
    renderConDoc :: R ()
renderConDoc = (LHsDoc GhcPs -> R ()) -> Maybe (LHsDoc GhcPs) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
con_doc
    renderContext :: R ()
renderContext =
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conNameWithContextSpn (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.
HasLoc 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 [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 PrinterOpts f -> f Int
forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation
          R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (() -> R ()
forall a. a -> R a
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 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 (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt LHsContext GhcPs -> R ()
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
p_lhsContext

    conNameWithContextSpn :: [SrcSpan]
conNameWithContextSpn =
      [TokForall -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc (TokForall -> SrcSpan) -> TokForall -> SrcSpan
forall a b. (a -> b) -> a -> b
$ AnnConDeclH98 -> TokForall
acdh_forall XConDeclH98 GhcPs
AnnConDeclH98
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. HasLoc a => GenLocated 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 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. HasLoc a => GenLocated a e -> SrcSpan
getLocA Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt)
        [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan
conNameSpn]
    conDeclSpn :: [SrcSpan]
conDeclSpn = SrcSpan
conNameSpn SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
conArgsSpans
    conNameSpn :: SrcSpan
conNameSpn = GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
    conArgsSpans :: [SrcSpan]
conArgsSpans = case HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args of
      PrefixCon ([Void]
_ :: [Void]) [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated 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 (XRec GhcPs (HsType GhcPs))]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
      RecCon XRec GhcPs [LConDeclField GhcPs]
l -> [GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField 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. HasLoc a => GenLocated 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 (XRec GhcPs (HsType GhcPs))
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
x, HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
y]

    splitDocTy :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs))
splitDocTy = \case
      L SrcSpanAnnA
_ (HsDocTy XDocTy GhcPs
_ XRec GhcPs (HsType GhcPs)
ty LHsDoc GhcPs
doc) -> (XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty, LHsDoc GhcPs -> Maybe (LHsDoc GhcPs)
forall a. a -> Maybe a
Just LHsDoc GhcPs
doc)
      GenLocated SrcSpanAnnA (HsType GhcPs)
ty -> (GenLocated SrcSpanAnnA (HsType GhcPs)
ty, Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing)

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. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx [XRec GhcPs (HsType GhcPs)] -> R ()
[GenLocated SrcSpanAnnA (HsType GhcPs)] -> R ()
p_hsContext
    R ()
space
    R ()
token'darrow
    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_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
..} = do
  SingleDerivingParens
singleDerivingParens <- (forall (f :: * -> *). PrinterOpts f -> f SingleDerivingParens)
-> R SingleDerivingParens
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f SingleDerivingParens
forall (f :: * -> *). PrinterOpts f -> f SingleDerivingParens
poSingleDerivingParens

  Text -> R ()
txt Text
"deriving"
  let derivingWhat :: R ()
derivingWhat = GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> (DerivClauseTys GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LDerivClauseTys GhcPs
GenLocated SrcSpanAnnC (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
NoExtField LHsSigType GhcPs
sigTy
          | SingleDerivingParens
DerivingAlways <- SingleDerivingParens
singleDerivingParens -> 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. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sigTy HsSigType GhcPs -> R ()
p_hsSigType
          | Bool
otherwise -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sigTy HsSigType GhcPs -> R ()
p_hsSigType
        DctMulti XDctMulti GhcPs
NoExtField
NoExtField [LHsSigType GhcPs]
sigTys
          | [LHsSigType GhcPs
sigTy] <- [LHsSigType GhcPs]
sigTys,
            SingleDerivingParens
DerivingNever <- SingleDerivingParens
singleDerivingParens ->
              GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sigTy HsSigType GhcPs -> R ()
p_hsSigType
          | Bool
otherwise -> do
              Bool
sortDerivedClasses <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poSortDerivedClasses
              let sort :: [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
sort = if Bool
sortDerivedClasses then (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> String)
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn GenLocated SrcSpanAnnA (HsSigType GhcPs) -> String
forall o. Outputable o => o -> String
showOutputable else [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
forall a. a -> a
id
              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. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsSigType GhcPs -> R ()
p_hsSigType)
                  ([GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
sort [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 EpAnnCO
_ 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 EpToken "via"
_ 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. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sigTy HsSigType GhcPs -> R ()
p_hsSigType

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

isInfix :: LexicalFixity -> Bool
isInfix :: LexicalFixity -> Bool
isInfix = \case
  LexicalFixity
Infix -> Bool
True
  LexicalFixity
Prefix -> 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 (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 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 :: HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField 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 HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
con_args of
        PrefixCon [] [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
xs ->
          [XRec GhcPs (HsType 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 (XRec GhcPs (HsType GhcPs))]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs)
        HsConDetails
  Void
  (HsScaled GhcPs (XRec GhcPs (HsType GhcPs)))
  (XRec GhcPs [LConDeclField GhcPs])
_ -> Bool
False
    f ConDecl GhcPs
_ = Bool
False

conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool
conArgsHaveHaddocks :: [XRec GhcPs (HsType GhcPs)] -> Bool
conArgsHaveHaddocks [XRec GhcPs (HsType 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) [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs