{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.Local.Endpoints.NamespaceDetails where

import Data.Set qualified as Set
import Servant (Capture, QueryParam, (:>))
import Servant.Docs (DocCapture (..), ToCapture (..))
import Servant.OpenApi ()
import U.Codebase.Causal qualified as V2Causal
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.NameSegment.Internal (NameSegment (NameSegment))
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Runtime (Runtime)
import Unison.Server.Backend
import Unison.Server.Backend qualified as Backend
import Unison.Server.Doc qualified as Doc
import Unison.Server.Types
  ( APIGet,
    NamespaceDetails (..),
    v2CausalBranchToUnisonHash,
  )
import Unison.Symbol (Symbol)
import Unison.Util.Pretty (Width)

type NamespaceDetailsAPI =
  "namespaces"
    :> Capture "namespace" Path.Path
    :> QueryParam "renderWidth" Width
    :> APIGet NamespaceDetails

instance ToCapture (Capture "namespace" Text) where
  toCapture :: Proxy (Capture "namespace" Text) -> DocCapture
toCapture Proxy (Capture "namespace" Text)
_ =
    String -> String -> DocCapture
DocCapture
      String
"namespace"
      String
"The fully qualified name of a namespace. The leading `.` is optional."

namespaceDetails ::
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  Path.Path ->
  Either ShortCausalHash CausalHash ->
  Maybe Width ->
  Backend IO NamespaceDetails
namespaceDetails :: Runtime Symbol
-> Codebase IO Symbol Ann
-> Path
-> Either ShortCausalHash CausalHash
-> Maybe Width
-> Backend IO NamespaceDetails
namespaceDetails Runtime Symbol
runtime Codebase IO Symbol Ann
codebase Path
namespacePath Either ShortCausalHash CausalHash
root Maybe Width
_mayWidth = do
  (rootCausal, namespaceCausal, shallowBranch) <-
    (forall x. Transaction x -> IO x)
-> Backend
     Transaction
     (CausalBranch Transaction, CausalBranch Transaction,
      Branch Transaction)
-> Backend
     IO
     (CausalBranch Transaction, CausalBranch Transaction,
      Branch 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
      rootCausalHash <-
        case Either ShortCausalHash CausalHash
root of
          (Left ShortCausalHash
sch) -> ShortCausalHash -> Backend Transaction (CausalBranch Transaction)
Backend.resolveRootBranchHashV2 ShortCausalHash
sch
          (Right CausalHash
ch) -> Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (CausalBranch Transaction)
 -> Backend Transaction (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
ch
      namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath rootCausalHash
      shallowBranch <- lift $ V2Causal.value namespaceCausal
      pure (rootCausalHash, namespaceCausal, shallowBranch)
  namespaceDetails <- do
    (_localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase rootCausal namespacePath
    let mayReadmeRef = Set NameSegment -> Branch Transaction -> Maybe TermReference
forall (m :: * -> *).
Set NameSegment -> Branch m -> Maybe TermReference
Backend.findDocInBranch Set NameSegment
readmeNames Branch Transaction
shallowBranch
    renderedReadme <- for mayReadmeRef \TermReference
readmeRef -> do
      -- Local server currently ignores eval errors.
      (eDoc, _evalErrs) <- IO (EvaluatedDoc Symbol, [DecompError])
-> Backend IO (EvaluatedDoc Symbol, [DecompError])
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EvaluatedDoc Symbol, [DecompError])
 -> Backend IO (EvaluatedDoc Symbol, [DecompError]))
-> IO (EvaluatedDoc Symbol, [DecompError])
-> Backend IO (EvaluatedDoc Symbol, [DecompError])
forall a b. (a -> b) -> a -> b
$ Runtime Symbol
-> Codebase IO Symbol Ann
-> TermReference
-> IO (EvaluatedDoc Symbol, [DecompError])
evalDocRef Runtime Symbol
runtime Codebase IO Symbol Ann
codebase TermReference
readmeRef
      pure $ Doc.renderDoc ppe eDoc
    let causalHash = CausalBranch Transaction -> Text
forall (m :: * -> *). CausalBranch m -> Text
v2CausalBranchToUnisonHash CausalBranch Transaction
namespaceCausal
    pure $ NamespaceDetails namespacePath causalHash renderedReadme
  pure $ namespaceDetails
  where
    readmeNames :: Set NameSegment
readmeNames =
      [NameSegment] -> Set NameSegment
forall a. Ord a => [a] -> Set a
Set.fromList ([NameSegment] -> Set NameSegment)
-> [NameSegment] -> Set NameSegment
forall a b. (a -> b) -> a -> b
$ Text -> NameSegment
NameSegment (Text -> NameSegment) -> [Text] -> [NameSegment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"README", Text
"Readme", Text
"ReadMe", Text
"readme"]