-- HLint is confused by the identifier `pattern` if PatternSynonyms is enabled.
{-# LANGUAGE NoPatternSynonyms #-}

-- | Functions for producing RenderedCode values from PureScript Type values.

module Language.PureScript.Docs.RenderedCode.RenderType
  ( renderType
  , renderTypeWithRole
  , renderType'
  , renderTypeAtom
  , renderTypeAtom'
  , renderRow
  ) where

import Prelude

import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import Data.List (uncons)

import Control.Arrow ((<+>))
import Control.PatternArrows as PA

import Language.PureScript.Crash (internalError)
import Language.PureScript.Label (Label)
import Language.PureScript.Names (coerceProperName)
import Language.PureScript.Pretty.Types (PrettyPrintConstraint, PrettyPrintType(..), convertPrettyPrintType, prettyPrintLabel)
import Language.PureScript.Roles (Role, displayRole)
import Language.PureScript.Types (Type, TypeVarVisibility, typeVarVisibilityPrefix)
import Language.PureScript.PSString (prettyPrintString)

import Language.PureScript.Docs.RenderedCode.Types (RenderedCode, keywordForall, roleAnn, sp, syntax, typeCtor, typeOp, typeVar)
import Language.PureScript.Docs.Utils.MonoidExtras (mintersperse)

typeLiterals :: Pattern () PrettyPrintType RenderedCode
typeLiterals :: Pattern () PrettyPrintType RenderedCode
typeLiterals = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe RenderedCode
match
  where
  match :: PrettyPrintType -> Maybe RenderedCode
match (PPTypeWildcard Maybe Text
name) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> RenderedCode
syntax forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"_" (Text
"?" forall a. Semigroup a => a -> a -> a
<>) Maybe Text
name
  match (PPTypeVar Text
var Maybe Text
role) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> RenderedCode
typeVar Text
var forall a. Semigroup a => a -> a -> a
<> Maybe Text -> RenderedCode
roleAnn Maybe Text
role
  match (PPRecord [(Label, PrettyPrintType)]
labels Maybe PrettyPrintType
tail_) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp
              [ Text -> RenderedCode
syntax Text
"{"
              , [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> RenderedCode
renderRow [(Label, PrettyPrintType)]
labels Maybe PrettyPrintType
tail_
              , Text -> RenderedCode
syntax Text
"}"
              ]
  match (PPTypeConstructor Qualified (ProperName 'TypeName)
n) =
    forall a. a -> Maybe a
Just (Qualified (ProperName 'TypeName) -> RenderedCode
typeCtor Qualified (ProperName 'TypeName)
n)
  match (PPRow [(Label, PrettyPrintType)]
labels Maybe PrettyPrintType
tail_) =
    forall a. a -> Maybe a
Just (Text -> RenderedCode
syntax Text
"(" forall a. Semigroup a => a -> a -> a
<> [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> RenderedCode
renderRow [(Label, PrettyPrintType)]
labels Maybe PrettyPrintType
tail_ forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
")")
  match (PPBinaryNoParensType PrettyPrintType
op PrettyPrintType
l PrettyPrintType
r) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PrettyPrintType -> RenderedCode
renderTypeAtom' PrettyPrintType
l forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> PrettyPrintType -> RenderedCode
renderTypeAtom' PrettyPrintType
op forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> PrettyPrintType -> RenderedCode
renderTypeAtom' PrettyPrintType
r
  match (PPTypeOp Qualified (OpName 'TypeOpName)
n) =
    forall a. a -> Maybe a
Just (Qualified (OpName 'TypeOpName) -> RenderedCode
typeOp Qualified (OpName 'TypeOpName)
n)
  match (PPTypeLevelString PSString
str) =
    forall a. a -> Maybe a
Just (Text -> RenderedCode
syntax (PSString -> Text
prettyPrintString PSString
str))
  match (PPTypeLevelInt Integer
nat) =
    forall a. a -> Maybe a
Just (Text -> RenderedCode
syntax forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
nat)
  match PrettyPrintType
_ =
    forall a. Maybe a
Nothing

renderConstraint :: PrettyPrintConstraint -> RenderedCode
renderConstraint :: PrettyPrintConstraint -> RenderedCode
renderConstraint (Qualified (ProperName 'ClassName)
pn, [PrettyPrintType]
ks, [PrettyPrintType]
tys) =
  let instApp :: PrettyPrintType
instApp = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl PrettyPrintType -> PrettyPrintType -> PrettyPrintType
PPTypeApp (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PrettyPrintType
a PrettyPrintType
b -> PrettyPrintType -> PrettyPrintType -> PrettyPrintType
PPTypeApp PrettyPrintType
a (PrettyPrintType -> PrettyPrintType
PPKindArg PrettyPrintType
b)) (Qualified (ProperName 'TypeName) -> PrettyPrintType
PPTypeConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName Qualified (ProperName 'ClassName)
pn)) [PrettyPrintType]
ks) [PrettyPrintType]
tys
  in  PrettyPrintType -> RenderedCode
renderType' PrettyPrintType
instApp

renderConstraints :: PrettyPrintConstraint -> RenderedCode -> RenderedCode
renderConstraints :: PrettyPrintConstraint -> RenderedCode -> RenderedCode
renderConstraints PrettyPrintConstraint
con RenderedCode
ty =
  forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp
    [ PrettyPrintConstraint -> RenderedCode
renderConstraint PrettyPrintConstraint
con
    , Text -> RenderedCode
syntax Text
"=>"
    , RenderedCode
ty
    ]

-- |
-- Render code representing a Row
--
renderRow :: [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> RenderedCode
renderRow :: [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> RenderedCode
renderRow [(Label, PrettyPrintType)]
h Maybe PrettyPrintType
t = [(Label, PrettyPrintType)] -> RenderedCode
renderHead [(Label, PrettyPrintType)]
h forall a. Semigroup a => a -> a -> a
<> Maybe PrettyPrintType -> RenderedCode
renderTail Maybe PrettyPrintType
t

renderHead :: [(Label, PrettyPrintType)] -> RenderedCode
renderHead :: [(Label, PrettyPrintType)] -> RenderedCode
renderHead = forall m. Monoid m => m -> [m] -> m
mintersperse (Text -> RenderedCode
syntax Text
"," forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Label, PrettyPrintType) -> RenderedCode
renderLabel

renderLabel :: (Label, PrettyPrintType) -> RenderedCode
renderLabel :: (Label, PrettyPrintType) -> RenderedCode
renderLabel (Label
label, PrettyPrintType
ty) =
  forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp
    [ Text -> RenderedCode
typeVar forall a b. (a -> b) -> a -> b
$ Label -> Text
prettyPrintLabel Label
label
    , Text -> RenderedCode
syntax Text
"::"
    , PrettyPrintType -> RenderedCode
renderType' PrettyPrintType
ty
    ]

renderTail :: Maybe PrettyPrintType -> RenderedCode
renderTail :: Maybe PrettyPrintType -> RenderedCode
renderTail Maybe PrettyPrintType
Nothing = forall a. Monoid a => a
mempty
renderTail (Just PrettyPrintType
other) = RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
"|" forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> PrettyPrintType -> RenderedCode
renderType' PrettyPrintType
other

typeApp :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
typeApp :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
typeApp = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match (PPTypeApp PrettyPrintType
f PrettyPrintType
x) = forall a. a -> Maybe a
Just (PrettyPrintType
f, PrettyPrintType
x)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

kindArg :: Pattern () PrettyPrintType ((), PrettyPrintType)
kindArg :: Pattern () PrettyPrintType ((), PrettyPrintType)
kindArg = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe ((), PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe ((), PrettyPrintType)
match (PPKindArg PrettyPrintType
ty) = forall a. a -> Maybe a
Just ((), PrettyPrintType
ty)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

appliedFunction :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
appliedFunction :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
appliedFunction = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match (PPFunction PrettyPrintType
arg PrettyPrintType
ret) = forall a. a -> Maybe a
Just (PrettyPrintType
arg, PrettyPrintType
ret)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

kinded :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
kinded :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
kinded = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe (PrettyPrintType, PrettyPrintType)
match (PPKindedType PrettyPrintType
t PrettyPrintType
k) = forall a. a -> Maybe a
Just (PrettyPrintType
t, PrettyPrintType
k)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

constrained :: Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)
constrained :: Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)
constrained = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe (PrettyPrintConstraint, PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe (PrettyPrintConstraint, PrettyPrintType)
match (PPConstrainedType PrettyPrintConstraint
con PrettyPrintType
ty) = forall a. a -> Maybe a
Just (PrettyPrintConstraint
con, PrettyPrintType
ty)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

explicitParens :: Pattern () PrettyPrintType ((), PrettyPrintType)
explicitParens :: Pattern () PrettyPrintType ((), PrettyPrintType)
explicitParens = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType -> Maybe ((), PrettyPrintType)
match
  where
  match :: PrettyPrintType -> Maybe ((), PrettyPrintType)
match (PPParensInType PrettyPrintType
ty) = forall a. a -> Maybe a
Just ((), PrettyPrintType
ty)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

matchTypeAtom :: Pattern () PrettyPrintType RenderedCode
matchTypeAtom :: Pattern () PrettyPrintType RenderedCode
matchTypeAtom = Pattern () PrettyPrintType RenderedCode
typeLiterals forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RenderedCode -> RenderedCode
parens_ Pattern () PrettyPrintType RenderedCode
matchType
  where
  parens_ :: RenderedCode -> RenderedCode
parens_ RenderedCode
x = Text -> RenderedCode
syntax Text
"(" forall a. Semigroup a => a -> a -> a
<> RenderedCode
x forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
")"

matchType :: Pattern () PrettyPrintType RenderedCode
matchType :: Pattern () PrettyPrintType RenderedCode
matchType = forall u a r. OperatorTable u a r -> Pattern u a r -> Pattern u a r
buildPrettyPrinter OperatorTable () PrettyPrintType RenderedCode
operators Pattern () PrettyPrintType RenderedCode
matchTypeAtom
  where
  operators :: OperatorTable () PrettyPrintType RenderedCode
  operators :: OperatorTable () PrettyPrintType RenderedCode
operators =
    forall u a r. [[Operator u a r]] -> OperatorTable u a r
OperatorTable [ [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern () PrettyPrintType ((), PrettyPrintType)
kindArg forall a b. (a -> b) -> a -> b
$ \()
_ RenderedCode
ty -> Text -> RenderedCode
syntax Text
"@" forall a. Semigroup a => a -> a -> a
<> RenderedCode
ty ]
                  , [ forall u a r. Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
AssocL Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
typeApp forall a b. (a -> b) -> a -> b
$ \RenderedCode
f RenderedCode
x -> RenderedCode
f forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> RenderedCode
x ]
                  , [ forall u a r. Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
AssocR Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
appliedFunction forall a b. (a -> b) -> a -> b
$ \RenderedCode
arg RenderedCode
ret -> forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp [RenderedCode
arg, Text -> RenderedCode
syntax Text
"->", RenderedCode
ret] ]
                  , [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)
constrained forall a b. (a -> b) -> a -> b
$ \PrettyPrintConstraint
deps RenderedCode
ty -> PrettyPrintConstraint -> RenderedCode -> RenderedCode
renderConstraints PrettyPrintConstraint
deps RenderedCode
ty ]
                  , [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern
  ()
  PrettyPrintType
  ([(TypeVarVisibility, Text, Maybe PrettyPrintType)],
   PrettyPrintType)
forall_ forall a b. (a -> b) -> a -> b
$ \[(TypeVarVisibility, Text, Maybe PrettyPrintType)]
tyVars RenderedCode
ty -> forall a. Monoid a => [a] -> a
mconcat [ RenderedCode
keywordForall, RenderedCode
sp, [(TypeVarVisibility, Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars [(TypeVarVisibility, Text, Maybe PrettyPrintType)]
tyVars, Text -> RenderedCode
syntax Text
".", RenderedCode
sp, RenderedCode
ty ] ]
                  , [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
kinded forall a b. (a -> b) -> a -> b
$ \PrettyPrintType
ty RenderedCode
k -> forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp [PrettyPrintType -> RenderedCode
renderType' PrettyPrintType
ty, Text -> RenderedCode
syntax Text
"::", RenderedCode
k] ]
                  , [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern () PrettyPrintType ((), PrettyPrintType)
explicitParens forall a b. (a -> b) -> a -> b
$ \()
_ RenderedCode
ty -> RenderedCode
ty ]
                  ]

forall_ :: Pattern () PrettyPrintType ([(TypeVarVisibility, Text, Maybe PrettyPrintType)], PrettyPrintType)
forall_ :: Pattern
  ()
  PrettyPrintType
  ([(TypeVarVisibility, Text, Maybe PrettyPrintType)],
   PrettyPrintType)
forall_ = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType
-> Maybe
     ([(TypeVarVisibility, Text, Maybe PrettyPrintType)],
      PrettyPrintType)
match
  where
  match :: PrettyPrintType
-> Maybe
     ([(TypeVarVisibility, Text, Maybe PrettyPrintType)],
      PrettyPrintType)
match (PPForAll [(TypeVarVisibility, Text, Maybe PrettyPrintType)]
mbKindedIdents PrettyPrintType
ty) = forall a. a -> Maybe a
Just ([(TypeVarVisibility, Text, Maybe PrettyPrintType)]
mbKindedIdents, PrettyPrintType
ty)
  match PrettyPrintType
_ = forall a. Maybe a
Nothing

renderTypeInternal :: (PrettyPrintType -> PrettyPrintType) -> Type a -> RenderedCode
renderTypeInternal :: forall a.
(PrettyPrintType -> PrettyPrintType) -> Type a -> RenderedCode
renderTypeInternal PrettyPrintType -> PrettyPrintType
insertRolesIfAny =
  PrettyPrintType -> RenderedCode
renderType' forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintType -> PrettyPrintType
insertRolesIfAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Type a -> PrettyPrintType
convertPrettyPrintType forall a. Bounded a => a
maxBound

-- |
-- Render code representing a Type
--
renderType :: Type a -> RenderedCode
renderType :: forall a. Type a -> RenderedCode
renderType = forall a.
(PrettyPrintType -> PrettyPrintType) -> Type a -> RenderedCode
renderTypeInternal forall a. a -> a
id

-- |
-- Render code representing a Type
-- but augment the `TypeVar`s with their `Role` if they have one
--
renderTypeWithRole :: [Role] -> Type a -> RenderedCode
renderTypeWithRole :: forall a. [Role] -> Type a -> RenderedCode
renderTypeWithRole = \case
  [] -> forall a. Type a -> RenderedCode
renderType
  [Role]
roleList -> forall a.
(PrettyPrintType -> PrettyPrintType) -> Type a -> RenderedCode
renderTypeInternal ([Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roleList [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
  where
  -- `data Foo first second = Foo` will produce
  -- ```
  -- PPTypeApp
  --  (PPTypeApp (PPTypeConstructor fooName) (PPTypeVar "first" Nothing))
  --  (PPTypeVar "second" Nothing)
  -- ```
  -- So, we recurse down the left side of `TypeApp` first before
  -- recursing down the right side. To make this stack-safe,
  -- we use a tail-recursive function with its own stack.
  -- - Left = values that have not yet been examined and need
  --          a role added to them (if any). There's still work "left" to do.
  -- - Right = values that have been examined and now need to be
  --           reassembled into their original value
  addRole
    :: [Role]
    -> [Either PrettyPrintType PrettyPrintType]
    -> Either PrettyPrintType PrettyPrintType
    -> PrettyPrintType
  addRole :: [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roles [Either PrettyPrintType PrettyPrintType]
stack Either PrettyPrintType PrettyPrintType
pp = case Either PrettyPrintType PrettyPrintType
pp of
    Left PrettyPrintType
next -> case PrettyPrintType
next of
      PPTypeVar Text
t Maybe Text
Nothing
        | Just (Role
x, [Role]
xs) <- forall a. [a] -> Maybe (a, [a])
uncons [Role]
roles ->
          [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
xs [Either PrettyPrintType PrettyPrintType]
stack (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> PrettyPrintType
PPTypeVar Text
t (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Role -> Text
displayRole Role
x))
        | Bool
otherwise ->
          forall a. HasCallStack => String -> a
internalError String
"addRole: invalid arguments - number of roles doesn't match number of type parameters"

      PPTypeVar Text
_ (Just Text
_) ->
        forall a. HasCallStack => String -> a
internalError String
"addRole: attempted to add a second role to a type parameter that already has one"

      PPTypeApp PrettyPrintType
leftSide PrettyPrintType
rightSide -> do
        -- push right-side to stack and continue recursing on left-side
        [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roles (forall a b. a -> Either a b
Left PrettyPrintType
rightSide forall a. a -> [a] -> [a]
: [Either PrettyPrintType PrettyPrintType]
stack) (forall a b. a -> Either a b
Left PrettyPrintType
leftSide)

      PrettyPrintType
other ->
        -- nothing to check, so move on
        [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roles [Either PrettyPrintType PrettyPrintType]
stack (forall a b. b -> Either a b
Right PrettyPrintType
other)


    pendingAssembly :: Either PrettyPrintType PrettyPrintType
pendingAssembly@(Right PrettyPrintType
rightSideOrFinalValue) -> case [Either PrettyPrintType PrettyPrintType]
stack of
      (unfinishedRightSide :: Either PrettyPrintType PrettyPrintType
unfinishedRightSide@(Left PrettyPrintType
_) : [Either PrettyPrintType PrettyPrintType]
remaining) ->
        -- We've finished recursing through the left-side of a `TypeApp`.
        -- Now we'll recurse through the right-side.
        -- We push `pendingAssembly` onto the stack so we can assemble
        -- the `PPTypeApp` together once it's right-side is done.
        [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roles (Either PrettyPrintType PrettyPrintType
pendingAssembly forall a. a -> [a] -> [a]
: [Either PrettyPrintType PrettyPrintType]
remaining) Either PrettyPrintType PrettyPrintType
unfinishedRightSide

      (Right PrettyPrintType
leftSide : [Either PrettyPrintType PrettyPrintType]
remaining) ->
        -- We've finished recursing through the right-side of a `TypeApp`
        -- We'll rebulid it and wrap it in `Right` so any other higher-level
        -- `TypeApp`s can be reassembled now, too.
        [Role]
-> [Either PrettyPrintType PrettyPrintType]
-> Either PrettyPrintType PrettyPrintType
-> PrettyPrintType
addRole [Role]
roles [Either PrettyPrintType PrettyPrintType]
remaining (forall a b. b -> Either a b
Right (PrettyPrintType -> PrettyPrintType -> PrettyPrintType
PPTypeApp PrettyPrintType
leftSide PrettyPrintType
rightSideOrFinalValue))

      [] ->
        -- We've reassembled everything. It's time to return.
        PrettyPrintType
rightSideOrFinalValue

renderType' :: PrettyPrintType -> RenderedCode
renderType' :: PrettyPrintType -> RenderedCode
renderType'
  = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Incomplete pattern")
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u a b. Pattern u a b -> u -> a -> Maybe b
PA.pattern Pattern () PrettyPrintType RenderedCode
matchType ()

renderTypeVars :: [(TypeVarVisibility, Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars :: [(TypeVarVisibility, Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars [(TypeVarVisibility, Text, Maybe PrettyPrintType)]
tyVars = forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp (forall a b. (a -> b) -> [a] -> [b]
map (TypeVarVisibility, Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar [(TypeVarVisibility, Text, Maybe PrettyPrintType)]
tyVars)

renderTypeVar :: (TypeVarVisibility, Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar :: (TypeVarVisibility, Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar (TypeVarVisibility
vis, Text
v, Maybe PrettyPrintType
mbK) = case Maybe PrettyPrintType
mbK of
  Maybe PrettyPrintType
Nothing -> Text -> RenderedCode
syntax (TypeVarVisibility -> Text
typeVarVisibilityPrefix TypeVarVisibility
vis) forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
typeVar Text
v
  Just PrettyPrintType
k -> forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp [ forall a. Monoid a => [a] -> a
mconcat [Text -> RenderedCode
syntax Text
"(", Text -> RenderedCode
syntax forall a b. (a -> b) -> a -> b
$ TypeVarVisibility -> Text
typeVarVisibilityPrefix TypeVarVisibility
vis, Text -> RenderedCode
typeVar Text
v], Text -> RenderedCode
syntax Text
"::", forall a. Monoid a => [a] -> a
mconcat [PrettyPrintType -> RenderedCode
renderType' PrettyPrintType
k, Text -> RenderedCode
syntax Text
")"] ]

-- |
-- Render code representing a Type, as it should appear inside parentheses
--
renderTypeAtom :: Type a -> RenderedCode
renderTypeAtom :: forall a. Type a -> RenderedCode
renderTypeAtom = PrettyPrintType -> RenderedCode
renderTypeAtom' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Type a -> PrettyPrintType
convertPrettyPrintType forall a. Bounded a => a
maxBound

renderTypeAtom' :: PrettyPrintType -> RenderedCode
renderTypeAtom' :: PrettyPrintType -> RenderedCode
renderTypeAtom'
  = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Incomplete pattern")
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u a b. Pattern u a b -> u -> a -> Maybe b
PA.pattern Pattern () PrettyPrintType RenderedCode
matchTypeAtom ()