{-# 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
$sel:projectName:ProjectContextSuccess :: ProjectContextResponse -> ProjectName
projectName :: ProjectName
projectName, ProjectBranchName
$sel:projectBranch:ProjectContextSuccess :: ProjectContextResponse -> ProjectBranchName
projectBranch :: ProjectBranchName
projectBranch} ->
      [Pair] -> Value
Aeson.object
        [ Key
"projectName" Key -> ProjectName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= ProjectName
projectName,
          Key
"projectBranch" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
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.ResponseError Aeson.Value -> Lsp ()) ->
  Lsp ()
projectContextHandler :: forall {f :: MessageDirection}.
TRequestMessage ('Method_CustomMethod "unison/projectContext")
-> (Either ResponseError Value -> Lsp ()) -> Lsp ()
projectContextHandler TRequestMessage ('Method_CustomMethod "unison/projectContext")
_m Either ResponseError Value -> Lsp ()
respond = do
  ProjectPath
pp <- Lsp ProjectPath
forall (m :: * -> *). Lspish m => m ProjectPath
getCurrentProjectPath
  let PP.ProjectPath {ProjectName
project :: ProjectName
$sel:project:ProjectPath :: forall proj branch. ProjectPathG proj branch -> proj
project, ProjectBranchName
branch :: ProjectBranchName
$sel:branch:ProjectPath :: forall proj branch. ProjectPathG proj branch -> branch
branch} = ProjectPath -> ProjectPathG ProjectName ProjectBranchName
PP.toNames ProjectPath
pp
  Either ResponseError Value -> Lsp ()
respond (Either ResponseError Value -> Lsp ())
-> (ProjectContextResponse -> Either ResponseError Value)
-> ProjectContextResponse
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either ResponseError Value
forall a b. b -> Either a b
Right (Value -> Either ResponseError Value)
-> (ProjectContextResponse -> Value)
-> ProjectContextResponse
-> Either ResponseError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectContextResponse -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (ProjectContextResponse -> Lsp ())
-> ProjectContextResponse -> Lsp ()
forall a b. (a -> b) -> a -> b
$ ProjectName -> ProjectBranchName -> ProjectContextResponse
ProjectContextSuccess ProjectName
project ProjectBranchName
branch