module Unison.Codebase.Editor.HandleInput.UI (openUI) where

import Control.Monad.Reader (ask)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.Branch.Type qualified as V2Branch
import U.Codebase.Reference qualified as V2 (Reference)
import U.Codebase.Referent qualified as V2 (Referent)
import U.Codebase.Referent qualified as V2.Referent
import U.Codebase.Sqlite.Project qualified as Project
import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.Output (Output (..))
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
import Unison.ConstructorType qualified as ConstructorType
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Parser.Ann (Ann (..))
import Unison.Prelude
import Unison.Project (ProjectAndBranch (ProjectAndBranch))
import Unison.Referent qualified as Referent
import Unison.Server.CodebaseServer qualified as Server
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Web.Browser (openBrowser)

openUI :: Path.Path' -> Cli ()
openUI :: Path' -> Cli ()
openUI Path'
path' = do
  Cli.Env {serverBaseUrl} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  defnPath <- Cli.resolvePath' path'
  pp <- Cli.getCurrentProjectPath
  case serverBaseUrl of
    Just BaseUrl
url -> BaseUrl -> ProjectPath -> Absolute -> Cli ()
openUIForProject BaseUrl
url ProjectPath
pp (ProjectPath
defnPath ProjectPath -> Getting Absolute ProjectPath Absolute -> Absolute
forall s a. s -> Getting a s a -> a
^. Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_)
    Maybe BaseUrl
Nothing -> do
      Output -> Cli ()
Cli.respond Output
UCMServerNotRunning

openUIForProject :: Server.BaseUrl -> PP.ProjectPath -> Path.Absolute -> Cli ()
openUIForProject :: BaseUrl -> ProjectPath -> Absolute -> Cli ()
openUIForProject BaseUrl
url pp :: ProjectPath
pp@(PP.ProjectPath Project
project ProjectBranch
projectBranch Absolute
perspective) Absolute
defnPath = do
  mayDefinitionRef <- Absolute -> Cli (Maybe DefinitionReference)
getDefinitionRef Absolute
perspective
  let projectBranchNames = (Project -> ProjectName)
-> (ProjectBranch -> ProjectBranchName)
-> ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b c d.
(a -> b)
-> (c -> d) -> ProjectAndBranch a c -> ProjectAndBranch b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (.name) (.name) (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
projectBranch)
  _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.ProjectBranchUI projectBranchNames perspective mayDefinitionRef) url
  pure ()
  where
    -- If the provided ui path matches a definition, find it.
    getDefinitionRef :: Path.Absolute -> Cli (Maybe (Server.DefinitionReference))
    getDefinitionRef :: Absolute -> Cli (Maybe DefinitionReference)
getDefinitionRef Absolute
perspective = MaybeT Cli DefinitionReference -> Cli (Maybe DefinitionReference)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Cli DefinitionReference -> Cli (Maybe DefinitionReference))
-> MaybeT Cli DefinitionReference
-> Cli (Maybe DefinitionReference)
forall a b. (a -> b) -> a -> b
$ do
      Cli.Env {codebase} <- Cli Env -> MaybeT Cli Env
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      pathToDefinitionNamespace <- hoistMaybe $ Path.ascend defnPath
      let defnNamespaceProjectPath = ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Absolute -> Identity Absolute)
-> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ ((Absolute -> Identity Absolute)
 -> ProjectPath -> Identity ProjectPath)
-> Absolute -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Absolute
pathToDefinitionNamespace
      namespaceBranch <- lift . Cli.runTransaction $ Codebase.getShallowBranchAtProjectPath defnNamespaceProjectPath
      fqn <- hoistMaybe $ do
        pathFromPerspective <- List.stripPrefix (Path.toList (Path.unabsolute perspective)) (Path.toList $ Path.unabsolute defnPath)
        Path.toName . Path.fromList $ pathFromPerspective
      def <- MaybeT $ getTermOrTypeRef codebase namespaceBranch fqn
      pure def

getTermOrTypeRef :: Codebase m Symbol Ann -> V2Branch.Branch n -> Name -> Cli (Maybe Server.DefinitionReference)
getTermOrTypeRef :: forall (m :: * -> *) (n :: * -> *).
Codebase m Symbol Ann
-> Branch n -> Name -> Cli (Maybe DefinitionReference)
getTermOrTypeRef Codebase m Symbol Ann
codebase Branch n
namespaceBranch Name
fqn = MaybeT Cli DefinitionReference -> Cli (Maybe DefinitionReference)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Cli DefinitionReference -> Cli (Maybe DefinitionReference))
-> MaybeT Cli DefinitionReference
-> Cli (Maybe DefinitionReference)
forall a b. (a -> b) -> a -> b
$ do
  let nameSeg :: NameSegment
nameSeg = Name -> NameSegment
Name.lastSegment Name
fqn
  let terms :: MaybeT Cli DefinitionReference
