{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

module Unison.Server.Local.Endpoints.DefinitionSummary
  ( TermSummaryAPI,
    serveTermSummary,
    TermSummary (..),
    TypeSummaryAPI,
    serveTypeSummary,
    TypeSummary (..),
  )
where

import Control.Monad.Reader
import Servant (Capture, QueryParam, (:>))
import Servant.OpenApi ()
import U.Codebase.HashTags (CausalHash)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Server.Backend (Backend)
import Unison.Server.Backend qualified as Backend
import Unison.Server.Types
  ( APIGet,
    TermSummary (..),
    TypeSummary (..),
    mayDefaultWidth,
  )
import Unison.Symbol (Symbol)
import Unison.Util.Pretty (Width)

type TermSummaryAPI =
  "definitions"
    :> "terms"
    :> "by-hash"
    :> Capture "hash" Referent
    :> "summary"
    -- Optional name to include in summary.
    -- It's propagated through to the response as-is.
    -- If missing, the short hash will be used instead.
    :> QueryParam "name" Name
    :> QueryParam "relativeTo" Path.Path
    :> QueryParam "renderWidth" Width
    :> APIGet TermSummary

serveTermSummary ::
  Codebase IO Symbol Ann ->
  Referent ->
  Maybe Name ->
  Either ShortCausalHash CausalHash ->
  Maybe Path.Path ->
  Maybe Width ->
  Backend IO TermSummary
serveTermSummary :: Codebase IO Symbol Ann
-> Referent
-> Maybe Name
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Width
-> Backend IO TermSummary
serveTermSummary Codebase IO Symbol Ann
codebase Referent
referent Maybe Name
mayName Either ShortCausalHash CausalHash
root Maybe Path
relativeTo Maybe Width
mayWidth = do
  let relativeToPath :: Path
relativeToPath = Path -> Maybe Path -> Path
forall a. a -> Maybe a -> a
fromMaybe Path
forall a. Monoid a => a
mempty Maybe Path
relativeTo
  root <- (forall x. Transaction x -> IO x)
-> Backend Transaction (CausalBranch Transaction)
-> Backend IO (CausalBranch Transaction)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
Backend.hoistBackend (Codebase IO Symbol Ann -> Transaction x -> IO x
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase) do
    Either ShortCausalHash CausalHash
-> Backend Transaction (CausalBranch Transaction)
Backend.normaliseRootCausalHash Either ShortCausalHash CausalHash
root
  (_, ppe) <- Backend.namesAtPathFromRootBranchHash codebase root relativeToPath
  let mkPPED Set LabeledDependency
_deps = PrettyPrintEnvDecl -> Transaction PrettyPrintEnvDecl
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnvDecl
ppe
  Backend.termSummaryForReferent codebase referent mayName mkPPED mayWidth

type TypeSummaryAPI =
  "definitions"
    :> "types"
    :> "by-hash"
    :> Capture "hash" Reference
    :> "summary"
    -- Optional name to include in summary.
    -- It's propagated through to the response as-is.
    -- If missing, the short hash will be used instead.
    :> QueryParam "name" Name
    :> QueryParam "relativeTo" Path.Path
    :> QueryParam "renderWidth" Width
    :> APIGet TypeSummary

serveTypeSummary ::
  Codebase IO Symbol Ann ->
  Reference ->
  Maybe Name ->
  Either ShortCausalHash CausalHash ->
  Maybe Path.Path ->
  Maybe Width ->
  Backend IO TypeSummary
serveTypeSummary :: Codebase IO Symbol Ann
-> Reference
-> Maybe Name
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Width
-> Backend IO TypeSummary
serveTypeSummary Codebase IO Symbol Ann
codebase Reference
reference Maybe Name
mayName Either ShortCausalHash CausalHash
_mayRoot Maybe Path
_relativeTo Maybe Width
mayWidth = do
  let shortHash :: ShortHash
shortHash = Reference -> ShortHash
Reference.toShortHash Reference
reference
  let displayName :: HashQualified Name
displayName = HashQualified Name
-> (Name -> HashQualified Name) -> Maybe Name -> HashQualified Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly ShortHash
shortHash) Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Maybe Name
mayName
  (tag, displayDecl) <-
    IO (TypeTag, DisplayObject () (Decl Symbol Ann))
-> Backend IO (TypeTag, DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
      Codebase IO Symbol Ann
-> Transaction (TypeTag, DisplayObject () (Decl Symbol Ann))
-> IO (TypeTag, DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
        tag <- Codebase IO Symbol Ann -> Reference -> Transaction TypeTag
forall v (m :: * -> *).
Var v =>
Codebase m v Ann -> Reference -> Transaction TypeTag
Backend.getTypeTag Codebase IO Symbol Ann
codebase Reference
reference
        displayDecl <- Backend.displayType codebase reference
        pure (tag, displayDecl)
  let syntaxHeader = Width
-> HashQualified Name
-> DisplayObject () (Decl Symbol Ann)
-> DisplayObject SyntaxText SyntaxText
Backend.typeToSyntaxHeader Width
width HashQualified Name
displayName DisplayObject () (Decl Symbol Ann)
displayDecl
  pure $
    TypeSummary
      { displayName = displayName,
        hash = shortHash,
        summary = bimap Backend.mungeSyntaxText Backend.mungeSyntaxText syntaxHeader,
        tag = tag
      }
  where
    width :: Width
width = Maybe Width -> Width
mayDefaultWidth Maybe Width
mayWidth