{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.CommandLine.DisplayValues where

import Data.Map qualified as Map
import Unison.ABT qualified as ABT
import Unison.Builtin qualified as Builtin
import Unison.Builtin.Decls qualified as DD
import Unison.Codebase.Editor.DisplayObject qualified as DO
import Unison.CommandLine.OutputMessages qualified as OutputMessages
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration qualified as DD
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Util qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPE
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Runtime.IOSource qualified as DD
import Unison.Symbol (Symbol)
import Unison.Syntax.DeclPrinter qualified as DP
import Unison.Syntax.NamePrinter qualified as NP
import Unison.Syntax.TermPrinter qualified as TP
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Util.Pretty qualified as P
import Unison.Util.SyntaxText qualified as S
import Unison.Var (Var)

type Pretty = P.Pretty P.ColorText

displayTerm ::
  (Monad m) =>
  PPE.PrettyPrintEnvDecl ->
  (Reference -> m (Maybe (Term Symbol ()))) ->
  (Referent -> m (Maybe (Type Symbol ()))) ->
  (Term Symbol () -> m (Maybe (Term Symbol ()))) ->
  (Reference -> m (Maybe (DD.Decl Symbol ()))) ->
  Term Symbol () ->
  m Pretty
displayTerm :: forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm = ElideUnit
-> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
ElideUnit
-> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm' ElideUnit
False

-- Whether to elide printing of `()` at the end of a block
-- For instance, in:
--
--   id x = x
--   ()
--
-- We could render it as above, with the `()` explicit, or just as:
--
--   id x = x
--
type ElideUnit = Bool

displayTerm' ::
  (Monad m) =>
  ElideUnit ->
  PPE.PrettyPrintEnvDecl ->
  (Reference -> m (Maybe (Term Symbol ()))) ->
  (Referent -> m (Maybe (Type Symbol ()))) ->
  (Term Symbol () -> m (Maybe (Term Symbol ()))) ->
  (Reference -> m (Maybe (DD.Decl Symbol ()))) ->
  Term Symbol () ->
  m Pretty
displayTerm' :: forall (m :: * -> *).
Monad m =>
ElideUnit
-> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm' ElideUnit
elideUnit PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types = \case
  tm :: Term Symbol ()
tm@(Term.Apps' (Term.Constructor' (ConstructorReference Reference
typ ConstructorId
_)) [Term Symbol ()]
_)
    | Reference
typ Reference -> Reference -> ElideUnit
forall a. Eq a => a -> a -> ElideUnit
== Reference
DD.docRef -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall v (m :: * -> *).
(Var v, Monad m) =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term v ())))
-> (Referent -> m (Maybe (Type v ())))
-> (Term v () -> m (Maybe (Term v ())))
-> (Reference -> m (Maybe (Decl v ())))
-> Term v ()
-> m Pretty
displayDoc PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
    | Reference
typ Reference -> Reference -> ElideUnit
forall a. Eq a => a -> a -> ElideUnit
== Reference
DD.doc2Ref -> do
        -- Pretty.get (doc.formatConsole tm)
        let tm' :: Term Symbol ()
tm' =
              () -> Term Symbol () -> Term Symbol () -> Term Symbol ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app
                ()
                (() -> Reference -> Term Symbol ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
Term.ref () Reference
DD.prettyGetRef)
                (() -> Term Symbol () -> Term Symbol () -> Term Symbol ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app () (() -> Reference -> Term Symbol ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
Term.ref () Reference
DD.doc2FormatConsoleRef) Term Symbol ()
tm)
        Maybe (Term Symbol ())
tm <- Term Symbol () -> m (Maybe (Term Symbol ()))
eval Term Symbol ()
tm'
        case Maybe (Term Symbol ())
tm of
          Maybe (Term Symbol ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Term Symbol () -> Pretty
errMsg Term Symbol ()
tm'
          Just Term Symbol ()
tm -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
    | Reference
typ Reference -> Reference -> ElideUnit
forall a. Eq a => a -> a -> ElideUnit
== Reference
DD.prettyAnnotatedRef -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayPretty PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
  tm :: Term Symbol ()
tm@(Term.Constructor' (ConstructorReference Reference
typ ConstructorId
_))
    | Reference
typ Reference -> Reference -> ElideUnit
forall a. Eq a => a -> a -> ElideUnit
== Reference
DD.prettyAnnotatedRef -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayPretty PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
  Term Symbol ()
tm -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Term Symbol () -> Pretty
src Term Symbol ()
tm
  where
    errMsg :: Term Symbol () -> Pretty
errMsg Term Symbol ()
tm =
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty
"I couldn't render this document, because the"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"rendering function produced an error when"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"evaluating this expression:",
            Pretty
"",
            Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Term Symbol () -> Pretty
src Term Symbol ()
tm,
            Pretty
