{-# LANGUAGE DataKinds #-}

module Unison.LSP.ProjectContext
  ( projectContextHandler,
  )
where

import Data.Aeson qualified as Aeson
import Language.LSP.Protocol.Message qualified as Msg
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Core.Project
import Unison.LSP.Types

data ProjectContextResponse = ProjectContextSuccess
  { ProjectContextResponse -> ProjectName
projectName :: ProjectName,
    ProjectContextResponse -> ProjectBranchName
projectBranch :: ProjectBranchName
  }
  deriving (Int -> ProjectContextResponse -> ShowS
[ProjectContextResponse] -> ShowS
ProjectContextResponse -> String
(Int -> ProjectContextResponse -> ShowS)
-> (ProjectContextResponse -> String)
-> ([ProjectContextResponse] -> ShowS)
-> Show ProjectContextResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectContextResponse -> ShowS
showsPrec :: Int -> ProjectContextResponse -> ShowS
$cshow :: ProjectContextResponse -> String
show :: ProjectContextResponse -> String
$cshowList :: [ProjectContextResponse] -> ShowS
showList :: [ProjectContextResponse] -> ShowS
Show, ProjectContextResponse -> ProjectContextResponse -> Bool
(ProjectContextResponse -> ProjectContextResponse -> Bool)
-> (ProjectContextResponse -> ProjectContextResponse -> Bool)
-> Eq ProjectContextResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectContextResponse -> ProjectContextResponse -> Bool
== :: ProjectContextResponse -> ProjectContextResponse -> Bool
$c/= :: ProjectContextResponse -> ProjectContextResponse -> Bool
/= :: ProjectContextResponse -> ProjectContextResponse -> Bool
Eq)

instance Aeson.ToJSON ProjectContextResponse where
  toJSON :: ProjectContextResponse -> Value
toJSON = \case
    ProjectContextSuccess {ProjectName
projectName :: ProjectContextResponse -> ProjectName
projectName :: ProjectName
projectName, ProjectBranchName
projectBranch :: ProjectContextResponse -> ProjectBranchName
projectBranch :: ProjectBranchName
projectBranch} ->
      [Pair] -> Value
Aeson.object
        [ Key
"projectName" Key -> ProjectName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= ProjectName
projectName,
          Key
"projectBranch" Key -> ProjectBranchName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= ProjectBranchName
projectBranch
        ]

-- | Handler for the 'unison/projectContext' custom LSP request.
-- This returns the current project's name and branch.
projectContextHandler ::
  Msg.TRequestMessage ('Msg.Method_CustomMethod "unison/projectContext") ->
  (Either (Msg.TResponseError ('Msg.Method_CustomMethod "unison/projectContext")) Aeson.Value -> Lsp ()) ->
  Lsp ()
projectContextHandler :: forall {f :: MessageDirection} {f :: MessageDirection}.
TRequestMessage ('Method_CustomMethod "unison/projectContext")
-> (Either
      (TResponseError ('Method_CustomMethod "unison/projectContext"))
      Value
    -> Lsp ())
-> Lsp ()
projectContextHandler TRequestMessage ('Method_CustomMethod "unison/projectContext")
_m Either
  (TResponseError ('Method_CustomMethod "unison/projectContext"))
  Value
-> Lsp ()
respond = do
  pp <- Lsp ProjectPath
forall (m :: * -> *). Lspish m => m ProjectPath
getCurrentProjectPath
  let PP.ProjectPath {project, branch} = PP.toNames pp
  respond . Right . Aeson.toJSON $ ProjectContextSuccess project branch