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

-- | Rendering of types.
module Ormolu.Printer.Meat.Type
  ( p_hsType,
    hasDocStrings,
    p_hsContext,
    p_hsTyVarBndr,
    p_forallBndrs,
    p_conDeclFields,
    tyVarsToTypes,
  )
where

import Data.Data (Data)
import GHC hiding (isPromoted)
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)
import Ormolu.Printer.Operators
import Ormolu.Utils

p_hsType :: HsType GhcPs -> R ()
p_hsType :: HsType GhcPs -> R ()
p_hsType t :: HsType GhcPs
t = Bool -> HsType GhcPs -> R ()
p_hsType' (HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
t) HsType GhcPs
t

p_hsType' :: Bool -> HsType GhcPs -> R ()
p_hsType' :: Bool -> HsType GhcPs -> R ()
p_hsType' multilineArgs :: Bool
multilineArgs = \case
  HsForAllTy NoExt bndrs :: [LHsTyVarBndr GhcPs]
bndrs t :: LHsType GhcPs
t -> do
    (HsTyVarBndr GhcPs -> R ()) -> [LHsTyVarBndr GhcPs] -> R ()
forall a. Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr GhcPs]
bndrs
    R ()
interArgBreak
    Bool -> HsType GhcPs -> R ()
p_hsType' Bool
multilineArgs (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
t)
  HsQualTy NoExt qs :: LHsContext GhcPs
qs t :: LHsType GhcPs
t -> do
    LHsContext GhcPs -> (HsContext GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsContext GhcPs
qs HsContext GhcPs -> R ()
p_hsContext
    R ()
space
    Text -> R ()
txt "=>"
    R ()
interArgBreak
    case LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
t of
      HsQualTy {} -> HsType GhcPs -> R ()
p_hsTypeR (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
t)
      HsFunTy {} -> HsType GhcPs -> R ()
p_hsTypeR (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
t)
      _ -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsTypeR
  HsTyVar NoExt p :: PromotionFlag
p n :: Located (IdP GhcPs)
n -> do
    case PromotionFlag
p of
      IsPromoted -> do
        Text -> R ()
txt "'"
        case RdrName -> String
forall o. Outputable o => o -> String
showOutputable (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
n) of
          _ : '\'' : _ -> R ()
space
          _ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      NotPromoted -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
n
  HsAppTy NoExt f :: LHsType GhcPs
f x :: LHsType GhcPs
x -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
f HsType GhcPs -> R ()
p_hsType
    R ()
breakpoint
    R () -> R ()
inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
x HsType GhcPs -> R ()
p_hsType)
  HsAppKindTy _ ty :: LHsType GhcPs
ty kd :: LHsType GhcPs
kd -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    -- The first argument is the location of the "@..." part. Not 100% sure,
    -- but I think we can ignore it as long as we use 'located' on both the
    -- type and the kind.
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty HsType GhcPs -> R ()
p_hsType
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt "@"
      LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
kd HsType GhcPs -> R ()
p_hsType
  HsFunTy NoExt x :: LHsType GhcPs
x y :: LHsType GhcPs
y@(L _ y' :: HsType 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 ()
space
    Text -> R ()
txt "->"
    R ()
interArgBreak
    case HsType GhcPs
y' of
      HsFunTy {} -> HsType GhcPs -> R ()
p_hsTypeR HsType GhcPs
y'
      _ -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
y HsType GhcPs -> R ()
p_hsTypeR
  HsListTy NoExt t :: LHsType GhcPs
t ->
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t (BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType)
  HsTupleTy NoExt tsort :: HsTupleSort
tsort xs :: HsContext GhcPs
xs ->
    let parens' :: R () -> R ()
parens' =
          case HsTupleSort
tsort of
            HsUnboxedTuple -> BracketStyle -> R () -> R ()
parensHash BracketStyle
N
            HsBoxedTuple -> BracketStyle -> R () -> R ()
parens BracketStyle
N
            HsConstraintTuple -> BracketStyle -> R () -> R ()
parens BracketStyle
N
            HsBoxedOrConstraintTuple -> BracketStyle -> R () -> R ()
parens BracketStyle
N
     in R () -> R ()
parens' (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 ()) -> HsContext 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 ()) -> (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) HsContext GhcPs
xs
  HsSumTy NoExt xs :: HsContext GhcPs
xs ->
    BracketStyle -> R () -> R ()
parensHash 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 () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt "|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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) HsContext GhcPs
xs
  HsOpTy NoExt x :: LHsType GhcPs
x op :: Located (IdP GhcPs)
op y :: LHsType GhcPs
y ->
    R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      let opTree :: OpTree (LHsType GhcPs) (Located RdrName)
opTree = OpTree (LHsType GhcPs) (Located RdrName)
-> Located RdrName
-> OpTree (LHsType GhcPs) (Located RdrName)
-> OpTree (LHsType GhcPs) (Located RdrName)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree LHsType GhcPs
x) Located (IdP GhcPs)
Located RdrName
op (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree LHsType GhcPs
y)
       in OpTree (LHsType GhcPs) (Located RdrName) -> R ()
