{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Unison.Syntax.TypePrinter
  ( pretty,
    pretty0,
    prettyRaw,
    prettyStr,
    prettySyntax,
    prettySignaturesST,
    prettySignaturesCT,
    prettySignaturesCTCollapsed,
    prettySignaturesAlt,
    prettySignaturesAlt',
    runPretty,
  )
where

import Control.Monad.Reader (ask)
import Data.Map qualified as Map
import Unison.Builtin.Decls qualified as DD
import Unison.HashQualified (HashQualified)
import Unison.Name (Name)
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.PrettyPrintEnv qualified as PrettyPrintEnv
import Unison.PrettyPrintEnv.FQN (Imports, elideFQN)
import Unison.PrettyPrintEnv.MonadPretty (Env (..), MonadPretty, runPretty, willCaptureType)
import Unison.Reference (Reference, pattern Builtin)
import Unison.Referent (Referent)
import Unison.Settings qualified as Settings
import Unison.Syntax.NamePrinter (styleHashQualified'')
import Unison.Type
import Unison.Util.ColorText (toPlain)
import Unison.Util.Pretty (ColorText, Pretty, Width)
import Unison.Util.Pretty qualified as PP
import Unison.Util.SyntaxText qualified as S
import Unison.Var (Var)
import Unison.Var qualified as Var

type SyntaxText = S.SyntaxText' Reference

pretty :: (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
pretty :: forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
pretty PrettyPrintEnv
ppe Type v a
t = Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
PP.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> Pretty (SyntaxText' Reference) -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' Reference)
prettySyntax PrettyPrintEnv
ppe Type v a
t

prettySyntax :: (Var v) => PrettyPrintEnv -> Type v a -> Pretty SyntaxText
prettySyntax :: forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' Reference)
prettySyntax PrettyPrintEnv
ppe = PrettyPrintEnv
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
ppe (Reader (Env v) (Pretty (SyntaxText' Reference))
 -> Pretty (SyntaxText' Reference))
-> (Type v a -> Reader (Env v) (Pretty (SyntaxText' Reference)))
-> Type v a
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports
-> Int
-> Type v a
-> Reader (Env v) (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
forall k a. Map k a
Map.empty (-Int
1)

prettyStr :: (Var v) => Maybe Width -> PrettyPrintEnv -> Type v a -> String
prettyStr :: forall v a.
Var v =>
Maybe Width -> PrettyPrintEnv -> Type v a -> String
prettyStr (Just Width
width) PrettyPrintEnv
ppe Type v a
t =
  ColorText -> String
toPlain (ColorText -> String)
-> (Reader (Env v) (Pretty (SyntaxText' Reference)) -> ColorText)
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
PP.render Width
width (Pretty ColorText -> ColorText)
-> (Reader (Env v) (Pretty (SyntaxText' Reference))
    -> Pretty ColorText)
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
PP.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> (Reader (Env v) (Pretty (SyntaxText' Reference))
    -> Pretty (SyntaxText' Reference))
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
ppe (Reader (Env v) (Pretty (SyntaxText' Reference)) -> String)
-> Reader (Env v) (Pretty (SyntaxText' Reference)) -> String
forall a b. (a -> b) -> a -> b
$ Imports
-> Int
-> Type v a
-> Reader (Env v) (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
forall k a. Map k a
Map.empty (-Int
1) Type v a
t
prettyStr Maybe Width
Nothing PrettyPrintEnv
ppe Type v a
t =
  ColorText -> String
toPlain (ColorText -> String)
-> (Reader (Env v) (Pretty (SyntaxText' Reference)) -> ColorText)
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
PP.render Width
forall a. Bounded a => a
maxBound (Pretty ColorText -> ColorText)
-> (Reader (Env v) (Pretty (SyntaxText' Reference))
    -> Pretty ColorText)
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
PP.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> (Reader (Env v) (Pretty (SyntaxText' Reference))
    -> Pretty (SyntaxText' Reference))
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reader (Env v) (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
ppe (Reader (Env v) (Pretty (SyntaxText' Reference)) -> String)
-> Reader (Env v) (Pretty (SyntaxText' Reference)) -> String
forall a b. (a -> b) -> a -> b
$ Imports
-> Int
-> Type v a
-> Reader (Env v) (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
forall k a. Map k a
Map.empty (-Int
1) Type v a
t

{- Explanation of precedence handling

   We illustrate precedence rules as follows.

     >=10
       10f 10x

   This example shows that a type application f x is enclosed in parentheses
   whenever the ambient precedence around it is >= 10, and that when printing
   its two components, an ambient precedence of 10 is used in both places.

   The pretty-printer uses the following rules for printing types.

     >=10
       10f 10x
       { 0e } 10t

     >=0
       0a -> 0b

-}

pretty0 ::
  forall v a m.
  (MonadPretty v m) =>
  Imports ->
  Int ->
  Type v a ->
  m (Pretty SyntaxText)
pretty0 :: forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
im Int
p Type v a
tp = Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
prettyRaw Imports
im Int
p (Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
removeEmptyEffects (Type v a -> Type v a) -> Type v a -> Type v a
forall a b. (a -> b) -> a -> b
$ Type v a -> Type v a
forall v a. Var v => Type v a -> Type v a
cleanup Type v a
tp)

prettyRaw ::
  forall v a m.
  (MonadPretty v m) =>
  Imports ->
  Int ->
  Type v a ->
  m (Pretty SyntaxText)
-- p is the operator precedence of the enclosing context (a number from 0 to
-- 11, or -1 to avoid outer parentheses unconditionally).  Function
-- application has precedence 10.
prettyRaw :: forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
prettyRaw Imports
im Int
p Type v a
tp = Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
p Type v a
tp
  where
    go :: Imports -> Int -> Type v a -> m (Pretty SyntaxText)
    go :: Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
p Type v a
tp = case Type v a -> Type v a
forall v a. Type v a -> Type v a
stripIntroOuters Type v a
tp of
      Var' v
v -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.Var (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ Text -> Pretty (SyntaxText' Reference)
forall s. IsString s => Text -> Pretty s
PP.text (v -> Text
forall v. Var v => v -> Text
Var.name v
v)
      DD.TupleType' [Type v a]
xs | [Type v a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type v a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 -> [Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.parenthesizeCommas ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> m [Pretty (SyntaxText' Reference)]
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type v a -> m (Pretty (SyntaxText' Reference)))
-> [Type v a] -> m [Pretty (SyntaxText' Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
0) [Type v a]
xs
      -- Would be nice to use a different SyntaxHighlights color if the reference is an ability.
      Ref' Reference
r -> do
        Env v
env <- m (Env v)
forall r (m :: * -> *). MonadReader r m => m r
ask
        pure $ (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ Reference -> Element Reference
forall r. r -> Element r
S.TypeReference Reference
r) (HashQualified Name -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ Imports -> HashQualified Name -> HashQualified Name
elideFQN Imports
im (PrettyPrintEnv -> Reference -> HashQualified Name
PrettyPrintEnv.typeName Env v
env.ppe Reference
r)
      Cycle' [v]
_ F (Type v a)
_ -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ String -> Pretty (SyntaxText' Reference)
forall a. IsString a => String -> a
fromString String
"bug: TypeParser does not currently emit Cycle"
      Abs' Subst F v a
_ -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ String -> Pretty (SyntaxText' Reference)
forall a. IsString a => String -> a
fromString String
"bug: TypeParser does not currently emit Abs"
      Ann' Type v a
_ Kind
_ -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ String -> Pretty (SyntaxText' Reference)
forall a. IsString a => String -> a
fromString String
"bug: TypeParser does not currently emit Ann"
      App' (Ref' (Builtin Text
"Sequence")) Type v a
x -> do
        Pretty (SyntaxText' Reference)
x' <- Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im (-Int
1) Type v a
x
        pure $ Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
PP.group (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar Pretty (SyntaxText' Reference)
"[" Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
x' Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar Pretty (SyntaxText' Reference)
"]"
      Apps' Type v a
f [Type v a]
xs ->
        Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. IsString s => Bool -> Pretty s -> Pretty s
PP.parenthesizeIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10)
          (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
PP.hang (Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference)
      -> Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
9 Type v a
f m (Pretty (SyntaxText' Reference)
   -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.spaced ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> m [Pretty (SyntaxText' Reference)]
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type v a -> m (Pretty (SyntaxText' Reference)))
-> [Type v a] -> m [Pretty (SyntaxText' Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
10) [Type v a]
xs)
              )
      Effect1' Type v a
e Type v a
t ->
        Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. IsString s => Bool -> Pretty s -> Pretty s
PP.parenthesizeIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Pretty (SyntaxText' Reference)
x Pretty (SyntaxText' Reference)
y -> Pretty (SyntaxText' Reference)
x Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
" " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
y) (Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference)
      -> Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
9 Type v a
e m (Pretty (SyntaxText' Reference)
   -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
10 Type v a
t)
      Effects' [Type v a]
es -> Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
effects ([Type v a] -> Maybe [Type v a]
forall a. a -> Maybe a
Just [Type v a]
es)
      ForallsNamed' [v]
vs' Type v a
body ->
        let vs :: [v]
vs = (v -> Bool) -> [v] -> [v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\v
v -> v -> Text
forall v. Var v => v -> Text
Var.name v
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"()") [v]
vs'
            prettyForall :: Int -> m (Pretty (SyntaxText' Reference))
prettyForall Int
p = do
              let vformatted :: Pretty (SyntaxText' Reference)
vformatted = Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
PP.sep Pretty (SyntaxText' Reference)
" " (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.Var (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (v -> Pretty (SyntaxText' Reference))
-> v
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty (SyntaxText' Reference)
forall s. IsString s => Text -> Pretty s
PP.text (Text -> Pretty (SyntaxText' Reference))
-> (v -> Text) -> v -> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name (v -> Pretty (SyntaxText' Reference))
-> [v] -> [Pretty (SyntaxText' Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs)
              Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
PP.hang (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.TypeOperator Pretty (SyntaxText' Reference)
"∀ " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
vformatted Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.TypeOperator Pretty (SyntaxText' Reference)
".") (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
p Type v a
body
         in -- if we're printing a type signature, and all the type variables
            -- are universally quantified, then we can omit the `forall` keyword
            -- only if the type variables are not bound in an outer scope
            if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
Settings.debugRevealForalls Bool -> Bool -> Bool
&& (v -> Bool) -> [v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all v -> Bool
forall v. Var v => v -> Bool
Var.universallyQuantifyIfFree [v]
vs
              then m Bool
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ([v] -> m Bool
forall v (m :: * -> *). MonadPretty v m => [v] -> m Bool
willCaptureType [v]
vs) (Int -> m (Pretty (SyntaxText' Reference))
prettyForall Int
p) (Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
p Type v a
body)
              else Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall {r}.
Bool -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
paren (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (Pretty (SyntaxText' Reference))
prettyForall (-Int
1)
      t :: Type v a
t@(Arrow' Type v a
_ Type v a
_) -> case Type v a
t of
        EffectfulArrows' (Ref' Reference
DD.UnitRef) [(Maybe [Type v a], Type v a)]
rest ->
          Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. IsString s => Bool -> Pretty s -> Pretty s
PP.parenthesizeIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
True Bool
True [(Maybe [Type v a], Type v a)]
rest
        EffectfulArrows' Type v a
fst [(Maybe [Type v a], Type v a)]
rest ->
          case Type v a
fst of
            Var' v
v
              | v -> Text
forall v. Var v => v -> Text
Var.name v
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"()" ->
                  Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. IsString s => Bool -> Pretty s -> Pretty s
PP.parenthesizeIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
True Bool
True [(Maybe [Type v a], Type v a)]
rest
            Type v a
_ ->
              Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. IsString s => Bool -> Pretty s -> Pretty s
PP.parenthesizeIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
(<>) (Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference)
      -> Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
0 Type v a
fst m (Pretty (SyntaxText' Reference)
   -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
False Bool
False [(Maybe [Type v a], Type v a)]
rest)
        Type v a
_ -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> (String -> Pretty (SyntaxText' Reference))
-> String
-> m (Pretty (SyntaxText' Reference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty (SyntaxText' Reference)
forall a. IsString a => String -> a
fromString (String -> m (Pretty (SyntaxText' Reference)))
-> String -> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ String
"bug: unexpected Arrow form in prettyRaw: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type v a -> String
forall a. Show a => a -> String
show Type v a
t
      Type v a
_ -> Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> m (Pretty (SyntaxText' Reference)))
-> (String -> Pretty (SyntaxText' Reference))
-> String
-> m (Pretty (SyntaxText' Reference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty (SyntaxText' Reference)
forall a. IsString a => String -> a
fromString (String -> m (Pretty (SyntaxText' Reference)))
-> String -> m (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ String
"bug: unexpected form in prettyRaw: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type v a -> String
forall a. Show a => a -> String
show Type v a
tp
    effects :: Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
effects Maybe [Type v a]
Nothing = Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty
    effects (Just [Type v a]
es) =
      Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
PP.group (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.AbilityBraces Pretty (SyntaxText' Reference)
"{" Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<>) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.AbilityBraces Pretty (SyntaxText' Reference)
"}")
        (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.commas ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> m [Pretty (SyntaxText' Reference)]
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type v a -> m (Pretty (SyntaxText' Reference)))
-> [Type v a] -> m [Pretty (SyntaxText' Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
0) [Type v a]
es)
    -- `first`: is this the first argument?
    -- `mes`: list of effects
    arrow :: Bool
-> Bool -> Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
arrow Bool
delay Bool
first Maybe [Type v a]
mes = do
      Pretty (SyntaxText' Reference)
es <- Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
effects Maybe [Type v a]
mes
      pure $
        (if Bool
first then Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty else Pretty (SyntaxText' Reference)
forall s. IsString s => Pretty s
PP.softbreak Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.TypeOperator Pretty (SyntaxText' Reference)
"->")
          Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> (if Bool
delay then (if Bool
first then Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelayForceChar Pretty (SyntaxText' Reference)
"'" else Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelayForceChar Pretty (SyntaxText' Reference)
" '") else Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty)
          Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
es
          Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> if Maybe [Type v a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Type v a]
mes Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
delay Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
first then Pretty (SyntaxText' Reference)
" " else Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty

    arrows ::
      Bool ->
      Bool ->
      [(Maybe [Type v a], Type v a)] ->
      m (Pretty SyntaxText)
    arrows :: Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
delay Bool
first [(Maybe [Type v a]
mes, Ref' Reference
DD.UnitRef)] = (Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.Unit Pretty (SyntaxText' Reference)
"()") (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
-> m (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool -> Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
arrow Bool
delay Bool
first Maybe [Type v a]
mes
    arrows Bool
delay Bool
first ((Maybe [Type v a]
mes, Ref' Reference
DD.UnitRef) : [(Maybe [Type v a], Type v a)]
rest) = do
      Pretty (SyntaxText' Reference)
es <- Bool
-> Bool -> Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
arrow Bool
delay Bool
first Maybe [Type v a]
mes
      Pretty (SyntaxText' Reference)
rest' <- Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
True Bool
True [(Maybe [Type v a], Type v a)]
rest
      pure $ Pretty (SyntaxText' Reference)
es Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall {r}.
Bool -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
parenNoGroup Bool
delay Pretty (SyntaxText' Reference)
rest'
    arrows Bool
delay Bool
first ((Maybe [Type v a]
mes, Type v a
arg) : [(Maybe [Type v a], Type v a)]
rest) = do
      Pretty (SyntaxText' Reference)
es <- Bool
-> Bool -> Maybe [Type v a] -> m (Pretty (SyntaxText' Reference))
arrow Bool
delay Bool
first Maybe [Type v a]
mes
      Pretty (SyntaxText' Reference)
arg' <- Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
go Imports
im Int
0 Type v a
arg
      Pretty (SyntaxText' Reference)
rest' <- Bool
-> Bool
-> [(Maybe [Type v a], Type v a)]
-> m (Pretty (SyntaxText' Reference))
arrows Bool
False Bool
False [(Maybe [Type v a], Type v a)]
rest
      pure $ Pretty (SyntaxText' Reference)
es Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Bool
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall {r}.
Bool -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
parenNoGroup (Bool
delay Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Maybe [Type v a], Type v a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe [Type v a], Type v a)]
rest)) (Pretty (SyntaxText' Reference)
arg' Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
rest')
    arrows Bool
False Bool
False [] = Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty
    arrows Bool
False Bool
True [] = Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty -- not reachable
    arrows Bool
True Bool
_ [] = Pretty (SyntaxText' Reference)
-> m (Pretty (SyntaxText' Reference))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty -- not reachable
    paren :: Bool -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
paren Bool
True Pretty (SyntaxText' r)
s = Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall s. Pretty s -> Pretty s
PP.group (Pretty (SyntaxText' r) -> Pretty (SyntaxText' r))
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a b. (a -> b) -> a -> b
$ Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.Parenthesis Pretty (SyntaxText' r)
"(" Pretty (SyntaxText' r)
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' r)
s Pretty (SyntaxText' r)
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a. Semigroup a => a -> a -> a
<> Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.Parenthesis Pretty (SyntaxText' r)
")"
    paren Bool
False Pretty (SyntaxText' r)
s = Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall s. Pretty s -> Pretty s
PP.group Pretty (SyntaxText' r)
s

    parenNoGroup :: Bool -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
parenNoGroup Bool
True Pretty (SyntaxText' r)
s = Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.Parenthesis Pretty (SyntaxText' r)
"(" Pretty (SyntaxText' r)
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' r)
s Pretty (SyntaxText' r)
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a. Semigroup a => a -> a -> a
<> Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.Parenthesis Pretty (SyntaxText' r)
")"
    parenNoGroup Bool
False Pretty (SyntaxText' r)
s = Pretty (SyntaxText' r)
s

fmt :: S.Element r -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r)
fmt :: forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt = Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
PP.withSyntax

-- todo: provide sample output in comment
prettySignaturesCT ::
  (Var v) =>
  PrettyPrintEnv ->
  [(Referent, HashQualified Name, Type v a)] ->
  [Pretty ColorText]
prettySignaturesCT :: forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> [Pretty ColorText]
prettySignaturesCT PrettyPrintEnv
ppe [(Referent, HashQualified Name, Type v a)]
ts = (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> [Pretty (SyntaxText' Reference)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
PP.syntaxToColor ([Pretty (SyntaxText' Reference)] -> [Pretty ColorText])
-> [Pretty (SyntaxText' Reference)] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)]
-> [Pretty (SyntaxText' Reference)]
forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)]
-> [Pretty (SyntaxText' Reference)]
prettySignaturesST PrettyPrintEnv
ppe [(Referent, HashQualified Name, Type v a)]
ts

prettySignaturesCTCollapsed ::
  (Var v) =>
  PrettyPrintEnv ->
  [(Referent, HashQualified Name, Type v a)] ->
  Pretty ColorText
prettySignaturesCTCollapsed :: forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> Pretty ColorText
prettySignaturesCTCollapsed PrettyPrintEnv
ppe [(Referent, HashQualified Name, Type v a)]
ts =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.lines
    ([Pretty ColorText] -> Pretty ColorText)
-> ([Pretty ColorText] -> [Pretty ColorText])
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
PP.group
    ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> [Pretty ColorText]
forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> [Pretty ColorText]
prettySignaturesCT PrettyPrintEnv
ppe [(Referent, HashQualified Name, Type v a)]
ts

prettySignaturesST ::
  (Var v) =>
  PrettyPrintEnv ->
  [(Referent, HashQualified Name, Type v a)] ->
  [Pretty SyntaxText]
prettySignaturesST :: forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)]
-> [Pretty (SyntaxText' Reference)]
prettySignaturesST PrettyPrintEnv
ppe [(Referent, HashQualified Name, Type v a)]
ts =
  [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
-> [Pretty (SyntaxText' Reference)]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
PP.align ([(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
 -> [Pretty (SyntaxText' Reference)])
-> (Reader
      (Env v)
      [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
    -> [(Pretty (SyntaxText' Reference),
         Pretty (SyntaxText' Reference))])
-> Reader
     (Env v)
     [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
-> [Pretty (SyntaxText' Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reader
     (Env v)
     [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
-> [(Pretty (SyntaxText' Reference),
     Pretty (SyntaxText' Reference))]
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
ppe (Reader
   (Env v)
   [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
 -> [Pretty (SyntaxText' Reference)])
-> Reader
     (Env v)
     [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
-> [Pretty (SyntaxText' Reference)]
forall a b. (a -> b) -> a -> b
$ ((Referent, HashQualified Name, Type v a)
 -> ReaderT
      (Env v)
      Identity
      (Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference)))
-> [(Referent, HashQualified Name, Type v a)]
-> Reader
     (Env v)
     [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Referent
r, HashQualified Name
hq, Type v a
typ) -> (Referent -> HashQualified Name -> Pretty (SyntaxText' Reference)
name Referent
r HashQualified Name
hq,) (Pretty (SyntaxText' Reference)
 -> (Pretty (SyntaxText' Reference),
     Pretty (SyntaxText' Reference)))
-> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference))
-> ReaderT
     (Env v)
     Identity
     (Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v a
-> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference))
forall {f :: * -> *} {v} {a}.
(Var v, MonadReader (Env v) f) =>
Type v a -> f (Pretty (SyntaxText' Reference))
sig Type v a
typ) [(Referent, HashQualified Name, Type v a)]
ts
  where
    name :: Referent -> HashQualified Name -> Pretty (SyntaxText' Reference)
name Referent
r HashQualified Name
hq =
      (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ Referent -> Element Reference
forall r. Referent' r -> Element r
S.TermReference Referent
r) HashQualified Name
hq
    sig :: Type v a -> f (Pretty (SyntaxText' Reference))
sig Type v a
typ = do
      Pretty (SyntaxText' Reference)
t <- Imports -> Int -> Type v a -> f (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
forall k a. Map k a
Map.empty (-Int
1) Type v a
typ
      let col :: Pretty (SyntaxText' r)
col = Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.TypeAscriptionColon Pretty (SyntaxText' r)
": "
      pure $ (Pretty (SyntaxText' Reference)
col Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
t) Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s -> Pretty s
`PP.orElse` (Pretty (SyntaxText' Reference)
col Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Width
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
PP.indentNAfterNewline Width
2 Pretty (SyntaxText' Reference)
t)

-- todo: provide sample output in comment; different from prettySignatures'
prettySignaturesAlt' ::
  (Var v) =>
  PrettyPrintEnv ->
  [([HashQualified Name], Type v a)] ->
  [Pretty ColorText]
prettySignaturesAlt' :: forall v a.
Var v =>
PrettyPrintEnv
-> [([HashQualified Name], Type v a)] -> [Pretty ColorText]
prettySignaturesAlt' PrettyPrintEnv
ppe [([HashQualified Name], Type v a)]
ts = PrettyPrintEnv
-> Reader (Env v) [Pretty ColorText] -> [Pretty ColorText]
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
ppe (Reader (Env v) [Pretty ColorText] -> [Pretty ColorText])
-> Reader (Env v) [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$
  do
    [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
ts' <- (([HashQualified Name], Type v a)
 -> ReaderT
      (Env v)
      Identity
      (Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference)))
-> [([HashQualified Name], Type v a)]
-> ReaderT
     (Env v)
     Identity
     [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([HashQualified Name], Type v a)
-> ReaderT
     (Env v)
     Identity
     (Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))
forall v (m :: * -> *) a.
MonadPretty v m =>
([HashQualified Name], Type v a)
-> m (Pretty (SyntaxText' Reference),
      Pretty (SyntaxText' Reference))
f [([HashQualified Name], Type v a)]
ts
    pure $ (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> [Pretty (SyntaxText' Reference)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
PP.syntaxToColor ([Pretty (SyntaxText' Reference)] -> [Pretty ColorText])
-> [Pretty (SyntaxText' Reference)] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
-> [Pretty (SyntaxText' Reference)]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
PP.align [(Pretty (SyntaxText' Reference), Pretty (SyntaxText' Reference))]
ts'
  where
    f :: (MonadPretty v m) => ([HashQualified Name], Type v a) -> m (Pretty SyntaxText, Pretty SyntaxText)
    f :: forall v (m :: * -> *) a.
MonadPretty v m =>
([HashQualified Name], Type v a)
-> m (Pretty (SyntaxText' Reference),
      Pretty (SyntaxText' Reference))
f ([HashQualified Name]
names, Type v a
typ) = do
      Pretty (SyntaxText' Reference)
typ' <- Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
pretty0 Imports
forall k a. Map k a
Map.empty (-Int
1) Type v a
typ
      let col :: Pretty (SyntaxText' r)
col = Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element r
forall r. Element r
S.TypeAscriptionColon Pretty (SyntaxText' r)
": "
      pure
        ( [Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.commas ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> ([HashQualified Name] -> [Pretty (SyntaxText' Reference)])
-> [HashQualified Name]
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> Pretty (SyntaxText' Reference))
-> [HashQualified Name] -> [Pretty (SyntaxText' Reference)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HashQualified Name
name -> (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Element Reference
forall r. HashQualified Name -> Element r
S.HashQualifier HashQualified Name
name) HashQualified Name
name) ([HashQualified Name] -> Pretty (SyntaxText' Reference))
-> [HashQualified Name] -> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ [HashQualified Name]
names,
          (Pretty (SyntaxText' Reference)
col Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
typ') Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s -> Pretty s
`PP.orElse` (Pretty (SyntaxText' Reference)
col Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Width
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
PP.indentNAfterNewline Width
2 Pretty (SyntaxText' Reference)
typ')
        )

-- prettySignatures'' :: Var v => [(Name, Type v a)] -> [Pretty ColorText]
-- prettySignatures'' env ts = prettySignatures' env (first HQ.fromName <$> ts)

prettySignaturesAlt ::
  (Var v) =>
  PrettyPrintEnv ->
  [([HashQualified Name], Type v a)] ->
  Pretty ColorText
prettySignaturesAlt :: forall v a.
Var v =>
PrettyPrintEnv
-> [([HashQualified Name], Type v a)] -> Pretty ColorText
prettySignaturesAlt PrettyPrintEnv
ppe [([HashQualified Name], Type v a)]
ts =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
PP.lines
    ([Pretty ColorText] -> Pretty ColorText)
-> ([Pretty ColorText] -> [Pretty ColorText])
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
PP.group
    ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> [([HashQualified Name], Type v a)] -> [Pretty ColorText]
forall v a.
Var v =>
PrettyPrintEnv
-> [([HashQualified Name], Type v a)] -> [Pretty ColorText]
prettySignaturesAlt' PrettyPrintEnv
ppe [([HashQualified Name], Type v a)]
ts