"",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty
"Sadly, I don't know the error, but you can evaluate"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the above expression in a scratch file to see it."
          ]
    src :: Term Symbol () -> Pretty
src Term Symbol ()
tm = ElideUnit -> PrettyPrintEnv -> Term Symbol () -> Pretty
forall v a.
Var v =>
ElideUnit -> PrettyPrintEnv -> Term v a -> Pretty
TP.prettyBlock ElideUnit
elideUnit (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Term Symbol ()
tm

-- assume this is given a
-- Pretty.Annotated ann (Either SpecialForm ConsoleText)
displayPretty ::
  forall m.
  (Monad m) =>
  PPE.PrettyPrintEnvDecl ->
  (Reference -> m (Maybe (Term Symbol ()))) ->
  (Referent -> m (Maybe (Type Symbol ()))) ->
  (Term Symbol () -> m (Maybe (Term Symbol ()))) ->
  (Reference -> m (Maybe (DD.Decl Symbol ()))) ->
  Term Symbol () ->
  m Pretty
displayPretty :: forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayPretty PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm = Term Symbol () -> m Pretty
go Term Symbol ()
tm
  where
    go :: Term Symbol () -> m Pretty
go = \case
      Term Symbol ()
DD.PrettyEmpty -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
      DD.PrettyGroup Term Symbol ()
_ Term Symbol ()
p -> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
go Term Symbol ()
p
      DD.PrettyLit Term Symbol ()
_ (DD.EitherLeft' Term Symbol ()
special) -> Term Symbol () -> m Pretty
goSpecial Term Symbol ()
special
      DD.PrettyLit Term Symbol ()
_ (DD.EitherRight' Term Symbol ()
consoleTxt) -> Term Symbol () -> m Pretty
goConsole Term Symbol ()
consoleTxt
      DD.PrettyWrap Term Symbol ()
_ Term Symbol ()
p -> (ColorText -> [Pretty]) -> Pretty -> Pretty
forall s. IsString s => (s -> [Pretty s]) -> Pretty s -> Pretty s
P.wrap' (Pretty -> [Pretty]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> [Pretty])
-> (ColorText -> Pretty) -> ColorText -> [Pretty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit) (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
go Term Symbol ()
p
      DD.PrettyOrElse Term Symbol ()
_ Term Symbol ()
p1 Term Symbol ()
p2 -> Pretty -> Pretty -> Pretty
forall s. Pretty s -> Pretty s -> Pretty s
P.orElse (Pretty -> Pretty -> Pretty) -> m Pretty -> m (Pretty -> Pretty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
go Term Symbol ()
p1 m (Pretty -> Pretty) -> m Pretty -> m Pretty
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term Symbol () -> m Pretty
go Term Symbol ()
p2
      DD.PrettyIndent Term Symbol ()
_ Term Symbol ()
initial Term Symbol ()
afterNl Term Symbol ()
p -> do
        Pretty
initial <- Term Symbol () -> m Pretty
go Term Symbol ()
initial
        Pretty
afterNl <- Term Symbol () -> m Pretty
go Term Symbol ()
afterNl
        Pretty
p <- Term Symbol () -> m Pretty
go Term Symbol ()
p
        pure $ Pretty
initial Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indentAfterNewline Pretty
afterNl Pretty
p
      DD.PrettyAppend Term Symbol ()
_ Seq (Term Symbol ())
ps -> [Pretty] -> Pretty
forall a. Monoid a => [a] -> a
mconcat ([Pretty] -> Pretty)
-> (Seq Pretty -> [Pretty]) -> Seq Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Pretty -> [Pretty]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Pretty -> Pretty) -> m (Seq Pretty) -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term Symbol () -> m Pretty)
-> Seq (Term Symbol ()) -> m (Seq Pretty)
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) -> Seq a -> f (Seq b)
traverse Term Symbol () -> m Pretty
go Seq (Term Symbol ())
ps
      DD.PrettyTable Term Symbol ()
_ Seq (Term Symbol ())
rows ->
        Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty)
-> ([[Pretty]] -> Pretty) -> [[Pretty]] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pretty]] -> Pretty
forall s. (IsString s, ListLike s Char) => [[Pretty s]] -> Pretty s
P.table ([[Pretty]] -> Pretty) -> m [[Pretty]] -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term Symbol () -> m [Pretty]) -> [Term Symbol ()] -> m [[Pretty]]
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 Term Symbol () -> m [Pretty]
goRow (Seq (Term Symbol ()) -> [Term Symbol ()]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol ())
rows)
        where
          goRow :: Term Symbol () -> m [Pretty]
goRow (Term.List' Seq (Term Symbol ())
row) = (Term Symbol () -> m Pretty) -> [Term Symbol ()] -> m [Pretty]
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 Term Symbol () -> m Pretty
go (Seq (Term Symbol ()) -> [Term Symbol ()]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol ())
row)
          goRow Term Symbol ()