p_tyOpTree ((RdrName -> Maybe RdrName)
-> OpTree (LHsType GhcPs) (Located RdrName)
-> OpTree (LHsType GhcPs) (Located RdrName)
forall op ty.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just OpTree (LHsType GhcPs) (Located RdrName)
opTree)
  HsParTy NoExt t :: LHsType GhcPs
t ->
    BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsType)
  HsIParamTy NoExt n :: Located HsIPName
n t :: LHsType GhcPs
t -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located HsIPName -> (HsIPName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located HsIPName
n HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom
    R ()
space
    Text -> R ()
txt "::"
    R ()
breakpoint
    R () -> R ()
inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsType)
  HsStarTy NoExt _ -> Text -> R ()
txt "*"
  HsKindSig NoExt t :: LHsType GhcPs
t k :: LHsType GhcPs
k -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsType
    R ()
space -- FIXME
    Text -> R ()
txt "::"
    R ()
space
    R () -> R ()
inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
k HsType GhcPs -> R ()
p_hsType)
  HsSpliceTy NoExt splice :: HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  HsDocTy NoExt t :: LHsType GhcPs
t str :: LHsDocString
str -> do
    HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True LHsDocString
str
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsType
  HsBangTy NoExt (HsSrcBang _ u :: SrcUnpackedness
u s :: SrcStrictness
s) t :: LHsType GhcPs
t -> do
    case SrcUnpackedness
u of
      SrcUnpack -> Text -> R ()
txt "{-# UNPACK #-}" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
      SrcNoUnpack -> Text -> R ()
txt "{-# NOUNPACK #-}" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
      NoSrcUnpack -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case SrcStrictness
s of
      SrcLazy -> Text -> R ()
txt "~"
      SrcStrict -> Text -> R ()
txt "!"
      NoSrcStrict -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
t HsType GhcPs -> R ()
p_hsType
  HsRecTy NoExt fields :: [LConDeclField GhcPs]
fields ->
    [LConDeclField GhcPs] -> R ()
p_conDeclFields [LConDeclField GhcPs]
fields
  HsExplicitListTy NoExt p :: PromotionFlag
p xs :: HsContext GhcPs
xs -> do
    case PromotionFlag
p of
      IsPromoted -> Text -> R ()
txt "'"
      NotPromoted -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      -- If both this list itself and the first element is promoted,
      -- we need to put a space in between or it fails to parse.
      case (PromotionFlag
p, HsContext GhcPs
xs) of
        (IsPromoted, L _ t :: HsType GhcPs
t : _) | HsType GhcPs -> Bool
forall pass. HsType pass -> Bool
isPromoted HsType GhcPs
t -> R ()
space
        _ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsType GhcPs -> R ()) -> HsContext 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 ()) -> (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) HsContext GhcPs
xs
  HsExplicitTupleTy NoExt xs :: HsContext GhcPs
xs -> do
    Text -> R ()
txt "'"
    BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      case HsContext GhcPs
xs of
        L _ t :: HsType GhcPs
t : _ | HsType GhcPs -> Bool
forall pass. HsType pass -> Bool
isPromoted HsType GhcPs
t -> R ()
space
        _ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      R () -> (LHsType GhcPs -> R ()) -> HsContext 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) ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsType GhcPs -> R ()
