{-# 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
import RdrName (RdrName (..))
import SrcLoc (Located)

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 style :: FamilyStyle
style name :: Located RdrName
name tpats :: [LHsType GhcPs]
tpats fixity :: LexicalFixity
fixity HsDataDefn {..} = do
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case NewOrData
dd_ND of
    NewType -> "newtype"
    DataType -> "data"
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case FamilyStyle
style of
    Associated -> Text
forall a. Monoid a => a
mempty
    Free -> " instance"
  [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]
: (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) (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 -> (R () -> R ()) -> R () -> [R ()] -> R ()
p_infixDefHelper
        (LexicalFixity -> Bool
isInfix LexicalFixity
fixity)
        R () -> R ()
inci
        (Located RdrName -> R ()
p_rdrName Located RdrName
name)
        ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. Data 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
    Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just k :: LHsType GhcPs
k -> do
      R ()
space
      Text -> R ()
txt "::"
      R ()
space
      LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data 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 do
        R ()
space
        Text -> R ()
txt "where"
        R ()
breakpoint
        R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LConDecl GhcPs -> R ()) -> [LConDecl GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((ConDecl GhcPs -> R ()) -> LConDecl GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' ConDecl GhcPs -> R ()
p_conDecl) [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 ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci
        (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Text -> R ()
txt "="
          R ()
space
          let s :: R ()
s =
                R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout
                  (R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
                  (R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
          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. Data a => (a -> R ()) -> Located a -> R ()
located' ConDecl GhcPs -> R ()
p_conDecl) [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. Data 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
$ \xs :: [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. Data a => (a -> R ()) -> Located a -> R ()
located' HsDerivingClause GhcPs -> R ()
p_hsDerivingClause) [LHsDerivingClause GhcPs]
xs
p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = String -> R ()
forall a. String -> a
notImplemented "XHsDataDefn"

p_conDecl :: ConDecl GhcPs -> R ()
p_conDecl :: ConDecl GhcPs -> R ()
p_conDecl = \case
  ConDeclGADT {..} -> 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 ()
        (c :: Located (IdP GhcPs)
c : cs :: [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 ()
comma
            R ()
breakpoint
            R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) Located RdrName -> R ()
p_rdrName [Located (IdP GhcPs)]
[Located RdrName]
cs
      R ()
space
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> R ()
txt "::"
        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
          (HsTyVarBndr GhcPs -> R ())
-> [Located (HsTyVarBndr GhcPs)] -> R ()
forall a. Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs 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 xs :: [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. Data 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 "->"
              R ()
breakpoint
          RecCon l :: Located [LConDeclField GhcPs]
l -> do
            Located [LConDeclField GhcPs]
-> ([LConDeclField GhcPs] -> R ()) -> R ()
forall a. Data 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 "->"
              R ()
breakpoint
          InfixCon _ _ -> String -> R ()
forall a. String -> a
notImplemented "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 {..} -> 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
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
con_name]
            [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
<> (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
<> 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
      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
        (HsTyVarBndr GhcPs -> R ())
-> [Located (HsTyVarBndr GhcPs)] -> R ()
forall a. Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs 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
      case HsConDeclDetails GhcPs
con_args of
        PrefixCon xs :: [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. Data a => (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [LHsType GhcPs]
xs
        RecCon l :: Located [LConDeclField GhcPs]
l -> do
          Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
con_name
          R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located [LConDeclField GhcPs]
-> ([LConDeclField GhcPs] -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located [LConDeclField GhcPs]
l [LConDeclField GhcPs] -> R ()
p_conDeclFields
        InfixCon x :: LHsType GhcPs
x y :: LHsType GhcPs
y -> do
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data 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. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
y HsType GhcPs -> R ()
p_hsType
  XConDecl NoExt -> String -> R ()
forall a. String -> a
notImplemented "XConDecl"

conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]
conArgsSpans = \case
  PrefixCon xs :: [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 l :: Located [LConDeclField GhcPs]
l ->
    [Located [LConDeclField GhcPs] -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located [LConDeclField GhcPs]
l]
  InfixCon x :: LHsType GhcPs
x y :: 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) -> 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 NoExt -> []

p_lhsContext ::
  LHsContext GhcPs ->
  R ()
p_lhsContext :: LHsContext GhcPs -> R ()
p_lhsContext = \case
  L _ [] -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ctx :: LHsContext GhcPs
ctx -> do
    LHsContext GhcPs -> ([LHsType GhcPs] -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsContext GhcPs
ctx [LHsType GhcPs] -> R ()
p_hsContext
    R ()
space
    Text -> R ()
txt "=>"
    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 {..} = do
  Text -> R ()
txt "deriving"
  let derivingWhat :: R ()
derivingWhat = Located [LHsSigType GhcPs] -> ([LHsSigType GhcPs] -> R ()) -> R ()
forall a. Data 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 "()"
        xs :: [LHsSigType GhcPs]
xs ->
          BracketStyle -> R () -> R ()
parens BracketStyle
N (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 () -> (LHsSigType GhcPs -> R ()) -> [LHsSigType GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
              (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint)
              (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. Data 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
    Nothing -> do
      R ()
breakpoint
      R () -> R ()
inci R ()
derivingWhat
    Just (L _ a :: DerivStrategy GhcPs
a) -> case DerivStrategy GhcPs
a of
      StockStrategy -> do
        Text -> R ()
txt "stock"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      AnyclassStrategy -> do
        Text -> R ()
txt "anyclass"
        R ()
breakpoint
        R () -> R ()
inci R ()
derivingWhat
      NewtypeStrategy -> do
        Text -> R ()
txt "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 "via"
          R ()
space
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
hsib_body HsType GhcPs -> R ()
p_hsType
      ViaStrategy (XHsImplicitBndrs NoExt) ->
        String -> R ()
forall a. String -> a
notImplemented "XHsImplicitBndrs"
p_hsDerivingClause (XHsDerivingClause NoExt) = String -> R ()
forall a. String -> a
notImplemented "XHsDerivingClause"

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

isInfix :: LexicalFixity -> Bool
isInfix :: LexicalFixity -> Bool
isInfix = \case
  Infix -> Bool
True
  Prefix -> Bool
False