_ = [Pretty] -> m [Pretty]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Term Symbol ()
tm -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm

    goSrc :: Seq (Term Symbol ()) -> m Pretty
goSrc Seq (Term Symbol ())
es = do
      -- we ignore the annotations; but this could be extended later
      -- to do some ascii art rendering
      let tys :: [Reference]
tys = [Reference
ref | DD.TupleTerm' [DD.EitherLeft' (Term.TypeLink' Reference
ref), Term Symbol ()
_anns] <- Seq (Term Symbol ()) -> [Term Symbol ()]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol ())
es]
          toRef :: Term (F typeVar typeAnn patternAnn) v a -> Maybe Reference
toRef (Term.Ref' Reference
r) = Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r
          toRef (Term.RequestOrCtor' GConstructorReference Reference
r) = Reference -> Maybe Reference
forall a. a -> Maybe a
Just (GConstructorReference Reference
r GConstructorReference Reference
-> Getting Reference (GConstructorReference Reference) Reference
-> Reference
forall s a. s -> Getting a s a -> a
^. Getting Reference (GConstructorReference Reference) Reference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_)
          toRef Term (F typeVar typeAnn patternAnn) v a
_ = Maybe Reference
forall a. Maybe a
Nothing
          tms :: [Reference]
tms = [Reference
ref | DD.TupleTerm' [DD.EitherRight' (DD.Doc2Term (Term Symbol () -> Maybe Reference
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Maybe Reference
toRef -> Just Reference
ref)), Term Symbol ()
_anns] <- Seq (Term Symbol ()) -> [Term Symbol ()]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol ())
es]
      Map Reference (DisplayObject () (Decl Symbol ()))
typeMap <-
        let -- todo: populate the variable names / kind once BuiltinObject supports that
            go :: Reference -> m (Reference, DisplayObject () (Decl Symbol ()))
go ref :: Reference
ref@(Reference.Builtin Text
_) = (Reference, DisplayObject () (Decl Symbol ()))
-> m (Reference, DisplayObject () (Decl Symbol ()))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference
ref, () -> DisplayObject () (Decl Symbol ())
forall b a. b -> DisplayObject b a
DO.BuiltinObject ())
            go Reference
ref =
              (Reference
ref,) (DisplayObject () (Decl Symbol ())
 -> (Reference, DisplayObject () (Decl Symbol ())))
-> m (DisplayObject () (Decl Symbol ()))
-> m (Reference, DisplayObject () (Decl Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                Maybe (Decl Symbol ())
decl <- Reference -> m (Maybe (Decl Symbol ()))
types Reference
ref
                let missing :: DisplayObject () (Decl Symbol ())
missing = ShortHash -> DisplayObject () (Decl Symbol ())
forall b a. ShortHash -> DisplayObject b a
DO.MissingObject (Reference -> ShortHash
Reference.toShortHash Reference
ref)
                pure $ DisplayObject () (Decl Symbol ())
-> (Decl Symbol () -> DisplayObject () (Decl Symbol ()))
-> Maybe (Decl Symbol ())
-> DisplayObject () (Decl Symbol ())
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DisplayObject () (Decl Symbol ())
missing Decl Symbol () -> DisplayObject () (Decl Symbol ())
forall b a. a -> DisplayObject b a
DO.UserObject Maybe (Decl Symbol ())
decl
         in [(Reference, DisplayObject () (Decl Symbol ()))]
-> Map Reference (DisplayObject () (Decl Symbol ()))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, DisplayObject () (Decl Symbol ()))]
 -> Map Reference (DisplayObject () (Decl Symbol ())))