p_hsType) HsContext GhcPs
xs
  HsTyLit NoExt t :: HsTyLit
t ->
    case HsTyLit
t of
      HsStrTy (SourceText s :: String
s) _ -> String -> R ()
p_stringLit String
s
      a :: HsTyLit
a -> HsTyLit -> R ()
forall a. Outputable a => a -> R ()
atom HsTyLit
a
  HsWildCardTy NoExt -> Text -> R ()
txt "_"
  XHsType (NHsCoreTy t) -> Type -> R ()
forall a. Outputable a => a -> R ()
atom Type
t
  where
    isPromoted :: HsType pass -> Bool
isPromoted = \case
      HsTyVar _ IsPromoted _ -> Bool
True
      HsExplicitListTy {} -> Bool
True
      HsExplicitTupleTy {} -> Bool
True
      _ -> Bool
False
    interArgBreak :: R ()
interArgBreak =
      if Bool
multilineArgs
        then R ()
newline
        else R ()
breakpoint
    p_hsTypeR :: HsType GhcPs -> R ()
p_hsTypeR = Bool -> HsType GhcPs -> R ()
p_hsType' Bool
multilineArgs

-- | Return 'True' if at least one argument in 'HsType' has a doc string
-- attached to it.
hasDocStrings :: HsType GhcPs -> Bool
hasDocStrings :: HsType GhcPs -> Bool
hasDocStrings = \case
  HsDocTy {} -> Bool
True
  HsFunTy _ (L _ x :: HsType GhcPs
x) (L _ y :: HsType GhcPs
y) -> HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
x Bool -> Bool -> Bool
|| HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
y
  _ -> Bool
False

p_hsContext :: HsContext GhcPs -> R ()
p_hsContext :: HsContext GhcPs -> R ()
p_hsContext = \case
  [] -> Text -> R ()
txt "()"
  [x :: LHsType GhcPs
x] -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
x HsType GhcPs -> R ()
p_hsType
  xs :: HsContext 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 () -> (LHsType GhcPs -> R ()) -> HsContext 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 ()) -> (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) HsContext GhcPs
xs

p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr = \case
  UserTyVar NoExt x :: Located (IdP GhcPs)
x ->
    Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
x
  KindedTyVar NoExt l :: Located (IdP GhcPs)
l k :: LHsType GhcPs
k -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (IdP GhcPs)
Located RdrName
l RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
    R ()
space
    Text -> R ()
txt "::"
    R ()
breakpoint
    R () -> R ()
inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
k HsType GhcPs -> R ()
p_hsType)
  XTyVarBndr NoExt -> String -> R ()
forall a. String -> a
notImplemented "XTyVarBndr"

-- | Render several @forall@-ed variables.
p_forallBndrs :: Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs :: (a -> R ()) -> [Located a] -> R ()
p_forallBndrs _ [] = Text -> R ()
txt "forall."
p_forallBndrs p :: a -> R ()
p tyvars :: [Located a]
tyvars =
  [SrcSpan] -> R () -> R ()
switchLayout (Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located a -> SrcSpan) -> [Located a] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located a]
tyvars) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> R ()
txt "forall"
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Located a -> R ()) -> [Located a] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ()) -> (Located a -> R ()) -> Located a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> R ()) -> Located a -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' a -> R ()
p) [Located a]
tyvars
      Text -> R ()
txt "."

p_conDeclFields :: [LConDeclField GhcPs] -> R ()
p_conDeclFields :: [LConDeclField GhcPs] -> R ()
p_conDeclFields xs :: [LConDeclField GhcPs]
xs =
  BracketStyle -> R () -> R ()
braces 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 ()
-> (LConDeclField GhcPs -> R ()) -> [LConDeclField 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 ())
-> (LConDeclField GhcPs -> R ()) -> LConDeclField GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConDeclField GhcPs -> R ()) -> LConDeclField GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' ConDeclField GhcPs -> R ()
p_conDeclField) [LConDeclField GhcPs]
xs

