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

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

import Control.Monad
import Data.Maybe (isJust, maybeToList)
import GHC
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
  Located RdrName ->
  -- | Type patterns
  [LHsType GhcPs] ->
  -- | Lexical fixity
  LexicalFixity ->
  -- | Data definition
  HsDataDefn GhcPs ->
  R ()
p_dataDecl :: FamilyStyle
-> Located RdrName
-> [LHsType GhcPs]
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl FamilyStyle
style Located RdrName
name [LHsType GhcPs]
tpats LexicalFixity
fixity HsDataDefn {[LConDecl GhcPs]
Maybe (LHsType GhcPs)
Maybe (Located CType)
NewOrData
XCHsDataDefn GhcPs
HsDeriving GhcPs
LHsContext GhcPs
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
dd_cType :: forall pass. HsDataDefn pass -> Maybe (Located CType)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs :: HsDeriving GhcPs
dd_cons :: [LConDecl GhcPs]
dd_kindSig :: Maybe (LHsType GhcPs)
dd_cType :: Maybe (Located CType)
dd_ctxt :: LHsContext GhcPs
dd_ND :: NewOrData
dd_ext :: XCHsDataDefn GhcPs
..} = do
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case NewOrData
dd_ND of
    NewOrData
NewType -> Text
"newtype"
    NewOrData
DataType -> Text
"data"
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case FamilyStyle
style of
    FamilyStyle
Associated -> Text
forall a. Monoid a => a
mempty
    FamilyStyle
Free -> Text
" instance"
  let constructorSpans :: [SrcSpan]
constructorSpans = Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (LHsType GhcPs -> SrcSpan) -> [LHsType GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [LHsType GhcPs]
tpats
  [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
constructorSpans (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
$
      Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
        (LexicalFixity -> Bool
isInfix LexicalFixity
fixity)
        Bool
True
        (Located RdrName -> R ()
p_rdrName Located RdrName
name)
        ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsType (LHsType GhcPs -> R ()) -> [LHsType GhcPs] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsType GhcPs]
tpats)
  case Maybe (LHsType GhcPs)
dd_kindSig of
    Maybe (LHsType GhcPs)
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just LHsType GhcPs
k -> do
      R ()
space
      Text -> R ()
txt Text
"::"
      R ()
space
      LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
k HsType GhcPs -> R ()
p_hsType
  let gadt :: Bool
gadt = Maybe (LHsType GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsType GhcPs)
dd_kindSig Bool -> Bool -> Bool
|| (LConDecl GhcPs -> Bool) -> [LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConDecl GhcPs -> Bool
isGadt (ConDecl GhcPs -> Bool)
-> (LConDecl GhcPs -> ConDecl GhcPs) -> LConDecl GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDecl GhcPs -> ConDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LConDecl GhcPs]
dd_cons
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl GhcPs]
dd_cons) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    if Bool
gadt
      then R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
constructorSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Text -> R ()
txt Text
"where"
        R ()
breakpoint
        (LConDecl GhcPs -> R ()) -> [LConDecl GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((ConDecl GhcPs -> R ()) -> LConDecl GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
False)) [LConDecl GhcPs]
dd_cons
      else [SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (LConDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LConDecl GhcPs -> SrcSpan) -> [LConDecl GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LConDecl GhcPs]
dd_cons)) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        let singleConstRec :: Bool
singleConstRec = [LConDecl GhcPs] -> Bool
isSingleConstRec [LConDecl GhcPs]
dd_cons
        if Bool
singleConstRec
          then R ()
space
          else
            if [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
              then R ()
newline
              else R ()
breakpoint
        R ()
equals
        R ()
space
        Layout
layout <- R Layout
getLayout
        let s :: R ()
s =
              if Layout
layout Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
MultiLine Bool -> Bool -> Bool
|| [LConDecl GhcPs] -> Bool
hasHaddocks [LConDecl GhcPs]
dd_cons
                then R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
                else R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
            sitcc' :: R () -> R ()
sitcc' =
              if Bool
singleConstRec
                then R () -> R ()
forall a. a -> a
id
                else R () -> R ()
sitcc
        R () -> (LConDecl GhcPs -> R ()) -> [LConDecl GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
s (R () -> R ()
sitcc' (R () -> R ())
-> (LConDecl GhcPs -> R ()) -> LConDecl GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConDecl GhcPs -> R ()) -> LConDecl GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec)) [LConDecl GhcPs]
dd_cons
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsDerivingClause GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LHsDerivingClause GhcPs] -> Bool)
-> [LHsDerivingClause GhcPs] -> Bool
forall a b. (a -> b) -> a -> b
$ HsDeriving GhcPs -> SrcSpanLess (HsDeriving GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc HsDeriving GhcPs
dd_derivs) R ()
breakpoint
  R () -> R ()