-> m [(Reference, DisplayObject () (Decl Symbol ()))]
-> m (Map Reference (DisplayObject () (Decl Symbol ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> m (Reference, DisplayObject () (Decl Symbol ())))
-> [Reference]
-> m [(Reference, DisplayObject () (Decl Symbol ()))]
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 Reference -> m (Reference, DisplayObject () (Decl Symbol ()))
go [Reference]
tys
      Map Reference (DisplayObject (Type Symbol ()) (Term Symbol ()))
termMap <-
        let go :: Reference
-> m (Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))
go Reference
ref =
              (Reference
ref,) (DisplayObject (Type Symbol ()) (Term Symbol ())
 -> (Reference, DisplayObject (Type Symbol ()) (Term Symbol ())))
-> m (DisplayObject (Type Symbol ()) (Term Symbol ()))
-> m (Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Reference
ref of
                Reference.Builtin Text
_ -> DisplayObject (Type Symbol ()) (Term Symbol ())
-> m (DisplayObject (Type Symbol ()) (Term Symbol ()))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayObject (Type Symbol ()) (Term Symbol ())
 -> m (DisplayObject (Type Symbol ()) (Term Symbol ())))
-> DisplayObject (Type Symbol ()) (Term Symbol ())
-> m (DisplayObject (Type Symbol ()) (Term Symbol ()))
forall a b. (a -> b) -> a -> b
$ DisplayObject (Type Symbol ()) (Term Symbol ())
-> (Type Symbol ()
    -> DisplayObject (Type Symbol ()) (Term Symbol ()))
-> Reference
-> DisplayObject (Type Symbol ()) (Term Symbol ())
forall a. a -> (Type Symbol () -> a) -> Reference -> a
Builtin.typeOf DisplayObject (Type Symbol ()) (Term Symbol ())
missing Type Symbol () -> DisplayObject (Type Symbol ()) (Term Symbol ())
forall b a. b -> DisplayObject b a
DO.BuiltinObject Reference
ref
                Reference
_ -> DisplayObject (Type Symbol ()) (Term Symbol ())
-> (Term Symbol ()
    -> DisplayObject (Type Symbol ()) (Term Symbol ()))
-> Maybe (Term Symbol ())
-> DisplayObject (Type Symbol ()) (Term Symbol ())
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DisplayObject (Type Symbol ()) (Term Symbol ())
missing Term Symbol () -> DisplayObject (Type Symbol ()) (Term Symbol ())
forall b a. a -> DisplayObject b a
DO.UserObject (Maybe (Term Symbol ())
 -> DisplayObject (Type Symbol ()) (Term Symbol ()))
-> m (Maybe (Term Symbol ()))
-> m (DisplayObject (Type Symbol ()) (Term Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> m (Maybe (Term Symbol ()))
terms Reference
ref
              where
                missing :: DisplayObject (Type Symbol ()) (Term Symbol ())
missing = ShortHash -> DisplayObject (Type Symbol ()) (Term Symbol ())
forall b a. ShortHash -> DisplayObject b a
DO.MissingObject (Reference -> ShortHash
Reference.toShortHash Reference
ref)
         in [(Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))]
-> Map Reference (DisplayObject (Type Symbol ()) (Term Symbol ()))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))]
 -> Map Reference (DisplayObject (Type Symbol ()) (Term Symbol ())))
-> m [(Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))]
-> m (Map
        Reference (DisplayObject (Type Symbol ()) (Term Symbol ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference
 -> m (Reference, DisplayObject (Type Symbol ()) (Term Symbol ())))
-> [Reference]
-> m [(Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))]
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 Reference
-> m (Reference, DisplayObject (Type Symbol ()) (Term Symbol ()))
go [Reference]
tms
      -- in docs, we use suffixed names everywhere
      let pped' :: PrettyPrintEnvDecl
pped' = PrettyPrintEnvDecl
pped {PPE.unsuffixifiedPPE = PPE.suffixifiedPPE pped}
      Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Map Reference (DisplayObject () (Decl Symbol ()))
-> Map Reference (DisplayObject (Type Symbol ()) (Term Symbol ()))
-> Pretty
forall v a1.
(Var v, Ord a1) =>
PrettyPrintEnvDecl
-> Map Reference (DisplayObject () (Decl v a1))
-> Map Reference (DisplayObject (Type v a1) (Term v a1))
-> Pretty
OutputMessages.displayDefinitions' PrettyPrintEnvDecl
pped' Map Reference (DisplayObject () (Decl Symbol ()))
typeMap Map Reference (DisplayObject (Type Symbol ()) (Term Symbol ()))
termMap

    goSpecial :: Term Symbol () -> m Pretty
goSpecial = \case
      DD.Doc2SpecialFormFoldedSource (Term.List' Seq (Term Symbol ())
es) -> Seq (Term Symbol ()) -> m Pretty
goSrc Seq (Term Symbol ())
es
      -- Source [Either Link.Type Doc2.Term]
      DD.Doc2SpecialFormSource (Term.List' Seq (Term Symbol ())
es) -> Seq (Term Symbol ()) -> m Pretty
goSrc Seq (Term Symbol ())
es
      -- Example Nat Doc2.Term
      -- Examples like `foo x y` are encoded as `Example 2 (_ x y -> foo)`, where
      -- 2 is the number of variables that should be dropped from the rendering.
      -- So this will render as `foo x y`.
      DD.Doc2SpecialFormExample ConstructorId
n (DD.Doc2Example [Symbol]
vs Term Symbol ()
body) ->
        Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
ex
        where
          ex :: Term Symbol ()
ex = () -> [Symbol] -> Term Symbol () -> Term Symbol ()
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lamWithoutBindingAnns (Term Symbol () -> ()
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol ()
body) (Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
n) [Symbol]
vs) Term Symbol ()
body
      DD.Doc2SpecialFormExampleBlock ConstructorId