terms = do
        matchingTerms <- Maybe (Map Referent (n MdValues))
-> MaybeT Cli (Map Referent (n MdValues))
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (Map Referent (n MdValues))
 -> MaybeT Cli (Map Referent (n MdValues)))
-> Maybe (Map Referent (n MdValues))
-> MaybeT Cli (Map Referent (n MdValues))
forall a b. (a -> b) -> a -> b
$ NameSegment
-> Map NameSegment (Map Referent (n MdValues))
-> Maybe (Map Referent (n MdValues))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
nameSeg (Branch n -> Map NameSegment (Map Referent (n MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
V2Branch.terms Branch n
namespaceBranch)
        oneTerm <- hoistMaybe $ Set.lookupMin $ Map.keysSet matchingTerms
        lift $ Cli.runTransaction (toTermReference codebase fqn oneTerm)
  let types :: MaybeT Cli DefinitionReference
types = do
        matchingTypes <- Maybe (Map Reference (n MdValues))
-> MaybeT Cli (Map Reference (n MdValues))
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (Map Reference (n MdValues))
 -> MaybeT Cli (Map Reference (n MdValues)))
-> Maybe (Map Reference (n MdValues))
-> MaybeT Cli (Map Reference (n MdValues))
forall a b. (a -> b) -> a -> b
$ NameSegment
-> Map NameSegment (Map Reference (n MdValues))
-> Maybe (Map Reference (n MdValues))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
nameSeg (Branch n -> Map NameSegment (Map Reference (n MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
V2Branch.types Branch n
namespaceBranch)
        oneType <- hoistMaybe $ Set.lookupMin $ Map.keysSet matchingTypes
        pure (toTypeReference fqn oneType)
  MaybeT Cli DefinitionReference
terms MaybeT Cli DefinitionReference
-> MaybeT Cli DefinitionReference -> MaybeT Cli DefinitionReference
forall a. MaybeT Cli a -> MaybeT Cli a -> MaybeT Cli a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT Cli DefinitionReference
types

toTypeReference :: Name -> V2.Reference -> Server.DefinitionReference
toTypeReference :: Name -> Reference -> DefinitionReference
toTypeReference Name
name Reference
reference =
  HashQualified Name -> DefinitionReference
Server.TypeReference (HashQualified Name -> DefinitionReference)
-> HashQualified Name -> DefinitionReference
forall a b. (a -> b) -> a -> b
$
    Name -> Reference -> HashQualified Name
forall n. n -> Reference -> HashQualified n
HQ.fromNamedReference Name
name (Reference -> Reference
Conversions.reference2to1 Reference
reference)

toTermReference :: Codebase m Symbol Ann -> Name -> V2.Referent -> Sqlite.Transaction Server.DefinitionReference
toTermReference :: forall (m :: * -> *).
Codebase m Symbol Ann
-> Name -> Referent -> Transaction DefinitionReference
toTermReference Codebase m Symbol Ann
codebase Name
name Referent
referent = do
  case Referent
referent of
    V2.Referent.Ref Reference
reference ->
      DefinitionReference -> Transaction DefinitionReference
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionReference -> Transaction DefinitionReference)
-> DefinitionReference -> Transaction DefinitionReference
forall a b. (a -> b) -> a -> b
$
        HashQualified Name -> DefinitionReference
Server.TermReference (HashQualified Name -> DefinitionReference)
-> HashQualified Name -> DefinitionReference
forall a b. (a -> b) -> a -> b
$
          Name -> Reference -> HashQualified Name
forall n. n -> Reference -> HashQualified n
HQ.fromNamedReference Name
name (Reference -> Reference
Conversions.reference2to1 Reference
reference)
    V2.Referent.Con Reference
_ ConstructorId
_ -> do
      v1Referent <- (Reference -> Transaction ConstructorType)
-> Referent -> Transaction Referent
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Referent -> m Referent
Conversions.referent2to1 (Codebase m Symbol Ann -> Reference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Transaction ConstructorType
Codebase.getDeclType Codebase m Symbol Ann
codebase) Referent
referent
      let hq = Name -> Referent -> HashQualified Name
forall n. n -> Referent -> HashQualified n
HQ.fromNamedReferent Name
name Referent
v1Referent

      pure case v1Referent of
        Referent.Con ConstructorReference
_ ConstructorType
ConstructorType.Data ->
          HashQualified Name -> DefinitionReference
Server.DataConstructorReference HashQualified Name
hq
        Referent.Con ConstructorReference
_ ConstructorType
ConstructorType.Effect ->
          HashQualified Name -> DefinitionReference
Server.AbilityConstructorReference HashQualified Name
hq
        Referent.Ref Reference
_ -> String -> DefinitionReference
forall a. HasCallStack => String -> a
error String
"Impossible! *twirls mustache*"