{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.Local.Endpoints.GetDefinitions where

import Servant
  ( QueryParam,
    QueryParams,
    (:>),
  )
import Servant.Docs
  ( DocQueryParam (..),
    ParamKind (..),
    ToParam (..),
    ToSample (..),
    noSamples,
  )
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.Runtime qualified as Rt
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.Server.Backend qualified as Backend
import Unison.Server.Local.Definitions qualified as Local
import Unison.Server.Types
  ( APIGet,
    DefinitionDisplayResults,
    Suffixify (..),
    defaultWidth,
  )
import Unison.Symbol (Symbol)
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Pretty (Width)

type DefinitionsAPI =
  "getDefinition"
    :> QueryParam "relativeTo" Path.Path
    :> QueryParams "names" (HQ.HashQualified Name)
    :> QueryParam "renderWidth" Width
    :> QueryParam "suffixifyBindings" Suffixify
    :> APIGet DefinitionDisplayResults

instance ToParam (QueryParam "renderWidth" Width) where
  toParam :: Proxy (QueryParam "renderWidth" Width) -> DocQueryParam
toParam Proxy (QueryParam "renderWidth" Width)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"renderWidth"
      [String
"80", String
"100", String
"120"]
      ( String
"The preferred maximum line width (in characters) of the source code of "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"definitions to be rendered. "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the render width is assumed to be "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Width -> String
forall a. Show a => a -> String
show Width
defaultWidth
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
      )
      ParamKind
Normal

instance ToParam (QueryParam "suffixifyBindings" Suffixify) where
  toParam :: Proxy (QueryParam "suffixifyBindings" Suffixify) -> DocQueryParam
toParam Proxy (QueryParam "suffixifyBindings" Suffixify)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"suffixifyBindings"
      [String
"True", String
"False"]
      ( String
"If True or absent, renders definitions using the shortest unambiguous "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"suffix. If False, uses the fully qualified name. "
      )
      ParamKind
Normal

instance ToParam (QueryParam "relativeTo" Path.Path) where
  toParam :: Proxy (QueryParam "relativeTo" Path) -> DocQueryParam
toParam Proxy (QueryParam "relativeTo" Path)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"relativeTo"
      []
      ( String
"The namespace relative to which names will be resolved and displayed. "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the root namespace will be used."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"E.g. base.List"
      )
      ParamKind
Normal

instance ToParam (QueryParam "namespace" Path.Path) where
  toParam :: Proxy (QueryParam "namespace" Path) -> DocQueryParam
toParam Proxy (QueryParam "namespace" Path)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"namespace"
      []
      ( String
"The namespace required by the endpoint."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the relativeTo namespace will be used."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"E.g. base.List"
      )
      ParamKind
Normal

instance ToParam (QueryParams "names" (HQ.HashQualified Name)) where
  toParam :: Proxy (QueryParams "names" (HashQualified Name)) -> DocQueryParam
toParam Proxy (QueryParams "names" (HashQualified Name))
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"names"
      [String
".base.List", String
"foo.bar", String
"@abc123"]
      (String
"A fully qualified name, hash-qualified name, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"or hash.")
      ParamKind
List

instance ToSample DefinitionDisplayResults where
  toSamples :: Proxy DefinitionDisplayResults
-> [(Text, DefinitionDisplayResults)]
toSamples Proxy DefinitionDisplayResults
_ = [(Text, DefinitionDisplayResults)]
forall a. [(Text, a)]
noSamples

serveDefinitions ::
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  Either ShortCausalHash CausalHash ->
  Maybe Path.Path ->
  [HQ.HashQualified Name] ->
  Maybe Width ->
  Maybe Suffixify ->
  Backend.Backend IO DefinitionDisplayResults
serveDefinitions :: Runtime Symbol
-> Codebase IO Symbol Ann
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend IO DefinitionDisplayResults
serveDefinitions Runtime Symbol
rt Codebase IO Symbol Ann
codebase Either ShortCausalHash CausalHash
root Maybe Path
relativePath [HashQualified Name]
hqns Maybe Width
width Maybe Suffixify
suff =
  do
    CausalBranch Transaction
rootCausalHash <- (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) (Backend Transaction (CausalBranch Transaction)
 -> Backend IO (CausalBranch Transaction))
-> (Either ShortCausalHash CausalHash
    -> Backend Transaction (CausalBranch Transaction))
-> Either ShortCausalHash CausalHash
-> Backend IO (CausalBranch Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ShortCausalHash CausalHash
-> Backend Transaction (CausalBranch Transaction)
Backend.normaliseRootCausalHash (Either ShortCausalHash CausalHash
 -> Backend IO (CausalBranch Transaction))
-> Either ShortCausalHash CausalHash
-> Backend IO (CausalBranch Transaction)
forall a b. (a -> b) -> a -> b
$ Either ShortCausalHash CausalHash
root
    [HashQualified Name]
hqns
      [HashQualified Name]
-> ([HashQualified Name] -> Backend IO DefinitionDisplayResults)
-> Backend IO DefinitionDisplayResults
forall a b. a -> (a -> b) -> b
& (HashQualified Name -> Backend IO DefinitionDisplayResults)
-> [HashQualified Name] -> Backend IO DefinitionDisplayResults
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM
        ( Path
-> CausalBranch Transaction
-> Maybe Width
-> Suffixify
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> HashQualified Name
-> Backend IO DefinitionDisplayResults
Local.prettyDefinitionsForHQName
            (Path -> Maybe Path -> Path
forall a. a -> Maybe a -> a
fromMaybe Path
Path.empty Maybe Path
relativePath)
            CausalBranch Transaction
rootCausalHash
            Maybe Width
width
            (Suffixify -> Maybe Suffixify -> Suffixify
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Suffixify
Suffixify Bool
True) Maybe Suffixify
suff)
            Runtime Symbol
rt
            Codebase IO Symbol Ann
codebase
        )