n (DD.Doc2Example [Symbol]
vs Term Symbol ()
body) ->
        -- todo: maybe do something with `vs` to indicate the variables are free
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElideUnit
-> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
ElideUnit
-> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm' ElideUnit
True PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
ex
        where
          ex :: Term Symbol ()
ex = () -> [Symbol] -> Term Symbol () -> Term Symbol ()
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lamWithoutBindingAnns (Term Symbol () -> ()
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol ()
body) (Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
n) [Symbol]
vs) Term Symbol ()
body

      -- Link (Either Link.Type Doc2.Term)
      DD.Doc2SpecialFormLink Term Symbol ()
e ->
        let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
            go :: HashQualified Name -> m Pretty
go = Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty)
-> (HashQualified Name -> Pretty) -> HashQualified Name -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
P.underline (Pretty -> Pretty)
-> (HashQualified Name -> Pretty) -> HashQualified Name -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' Reference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' Reference)
NP.prettyHashQualified
         in case Term Symbol ()
e of
              DD.EitherLeft' (Term.TypeLink' Reference
ref) -> HashQualified Name -> m Pretty
go (HashQualified Name -> m Pretty) -> HashQualified Name -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe Reference
ref
              -- Eta-reduce the term, as the compiler may have eta-expanded it.
              DD.EitherRight' (DD.Doc2Term Term Symbol ()
t) -> case Term Symbol () -> Term Symbol ()
forall v. Ord v => Term0 v -> Term0 v
Term.etaNormalForm Term Symbol ()
t of
                Term.Ref' Reference
ref -> HashQualified Name -> m Pretty
go (HashQualified Name -> m Pretty) -> HashQualified Name -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (Reference -> Referent
Referent.Ref Reference
ref)
                Term.Request' GConstructorReference Reference
ref ->
                  HashQualified Name -> m Pretty
go (HashQualified Name -> m Pretty) -> HashQualified Name -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (GConstructorReference Reference -> ConstructorType -> Referent
Referent.Con GConstructorReference Reference
ref ConstructorType
CT.Effect)
                Term.Constructor' GConstructorReference Reference
ref ->
                  HashQualified Name -> m Pretty
go (HashQualified Name -> m Pretty) -> HashQualified Name -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (GConstructorReference Reference -> ConstructorType -> Referent
Referent.Con GConstructorReference Reference
ref ConstructorType
CT.Data)
                Term Symbol ()