p_conDeclField :: ConDeclField GhcPs -> R ()
p_conDeclField :: ConDeclField GhcPs -> R ()
p_conDeclField ConDeclField {..} = 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
cd_fld_doc
  R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    R () -> (LFieldOcc GhcPs -> R ()) -> [LFieldOcc 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)
      ((FieldOcc GhcPs -> R ()) -> LFieldOcc GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (Located RdrName -> R ()
p_rdrName (Located RdrName -> R ())
-> (FieldOcc GhcPs -> Located RdrName) -> FieldOcc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc))
      [LFieldOcc GhcPs]
cd_fld_names
  R ()
space
  Text -> R ()
txt "::"
  R ()
breakpoint
  R () -> R ()
sitcc (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
$ HsType GhcPs -> R ()
p_hsType (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
cd_fld_type)
p_conDeclField (XConDeclField NoExt) = String -> R ()
forall a. String -> a
notImplemented "XConDeclField"

tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree (L _ (HsOpTy NoExt l :: LHsType GhcPs
l op :: Located (IdP GhcPs)
op r :: LHsType GhcPs
r)) =
  OpTree (LHsType GhcPs) (Located RdrName)
-> Located RdrName
-> OpTree (LHsType GhcPs) (Located RdrName)
-> OpTree (LHsType GhcPs) (Located RdrName)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree LHsType GhcPs
l) Located (IdP GhcPs)
Located RdrName
op (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
tyOpTree LHsType GhcPs
r)
tyOpTree n :: LHsType GhcPs
n = LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
forall ty op. ty -> OpTree ty op
OpNode LHsType GhcPs
n

p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()
p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()
p_tyOpTree (OpNode n :: LHsType GhcPs
n) = LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
n HsType GhcPs -> R ()
p_hsType
p_tyOpTree (OpBranch l :: OpTree (LHsType GhcPs) (Located RdrName)
l op :: Located RdrName
op r :: OpTree (LHsType GhcPs) (Located RdrName)
r) = do
  [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsType GhcPs) (Located RdrName) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsType GhcPs) (Located RdrName)
l] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    OpTree (LHsType GhcPs) (Located RdrName) -> R ()
p_tyOpTree OpTree (LHsType GhcPs) (Located RdrName)
l
  R ()
breakpoint
  R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsType GhcPs) (Located RdrName) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsType GhcPs) (Located RdrName)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located RdrName -> R ()
p_rdrName Located RdrName
op
    R ()
space
    OpTree (LHsType GhcPs) (Located RdrName) -> R ()
p_tyOpTree OpTree (LHsType GhcPs) (Located RdrName)
r

----------------------------------------------------------------------------
-- Conversion functions

tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
tyVarsToTypes :: LHsQTyVars GhcPs -> HsContext GhcPs
tyVarsToTypes = \case
  HsQTvs {..} -> (HsTyVarBndr GhcPs -> HsType GhcPs)
-> LHsTyVarBndr GhcPs -> LHsType GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr GhcPs -> HsType GhcPs
tyVarToType (LHsTyVarBndr GhcPs -> LHsType GhcPs)
-> [LHsTyVarBndr GhcPs] -> HsContext GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr GhcPs]
hsq_explicit
  XLHsQTyVars {} -> String -> HsContext GhcPs
forall a. String -> a
notImplemented "XLHsQTyVars"

tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
tyVarToType = \case
  UserTyVar NoExt tvar :: Located (IdP GhcPs)
tvar -> XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExt
XTyVar GhcPs
NoExt PromotionFlag
NotPromoted Located (IdP GhcPs)
tvar
  KindedTyVar NoExt tvar :: Located (IdP GhcPs)
tvar kind :: LHsType GhcPs
kind ->
    -- Note: we always add parentheses because for whatever reason GHC does
    -- not use HsParTy for left-hand sides of declarations. Please see
    -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as
    -- long as 'tyVarToType' does not get applied to right-hand sides of
    -- declarations.
    XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy NoExt
XParTy GhcPs
NoExt (LHsType GhcPs -> HsType GhcPs) -> LHsType GhcPs -> HsType GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$
      XKindSig GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig NoExt
XKindSig GhcPs
NoExt (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExt
XTyVar GhcPs
NoExt PromotionFlag
NotPromoted Located (IdP GhcPs)
tvar)) LHsType GhcPs
kind
  XTyVarBndr {} -> String -> HsType GhcPs
forall a. String -> a
notImplemented "XTyVarBndr"