inci (R () -> R ())
-> (([LHsDerivingClause GhcPs] -> R ()) -> R ())
-> ([LHsDerivingClause GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDeriving GhcPs -> ([LHsDerivingClause GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located HsDeriving GhcPs
dd_derivs (([LHsDerivingClause GhcPs] -> R ()) -> R ())
-> ([LHsDerivingClause GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \[LHsDerivingClause GhcPs]
xs ->
    R ()
-> (LHsDerivingClause GhcPs -> R ())
-> [LHsDerivingClause GhcPs]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((HsDerivingClause GhcPs -> R ()) -> LHsDerivingClause GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) [LHsDerivingClause GhcPs]
xs
p_dataDecl FamilyStyle
_ Located RdrName
_ [LHsType GhcPs]
_ LexicalFixity
_ (XHsDataDefn XXHsDataDefn GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsDataDefn GhcPs
x

p_conDecl ::
  Bool ->
  ConDecl GhcPs ->
  R ()
p_conDecl :: Bool -> ConDecl GhcPs -> R ()
p_conDecl Bool
singleConstRec = \case
  ConDeclGADT {[Located (IdP GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
LHsQTyVars GhcPs
HsConDeclDetails GhcPs
XConDeclGADT GhcPs
Located Bool
LHsType GhcPs
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_names :: forall pass. ConDecl pass -> [Located (IdP pass)]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_qvars :: forall pass. ConDecl pass -> LHsQTyVars pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_doc :: Maybe LHsDocString
con_res_ty :: LHsType GhcPs
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_qvars :: LHsQTyVars GhcPs
con_forall :: Located Bool
con_names :: [Located (IdP GhcPs)]
con_g_ext :: XConDeclGADT GhcPs
..} -> do
    (LHsDocString -> R ()) -> Maybe LHsDocString -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True) Maybe LHsDocString
con_doc
    let conDeclSpn :: [SrcSpan]
conDeclSpn =
          (Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [Located (IdP GhcPs)]
[Located RdrName]
con_names
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [Located Bool -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Bool
con_forall]
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> LHsQTyVars GhcPs -> [SrcSpan]
conTyVarsSpans LHsQTyVars GhcPs
con_qvars
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList ((LHsContext GhcPs -> SrcSpan)
-> Maybe (LHsContext GhcPs) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsContext GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Maybe (LHsContext GhcPs)
con_mb_cxt)
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans HsConDeclDetails GhcPs
con_args
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      case [Located (IdP GhcPs)]
con_names of
        [] -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Located (IdP GhcPs)
c : [Located (IdP GhcPs)]
cs) -> do
          Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
c
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (IdP GhcPs)]
[Located 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 () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Located RdrName -> R ()
p_rdrName [Located (IdP GhcPs)]
[Located RdrName]
cs
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
space
        Text -> R ()
txt Text
"::"
        let interArgBreak :: R ()
interArgBreak =
              if HsType GhcPs -> Bool
hasDocStrings (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
con_res_ty)
                then R ()
newline
                else R ()
breakpoint
        R ()
interArgBreak
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Located Bool -> SrcSpanLess (Located Bool)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Bool
con_forall) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          ForallVisFlag
-> (HsTyVarBndr GhcPs -> R ())
-> [Located (HsTyVarBndr GhcPs)]
-> R ()
forall a.
Data a =>
ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
p_forallBndrs ForallVisFlag
ForallInvis HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr (LHsQTyVars GhcPs -> [Located (HsTyVarBndr GhcPs)]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsq_explicit LHsQTyVars GhcPs
con_qvars)
          R ()
interArgBreak
        Maybe (LHsContext GhcPs) -> (LHsContext GhcPs -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
con_mb_cxt LHsContext GhcPs -> R ()
p_lhsContext
        case HsConDeclDetails GhcPs
con_args of
          PrefixCon [LHsType GhcPs]
xs -> do
            R () -> (LHsType GhcPs -> R ()) -> [LHsType GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [LHsType GhcPs]
xs
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType GhcPs]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              R ()
space
              Text -> R ()
txt Text
"->"
              R ()
breakpoint
          RecCon Located [LConDeclField GhcPs]
l -> do
            Located [LConDeclField GhcPs]
-> ([LConDeclField GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [LConDeclField GhcPs]
l [LConDeclField GhcPs] -> R ()
p_conDeclFields
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LConDeclField GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LConDeclField GhcPs] -> Bool) -> [LConDeclField GhcPs] -> Bool
forall a b. (a -> b) -> a -> b
$ Located [LConDeclField GhcPs]
-> SrcSpanLess (Located [LConDeclField GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcPs]
l) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              R ()
space
              Text -> R ()
txt Text
"->"
              R ()
breakpoint
          InfixCon LHsType GhcPs
_ LHsType GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"InfixCon"
        HsType GhcPs -> R ()
p_hsType (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
con_res_ty)
  ConDeclH98 {[Located (HsTyVarBndr GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclDetails GhcPs
XConDeclH98 GhcPs
Located Bool
Located (IdP GhcPs)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [Located (HsTyVarBndr GhcPs)]
con_forall :: Located Bool
con_name :: Located (IdP GhcPs)
con_ext :: XConDeclH98 GhcPs
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} -> do
    (LHsDocString -> R ()) -> Maybe LHsDocString -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True) Maybe LHsDocString
con_doc
    let conDeclWithContextSpn :: [SrcSpan]
conDeclWithContextSpn =
          [Located Bool -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Bool
con_forall]
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> (Located (HsTyVarBndr GhcPs) -> SrcSpan)
-> [Located (HsTyVarBndr GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsTyVarBndr GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [Located (HsTyVarBndr GhcPs)]
con_ex_tvs
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> Maybe SrcSpan -> [SrcSpan]
forall a. Maybe a -> [a]
maybeToList ((LHsContext GhcPs -> SrcSpan)
-> Maybe (LHsContext GhcPs) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsContext GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Maybe (LHsContext GhcPs)
con_mb_cxt)
            [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
conDeclSpn
        conDeclSpn :: [SrcSpan]
conDeclSpn =
          Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
con_name SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans HsConDeclDetails GhcPs
con_args
    [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 (Located Bool -> SrcSpanLess (Located Bool)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Bool
con_forall) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        ForallVisFlag
-> (HsTyVarBndr GhcPs -> R ())
-> [Located (HsTyVarBndr GhcPs)]
-> R ()
forall a.
Data a =>
ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
p_forallBndrs ForallVisFlag
ForallInvis HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr [Located (HsTyVarBndr GhcPs)]
con_ex_tvs
        R ()
breakpoint
      Maybe (LHsContext GhcPs) -> (LHsContext GhcPs -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
con_mb_cxt LHsContext GhcPs -> R ()
p_lhsContext
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conDeclSpn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case HsConDeclDetails GhcPs
con_args of
        PrefixCon [LHsType GhcPs]
xs -> do
          Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
con_name
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType GhcPs]
xs) R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsType GhcPs -> R ()) -> [LHsType GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ()) -> (LHsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsTypePostDoc) [LHsType GhcPs]
xs
        RecCon Located [LConDeclField GhcPs]
l -> do
          Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
con_name
          R ()
breakpoint
          Bool -> R () -> R ()
inciIf (Bool -> Bool
not Bool
singleConstRec) (Located [LConDeclField GhcPs]
-> ([LConDeclField GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [LConDeclField GhcPs]
l [LConDeclField GhcPs] -> R ()
p_conDeclFields)
        InfixCon LHsType GhcPs
x LHsType GhcPs
y -> do
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
x HsType GhcPs -> R ()
p_hsType
          R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
            Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
con_name
            R ()
space
            LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
y HsType GhcPs -> R ()
p_hsType
  XConDecl XXConDecl GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl GhcPs
x

conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans = \case
  PrefixCon [LHsType GhcPs]
xs ->
    LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsType GhcPs -> SrcSpan) -> [LHsType GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsType GhcPs]
xs
  RecCon Located [LConDeclField GhcPs]
l ->
    [Located [LConDeclField GhcPs] -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located [LConDeclField GhcPs]
l]
  InfixCon LHsType GhcPs
x LHsType GhcPs
y ->
    [LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsType GhcPs
x, LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsType GhcPs
y]

conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]
conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]
conTyVarsSpans = \case
  HsQTvs {[Located (HsTyVarBndr GhcPs)]
XHsQTvs GhcPs
hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass
hsq_explicit :: [Located (HsTyVarBndr GhcPs)]
hsq_ext :: XHsQTvs GhcPs
hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
..} -> Located (HsTyVarBndr GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (HsTyVarBndr GhcPs) -> SrcSpan)
-> [Located (HsTyVarBndr GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (HsTyVarBndr GhcPs)]
hsq_explicit
  XLHsQTyVars XXLHsQTyVars GhcPs
x -> NoExtCon -> [SrcSpan]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXLHsQTyVars GhcPs
x

p_lhsContext ::
  LHsContext GhcPs ->
  R ()
p_lhsContext :: LHsContext GhcPs -> R ()
p_lhsContext = \case
  L SrcSpan
_ [] -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LHsContext GhcPs
ctx -> do
    LHsContext GhcPs -> ([LHsType GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsContext GhcPs
ctx [LHsType 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
  XConDecl {} -> Bool
False

p_hsDerivingClause ::
  HsDerivingClause GhcPs ->
  R ()
p_hsDerivingClause :: HsDerivingClause GhcPs -> R ()
p_hsDerivingClause HsDerivingClause {Maybe (LDerivStrategy GhcPs)
XCHsDerivingClause GhcPs
Located [LHsSigType 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 -> Located [LHsSigType pass]
deriv_clause_tys :: Located [LHsSigType GhcPs]
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_ext :: XCHsDerivingClause GhcPs
..} = do
  Text -> R ()
txt Text
"deriving"
  let derivingWhat :: R ()
derivingWhat = Located [LHsSigType GhcPs] -> ([LHsSigType GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [LHsSigType GhcPs]
deriv_clause_tys (([LHsSigType GhcPs] -> R ()) -> R ())
-> ([LHsSigType GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \case
        [] -> Text -> R ()
txt Text
"()"
        [LHsSigType GhcPs]
xs ->
          BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            R () -> (LHsSigType GhcPs -> R ()) -> [LHsSigType GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
              R ()
commaDel
              (R () -> R ()
sitcc (R () -> R ())
-> (LHsSigType GhcPs -> R ()) -> LHsSigType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsType (LHsType GhcPs -> R ())
-> (LHsSigType GhcPs -> LHsType GhcPs) -> LHsSigType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsSigType GhcPs -> LHsType GhcPs
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body)
              [LHsSigType GhcPs]
xs
  R ()
space
  case Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy of
    Maybe (LDerivStrategy GhcPs)
Nothing -> do
      R ()
breakpoint
      R () -> R ()
inci R ()
derivingWhat
    Just (L SrcSpan
_ DerivStrategy GhcPs
a) -> case DerivStrategy GhcPs
a of
      DerivStrategy GhcPs
StockStrategy -> do
        Text -> R ()
txt Text
"stock"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      DerivStrategy GhcPs
AnyclassStrategy -> do
        Text -> R ()
txt Text
"anyclass"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      DerivStrategy GhcPs
NewtypeStrategy -> do
        Text -> R ()
txt Text
"newtype"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      ViaStrategy HsIB {..} -> 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
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
hsib_body HsType GhcPs -> R ()
p_hsType
      ViaStrategy (XHsImplicitBndrs x) ->
        NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs GhcPs (LHsType GhcPs)
x
p_hsDerivingClause (XHsDerivingClause XXHsDerivingClause GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsDerivingClause GhcPs
x

----------------------------------------------------------------------------
-- 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 SrcSpan
_ ConDeclH98 {[Located (HsTyVarBndr GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclDetails GhcPs
XConDeclH98 GhcPs
Located Bool
Located (IdP GhcPs)
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [Located (HsTyVarBndr GhcPs)]
con_forall :: Located Bool
con_name :: Located (IdP GhcPs)
con_ext :: XConDeclH98 GhcPs
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..})] =
  case HsConDeclDetails GhcPs
con_args of
    RecCon Located [LConDeclField GhcPs]
_ -> Bool
True
    HsConDeclDetails GhcPs
_ -> Bool
False
isSingleConstRec [LConDecl GhcPs]
_ = Bool
False

hasHaddocks :: [LConDecl GhcPs] -> Bool
hasHaddocks :: [LConDecl GhcPs] -> Bool
hasHaddocks = (LConDecl GhcPs -> Bool) -> [LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConDecl GhcPs -> Bool
forall pass. ConDecl pass -> Bool
f (ConDecl GhcPs -> Bool)
-> (LConDecl GhcPs -> ConDecl GhcPs) -> LConDecl GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDecl GhcPs -> ConDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
  where
    f :: ConDecl pass -> Bool
f ConDeclH98 {[LHsTyVarBndr pass]
Maybe (LHsContext pass)
Maybe LHsDocString
HsConDeclDetails pass
XConDeclH98 pass
Located Bool
Located (IdP pass)
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails pass
con_mb_cxt :: Maybe (LHsContext pass)
con_ex_tvs :: [LHsTyVarBndr pass]
con_forall :: Located Bool
con_name :: Located (IdP pass)
con_ext :: XConDeclH98 pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} = Maybe LHsDocString -> Bool
forall a. Maybe a -> Bool
isJust Maybe LHsDocString
con_doc
    f ConDecl pass
_ = Bool
False