-- 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
import Language.PureScript.Label
import Language.PureScript.Names
import Language.PureScript.Pretty.Types
import Language.PureScript.Roles
import Language.PureScript.Types
import Language.PureScript.PSString (prettyPrintString)

import Language.PureScript.Docs.RenderedCode.Types
import Language.PureScript.Docs.Utils.MonoidExtras

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
  ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
forall_ forall a b. (a -> b) -> a -> b
$ \[(Text, Maybe PrettyPrintType)]
tyVars RenderedCode
ty -> forall a. Monoid a => [a] -> a
mconcat [ RenderedCode
keywordForall, RenderedCode
sp, [(Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars [(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 ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
forall_ :: Pattern
  ()
  PrettyPrintType
  ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
forall_ = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern PrettyPrintType
-> Maybe ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
match
  where
  match :: PrettyPrintType
-> Maybe ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
match (PPForAll [(Text, Maybe PrettyPrintType)]
mbKindedIdents PrettyPrintType
ty) = forall a. a -> Maybe a
Just ([(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 :: [(Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars :: [(Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars [(Text, Maybe PrettyPrintType)]
tyVars = forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp (forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar [(Text, Maybe PrettyPrintType)]
tyVars)

renderTypeVar :: (Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar :: (Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar (Text
v, Maybe PrettyPrintType
mbK) = case Maybe PrettyPrintType
mbK of
  Maybe PrettyPrintType
Nothing -> 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
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 ()