_ -> Pretty -> Pretty
P.red (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
t
              Term Symbol ()
_ -> Pretty -> Pretty
P.red (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
e
      -- Signature [Doc2.Term]
      DD.Doc2SpecialFormSignature (Term.List' Seq (Term Symbol ())
tms) ->
        let referents :: [Referent]
referents = [Referent
r | DD.Doc2Term (Term Symbol () -> Maybe Referent
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Maybe Referent
toReferent -> Just Referent
r) <- Seq (Term Symbol ()) -> [Term Symbol ()]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol ())
tms]
            go :: Referent -> m Pretty
go Referent
r = Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referent -> m Pretty
goSignature Referent
r
         in Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n" ([Pretty] -> Pretty) -> m [Pretty] -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Referent -> m Pretty) -> [Referent] -> m [Pretty]
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 -> m Pretty
go [Referent]
referents
      -- SignatureInline Doc2.Term
      DD.Doc2SpecialFormSignatureInline (DD.Doc2Term Term Symbol ()
tm) ->
        Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Term Symbol () -> Maybe Referent
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Maybe Referent
toReferent Term Symbol ()
tm of
          Just Referent
r -> Referent -> m Pretty
goSignature Referent
r
          Maybe Referent
_ -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
      -- Eval Doc2.Term
      DD.Doc2SpecialFormEval (DD.Doc2Term Term Symbol ()
tm) ->
        Term Symbol () -> m (Maybe (Term Symbol ()))
eval Term Symbol ()
tm m (Maybe (Term Symbol ()))
-> (Maybe (Term Symbol ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (Term Symbol ())
Nothing -> do
            Pretty
p <- PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
            Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
p, Pretty
"⧨", Pretty -> Pretty
P.red Pretty
"🆘  An error occured during evaluation"]
          Just Term Symbol ()
result -> do
            Pretty
p1 <- PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm
            Pretty
p2 <- PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
result
            Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
p1, Pretty
"⧨", Pretty -> Pretty
P.green Pretty
p2]

      -- EvalInline Doc2.Term
      DD.Doc2SpecialFormEvalInline (DD.Doc2Term Term Symbol ()
tm) ->
        Term Symbol () -> m (Maybe (Term Symbol ()))
eval Term Symbol ()
tm m (Maybe (Term Symbol ()))
-> (Maybe (Term Symbol ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (Term Symbol ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
P.red (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"🆘  An error occurred during evaluation"
          Just Term Symbol ()
result -> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
result
      -- Embed Any
      DD.Doc2SpecialFormEmbed (Term.App' Term Symbol ()
_ Term Symbol ()
any) ->
        PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
any m Pretty -> (Pretty -> Pretty) -> m Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Pretty
p ->
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"\n" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"{{ embed {{" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
p Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"}} }}" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"\n"
      -- EmbedInline Any
      DD.Doc2SpecialFormEmbedInline Term Symbol ()
any ->
        PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
any m Pretty -> (Pretty -> Pretty) -> m Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Pretty
p ->
          Pretty
"{{ embed {{" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
p Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"}} }}"
      Term Symbol ()
tm -> Pretty -> Pretty
P.red (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm

    toReferent :: Term (F typeVar typeAnn patternAnn) v a -> Maybe Referent
toReferent Term (F typeVar typeAnn patternAnn) v a
tm = case Term (F typeVar typeAnn patternAnn) v a
tm of
      Term.Ref' Reference
r -> Referent -> Maybe Referent
forall a. a -> Maybe a
Just (Reference -> Referent
Referent.Ref Reference
r)
      Term.Constructor' GConstructorReference Reference
r -> Referent -> Maybe Referent
forall a. a -> Maybe a
Just (GConstructorReference Reference -> ConstructorType -> Referent
Referent.Con GConstructorReference Reference
r ConstructorType
CT.Data)
      Term.Request' GConstructorReference Reference
r -> Referent -> Maybe Referent
forall a. a -> Maybe a
Just (GConstructorReference Reference -> ConstructorType -> Referent
Referent.Con GConstructorReference Reference
r ConstructorType
CT.Effect)
      Term (F typeVar typeAnn patternAnn) v a
_ -> Maybe Referent
forall a. Maybe a
Nothing

    goSignature :: Referent -> m Pretty
goSignature Referent
r =
      Referent -> m (Maybe (Type Symbol ()))
typeOf Referent
r m (Maybe (Type Symbol ()))
-> (Maybe (Type Symbol ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Type Symbol ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> Pretty
termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Referent
r
        Just Type Symbol ()
typ ->
          Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$
            PrettyPrintEnv
-> [(Referent, HashQualified Name, Type Symbol ())] -> Pretty
forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> Pretty
TypePrinter.prettySignaturesCTCollapsed
              (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped)
              [(Referent
r, PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Referent
r, Type Symbol ()
typ)]

    goColor :: Term (F typeVar typeAnn patternAnn) v a -> Pretty -> Pretty
goColor Term (F typeVar typeAnn patternAnn) v a
c = case Term (F typeVar typeAnn patternAnn) v a
c of
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBlack -> Pretty -> Pretty
P.black
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorRed -> Pretty -> Pretty
P.red
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorGreen -> Pretty -> Pretty
P.green
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorYellow -> Pretty -> Pretty
P.yellow
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBlue -> Pretty -> Pretty
P.blue
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorMagenta -> Pretty -> Pretty
P.purple
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorCyan -> Pretty -> Pretty
P.cyan
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorWhite -> Pretty -> Pretty
P.white
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightBlack -> Pretty -> Pretty
P.hiBlack
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightRed -> Pretty -> Pretty
P.hiRed
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightGreen -> Pretty -> Pretty
P.hiGreen
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightYellow -> Pretty -> Pretty
P.hiYellow
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightBlue -> Pretty -> Pretty
P.hiBlue
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightMagenta -> Pretty -> Pretty
P.hiPurple
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightCyan -> Pretty -> Pretty
P.hiCyan
      Term (F typeVar typeAnn patternAnn) v a
DD.AnsiColorBrightWhite -> Pretty -> Pretty
P.hiWhite
      Term (F typeVar typeAnn patternAnn) v a
_ -> Pretty -> Pretty
forall a. a -> a
id

    goConsole :: Term Symbol () -> m Pretty
goConsole = \case
      DD.ConsoleTextPlain (Term.Text' Text
txt) -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt
      DD.ConsoleTextForeground Term Symbol ()
color Term Symbol ()
txt -> Term Symbol () -> Pretty -> Pretty
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Pretty -> Pretty
goColor Term Symbol ()
color (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
goConsole Term Symbol ()
txt
      DD.ConsoleTextBackground Term Symbol ()
color Term Symbol ()
txt -> do
        Pretty
txt <- Term Symbol () -> m Pretty
goConsole Term Symbol ()
txt
        Pretty -> Pretty
color <- (Pretty -> Pretty) -> m (Pretty -> Pretty)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Pretty -> Pretty) -> m (Pretty -> Pretty))
-> (Pretty -> Pretty) -> m (Pretty -> Pretty)
forall a b. (a -> b) -> a -> b
$ Term Symbol () -> Pretty -> Pretty
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Pretty -> Pretty
goColor Term Symbol ()
color
        pure $ (Pretty -> Pretty) -> Pretty -> Pretty
P.background Pretty -> Pretty
color Pretty
txt
      DD.ConsoleTextBold Term Symbol ()
txt -> Pretty -> Pretty
P.bold (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
goConsole Term Symbol ()
txt
      DD.ConsoleTextUnderline Term Symbol ()
txt -> Pretty -> Pretty
P.underline (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
goConsole Term Symbol ()
txt
      DD.ConsoleTextInvert Term Symbol ()
txt -> Pretty -> Pretty
P.invert (Pretty -> Pretty) -> m Pretty -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Symbol () -> m Pretty
goConsole Term Symbol ()
txt
      Term Symbol ()
tm -> PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Type Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Pretty
displayTerm PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term Symbol ()))
terms Referent -> m (Maybe (Type Symbol ()))
typeOf Term Symbol () -> m (Maybe (Term Symbol ()))
eval Reference -> m (Maybe (Decl Symbol ()))
types Term Symbol ()
tm

-- pattern DocBlob txt <- Term.App' (Term.Constructor' DocRef DocBlobId) (Term.Text' txt)

displayDoc ::
  forall v m.
  (Var v, Monad m) =>
  PPE.PrettyPrintEnvDecl ->
  (Reference -> m (Maybe (Term v ()))) ->
  (Referent -> m (Maybe (Type v ()))) ->
  (Term v () -> m (Maybe (Term v ()))) ->
  (Reference -> m (Maybe (DD.Decl v ()))) ->
  Term v () ->
  m Pretty
displayDoc :: forall v (m :: * -> *).
(Var v, Monad m) =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term v ())))
-> (Referent -> m (Maybe (Type v ())))
-> (Term v () -> m (Maybe (Term v ())))
-> (Reference -> m (Maybe (Decl v ())))
-> Term v ()
-> m Pretty
displayDoc PrettyPrintEnvDecl
pped Reference -> m (Maybe (Term v ()))
terms Referent -> m (Maybe (Type v ()))
typeOf Term v () -> m (Maybe (Term v ()))
evaluated Reference -> m (Maybe (Decl v ()))
types = Term v () -> m Pretty
go
  where
    go :: Term v () -> m Pretty
go (DD.DocJoin Seq (Term v ())
docs) = Seq Pretty -> Pretty
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Seq Pretty -> Pretty) -> m (Seq Pretty) -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term v () -> m Pretty) -> Seq (Term v ()) -> m (Seq Pretty)
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) -> Seq a -> f (Seq b)
traverse Term v () -> m Pretty
go Seq (Term v ())
docs
    go (DD.DocBlob Text
txt) = Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. (ListLike s Char, IsString s) => Text -> Pretty s
P.paragraphyText Text
txt
    go (DD.DocLink (DD.LinkTerm (Term.TermLink' Referent
r))) =
      Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.underline (PrettyPrintEnv -> Referent -> Pretty
termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Referent
r)
    go (DD.DocLink (DD.LinkType (Term.TypeLink' Reference
r))) =
      Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.underline (PrettyPrintEnv -> Reference -> Pretty
typeName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Reference
r)
    go (DD.DocSource (DD.LinkTerm (Term.TermLink' Referent
r))) = (Reference -> m (Maybe (Term v ()))) -> Referent -> m Pretty
prettyTerm Reference -> m (Maybe (Term v ()))
terms Referent
r
    go (DD.DocSource (DD.LinkType (Term.TypeLink' Reference
r))) = Reference -> m Pretty
prettyType Reference
r
    go (DD.DocSignature (Term.TermLink' Referent
r)) = Referent -> m Pretty
prettySignature Referent
r
    go (DD.DocEvaluate (Term.TermLink' Referent
r)) = (Reference -> m (Maybe (Term v ()))) -> Referent -> m Pretty
prettyEval (Term v () -> m (Maybe (Term v ()))
evaluated (Term v () -> m (Maybe (Term v ())))
-> (Reference -> Term v ()) -> Reference -> m (Maybe (Term v ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Reference -> Term v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
Term.ref ()) Referent
r
    go Term v ()
tm = Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Term v () -> Pretty
forall v a. Var v => PrettyPrintEnv -> Term v a -> Pretty
TP.pretty (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped) Term v ()
tm
    prettySignature :: Referent -> m Pretty
prettySignature Referent
r =
      Referent -> m (Maybe (Type v ()))
typeOf Referent
r m (Maybe (Type v ()))
-> (Maybe (Type v ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Type v ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> Pretty
termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Referent
r
        Just Type v ()
typ ->
          Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> (Pretty -> Pretty) -> Pretty -> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$
            PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v ())] -> Pretty
forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> Pretty
TypePrinter.prettySignaturesCTCollapsed
              (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped)
              [(Referent
r, PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Referent
r, Type v ()
typ)]
    prettyEval :: (Reference -> m (Maybe (Term v ()))) -> Referent -> m Pretty
prettyEval Reference -> m (Maybe (Term v ()))
terms Referent
r = case Referent
r of
      Referent.Ref (Reference.Builtin Text
n) -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty)
-> (Pretty (SyntaxText' Any) -> Pretty)
-> Pretty (SyntaxText' Any)
-> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Any) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Any) -> m Pretty)
-> Pretty (SyntaxText' Any) -> m Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty (SyntaxText' Any)
forall s. IsString s => Text -> Pretty s
P.text Text
n
      Referent.Ref Reference
ref ->
        let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> Reference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
pped Reference
ref
         in Reference -> m (Maybe (Term v ()))
terms Reference
ref m (Maybe (Term v ()))
-> (Maybe (Term v ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe (Term v ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"😶  Missing term source for: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Referent -> Pretty
termName PrettyPrintEnv
ppe Referent
r
              Just Term v ()
tm -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Term v () -> Pretty
forall v a. Var v => PrettyPrintEnv -> Term v a -> Pretty
TP.pretty PrettyPrintEnv
ppe Term v ()
tm
      Referent.Con (ConstructorReference Reference
r ConstructorId
_) ConstructorType
_ -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Reference -> Pretty
typeName (PrettyPrintEnvDecl -> Reference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
pped Reference
r) Reference
r
    prettyTerm :: (Reference -> m (Maybe (Term v ()))) -> Referent -> m Pretty
prettyTerm Reference -> m (Maybe (Term v ()))
terms Referent
r = case Referent
r of
      Referent.Ref (Reference.Builtin Text
_) -> Referent -> m Pretty
prettySignature Referent
r
      Referent.Ref Reference
ref ->
        let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> Reference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
pped Reference
ref
         in Reference -> m (Maybe (Term v ()))
terms Reference
ref m (Maybe (Term v ()))
-> (Maybe (Term v ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe (Term v ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"😶  Missing term source for: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Referent -> Pretty
termName PrettyPrintEnv
ppe Referent
r
              Just Term v ()
tm -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty)
-> (Pretty (SyntaxText' Reference) -> Pretty)
-> Pretty (SyntaxText' Reference)
-> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty)
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
P.group (Pretty (SyntaxText' Reference) -> m Pretty)
-> Pretty (SyntaxText' Reference) -> m Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> HashQualified Name
-> Term v ()
-> Pretty (SyntaxText' Reference)
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name
-> Term2 v at ap v a
-> Pretty (SyntaxText' Reference)
TP.prettyBinding PrettyPrintEnv
ppe (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe Referent
r) Term v ()
tm
      Referent.Con (ConstructorReference Reference
r ConstructorId
_) ConstructorType
_ -> Reference -> m Pretty
prettyType Reference
r
    prettyType :: Reference -> m Pretty
prettyType Reference
r =
      let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> Reference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
pped Reference
r
       in Reference -> m (Maybe (Decl v ()))
types Reference
r m (Maybe (Decl v ()))
-> (Maybe (Decl v ()) -> m Pretty) -> m Pretty
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (Decl v ())
Nothing -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty) -> Pretty -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"😶  Missing type source for: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Reference -> Pretty
typeName PrettyPrintEnv
ppe Reference
r
            Just Decl v ()
ty -> Pretty -> m Pretty
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> m Pretty)
-> (Pretty (SyntaxText' Reference) -> Pretty)
-> Pretty (SyntaxText' Reference)
-> m Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Reference) -> m Pretty)
-> Pretty (SyntaxText' Reference) -> m Pretty
forall a b. (a -> b) -> a -> b
$ Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
P.group (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v ()
-> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> Pretty (SyntaxText' Reference)
DP.prettyDecl PrettyPrintEnvDecl
pped Reference
r (PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe Reference
r) Decl v ()
ty

termName :: PPE.PrettyPrintEnv -> Referent -> Pretty
termName :: PrettyPrintEnv -> Referent -> Pretty
termName PrettyPrintEnv
ppe Referent
r =
  Pretty (SyntaxText' Reference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty)
-> Pretty (SyntaxText' Reference) -> Pretty
forall a b. (a -> b) -> a -> b
$
    (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
NP.styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
NP.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
name
  where
    name :: HashQualified Name
name = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe Referent
r

typeName :: PPE.PrettyPrintEnv -> Reference -> Pretty
typeName :: PrettyPrintEnv -> Reference -> Pretty
typeName PrettyPrintEnv
ppe Reference
r =
  Pretty (SyntaxText' Reference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty)
-> Pretty (SyntaxText' Reference) -> Pretty
forall a b. (a -> b) -> a -> b
$
    (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
NP.styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
NP.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
name
  where
    name :: HashQualified Name
name = PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe Reference
r