{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Unison.Server.Local.Endpoints.Projects
  ( projectListingEndpoint,
    projectBranchListingEndpoint,
    ListProjectsEndpoint,
    ListProjectBranchesEndpoint,
  )
where

import Data.Aeson (ToJSON (..))
import Data.Aeson qualified as Aeson
import Data.OpenApi (ToParamSchema, ToSchema)
import GHC.Generics ()
import Servant
import Servant.Docs
import Servant.Docs qualified as Docs
import U.Codebase.Sqlite.Project qualified as SqliteProject
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName))
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Server.Backend (Backend)
import Unison.Symbol (Symbol)

data ProjectListing = ProjectListing
  { ProjectListing -> ProjectName
projectName :: ProjectName
  }
  deriving stock (Int -> ProjectListing -> ShowS
[ProjectListing] -> ShowS
ProjectListing -> String
(Int -> ProjectListing -> ShowS)
-> (ProjectListing -> String)
-> ([ProjectListing] -> ShowS)
-> Show ProjectListing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectListing -> ShowS
showsPrec :: Int -> ProjectListing -> ShowS
$cshow :: ProjectListing -> String
show :: ProjectListing -> String
$cshowList :: [ProjectListing] -> ShowS
showList :: [ProjectListing] -> ShowS
Show, (forall x. ProjectListing -> Rep ProjectListing x)
-> (forall x. Rep ProjectListing x -> ProjectListing)
-> Generic ProjectListing
forall x. Rep ProjectListing x -> ProjectListing
forall x. ProjectListing -> Rep ProjectListing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectListing -> Rep ProjectListing x
from :: forall x. ProjectListing -> Rep ProjectListing x
$cto :: forall x. Rep ProjectListing x -> ProjectListing
to :: forall x. Rep ProjectListing x -> ProjectListing
Generic)

instance ToSchema ProjectListing

instance ToJSON ProjectListing where
  toJSON :: ProjectListing -> Value
toJSON ProjectListing {ProjectName
$sel:projectName:ProjectListing :: ProjectListing -> ProjectName
projectName :: ProjectName
projectName} =
    [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]

instance ToSample ProjectListing where
  toSamples :: Proxy ProjectListing -> [(Text, ProjectListing)]
toSamples Proxy ProjectListing
_ =
    ProjectListing -> [(Text, ProjectListing)]
forall a. a -> [(Text, a)]
singleSample (ProjectListing -> [(Text, ProjectListing)])
-> ProjectListing -> [(Text, ProjectListing)]
forall a b. (a -> b) -> a -> b
$ ProjectName -> ProjectListing
ProjectListing (Text -> ProjectName
UnsafeProjectName Text
"my-project")

data ProjectBranchListing = ProjectBranchListing
  { ProjectBranchListing -> ProjectBranchName
branchName :: ProjectBranchName
  }
  deriving stock (Int -> ProjectBranchListing -> ShowS
[ProjectBranchListing] -> ShowS
ProjectBranchListing -> String
(Int -> ProjectBranchListing -> ShowS)
-> (ProjectBranchListing -> String)
-> ([ProjectBranchListing] -> ShowS)
-> Show ProjectBranchListing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectBranchListing -> ShowS
showsPrec :: Int -> ProjectBranchListing -> ShowS
$cshow :: ProjectBranchListing -> String
show :: ProjectBranchListing -> String
$cshowList :: [ProjectBranchListing] -> ShowS
showList :: [ProjectBranchListing] -> ShowS
Show, (forall x. ProjectBranchListing -> Rep ProjectBranchListing x)
-> (forall x. Rep ProjectBranchListing x -> ProjectBranchListing)
-> Generic ProjectBranchListing
forall x. Rep ProjectBranchListing x -> ProjectBranchListing
forall x. ProjectBranchListing -> Rep ProjectBranchListing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectBranchListing -> Rep ProjectBranchListing x
from :: forall x. ProjectBranchListing -> Rep ProjectBranchListing x
$cto :: forall x. Rep ProjectBranchListing x -> ProjectBranchListing
to :: forall x. Rep ProjectBranchListing x -> ProjectBranchListing
Generic)

instance ToSchema ProjectBranchListing

instance ToJSON ProjectBranchListing where
  toJSON :: ProjectBranchListing -> Value
toJSON ProjectBranchListing {ProjectBranchName
$sel:branchName:ProjectBranchListing :: ProjectBranchListing -> ProjectBranchName
branchName :: ProjectBranchName
branchName} =
    [Pair] -> Value
Aeson.object [Key
"branchName" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= ProjectBranchName
branchName]

instance ToSample ProjectBranchListing where
  toSamples :: Proxy ProjectBranchListing -> [(Text, ProjectBranchListing)]
toSamples Proxy ProjectBranchListing
_ =
    ProjectBranchListing -> [(Text, ProjectBranchListing)]
forall a. a -> [(Text, a)]
singleSample (ProjectBranchListing -> [(Text, ProjectBranchListing)])
-> ProjectBranchListing -> [(Text, ProjectBranchListing)]
forall a b. (a -> b) -> a -> b
$ ProjectBranchName -> ProjectBranchListing
ProjectBranchListing (Text -> ProjectBranchName
UnsafeProjectBranchName Text
"my-branch")

type ListProjectsEndpoint =
  QueryParam "prefix" PrefixFilter
    :> Get '[JSON] [ProjectListing]

type ListProjectBranchesEndpoint =
  QueryParam "prefix" PrefixFilter
    :> Get '[JSON] [ProjectBranchListing]

newtype PrefixFilter = PrefixFilter
  { PrefixFilter -> Text
prefix :: Text
  }
  deriving stock (Int -> PrefixFilter -> ShowS
[PrefixFilter] -> ShowS
PrefixFilter -> String
(Int -> PrefixFilter -> ShowS)
-> (PrefixFilter -> String)
-> ([PrefixFilter] -> ShowS)
-> Show PrefixFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrefixFilter -> ShowS
showsPrec :: Int -> PrefixFilter -> ShowS
$cshow :: PrefixFilter -> String
show :: PrefixFilter -> String
$cshowList :: [PrefixFilter] -> ShowS
showList :: [PrefixFilter] -> ShowS
Show, (forall x. PrefixFilter -> Rep PrefixFilter x)
-> (forall x. Rep PrefixFilter x -> PrefixFilter)
-> Generic PrefixFilter
forall x. Rep PrefixFilter x -> PrefixFilter
forall x. PrefixFilter -> Rep PrefixFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrefixFilter -> Rep PrefixFilter x
from :: forall x. PrefixFilter -> Rep PrefixFilter x
$cto :: forall x. Rep PrefixFilter x -> PrefixFilter
to :: forall x. Rep PrefixFilter x -> PrefixFilter
Generic)
  deriving newtype (Text -> Either Text PrefixFilter
ByteString -> Either Text PrefixFilter
(Text -> Either Text PrefixFilter)
-> (ByteString -> Either Text PrefixFilter)
-> (Text -> Either Text PrefixFilter)
-> FromHttpApiData PrefixFilter
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PrefixFilter
parseUrlPiece :: Text -> Either Text PrefixFilter
$cparseHeader :: ByteString -> Either Text PrefixFilter
parseHeader :: ByteString -> Either Text PrefixFilter
$cparseQueryParam :: Text -> Either Text PrefixFilter
parseQueryParam :: Text -> Either Text PrefixFilter
FromHttpApiData)

instance ToParamSchema PrefixFilter

instance ToParam (QueryParam "prefix" PrefixFilter) where
  toParam :: Proxy (QueryParam "prefix" PrefixFilter) -> DocQueryParam
toParam Proxy (QueryParam "prefix" PrefixFilter)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"prefix"
      [String
"my-proj"]
      String
"Filter by project or branch prefix"
      ParamKind
Normal

instance Docs.ToSample PrefixFilter where
  toSamples :: Proxy PrefixFilter -> [(Text, PrefixFilter)]
toSamples Proxy PrefixFilter
_ =
    PrefixFilter -> [(Text, PrefixFilter)]
forall a. a -> [(Text, a)]
singleSample (PrefixFilter -> [(Text, PrefixFilter)])
-> PrefixFilter -> [(Text, PrefixFilter)]
forall a b. (a -> b) -> a -> b
$ Text -> PrefixFilter
PrefixFilter Text
"my-proj"

projectListingEndpoint ::
  Codebase IO Symbol Ann ->
  Maybe PrefixFilter ->
  Backend IO [ProjectListing]
projectListingEndpoint :: Codebase IO Symbol Ann
-> Maybe PrefixFilter -> Backend IO [ProjectListing]
projectListingEndpoint Codebase IO Symbol Ann
codebase Maybe PrefixFilter
mayPrefix = IO [ProjectListing] -> Backend IO [ProjectListing]
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ProjectListing] -> Backend IO [ProjectListing])
-> (Transaction [ProjectListing] -> IO [ProjectListing])
-> Transaction [ProjectListing]
-> Backend IO [ProjectListing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction [ProjectListing] -> IO [ProjectListing]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction [ProjectListing] -> Backend IO [ProjectListing])
-> Transaction [ProjectListing] -> Backend IO [ProjectListing]
forall a b. (a -> b) -> a -> b
$ do
  [Project]
projects <- Maybe Text -> Transaction [Project]
Q.loadAllProjectsBeginningWith (PrefixFilter -> Text
prefix (PrefixFilter -> Text) -> Maybe PrefixFilter -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PrefixFilter
mayPrefix)
  [ProjectListing] -> Transaction [ProjectListing]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ProjectListing] -> Transaction [ProjectListing])
-> [ProjectListing] -> Transaction [ProjectListing]
forall a b. (a -> b) -> a -> b
$ ProjectName -> ProjectListing
ProjectListing (ProjectName -> ProjectListing)
-> (Project -> ProjectName) -> Project -> ProjectListing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> ProjectName
SqliteProject.name (Project -> ProjectListing) -> [Project] -> [ProjectListing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Project]
projects

projectBranchListingEndpoint ::
  Codebase IO Symbol Ann ->
  ProjectName ->
  Maybe PrefixFilter ->
  Backend IO [ProjectBranchListing]
projectBranchListingEndpoint :: Codebase IO Symbol Ann
-> ProjectName
-> Maybe PrefixFilter
-> Backend IO [ProjectBranchListing]
projectBranchListingEndpoint Codebase IO Symbol Ann
codebase ProjectName
projectName Maybe PrefixFilter
mayPrefix = IO [ProjectBranchListing] -> Backend IO [ProjectBranchListing]
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ProjectBranchListing] -> Backend IO [ProjectBranchListing])
-> (MaybeT Transaction [ProjectBranchListing]
    -> IO [ProjectBranchListing])
-> MaybeT Transaction [ProjectBranchListing]
-> Backend IO [ProjectBranchListing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction [ProjectBranchListing] -> IO [ProjectBranchListing]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction [ProjectBranchListing] -> IO [ProjectBranchListing])
-> (MaybeT Transaction [ProjectBranchListing]
    -> Transaction [ProjectBranchListing])
-> MaybeT Transaction [ProjectBranchListing]
-> IO [ProjectBranchListing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [ProjectBranchListing] -> [ProjectBranchListing])
-> Transaction (Maybe [ProjectBranchListing])
-> Transaction [ProjectBranchListing]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe [ProjectBranchListing] -> [ProjectBranchListing]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Transaction (Maybe [ProjectBranchListing])
 -> Transaction [ProjectBranchListing])
-> (MaybeT Transaction [ProjectBranchListing]
    -> Transaction (Maybe [ProjectBranchListing]))
-> MaybeT Transaction [ProjectBranchListing]
-> Transaction [ProjectBranchListing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT Transaction [ProjectBranchListing]
-> Transaction (Maybe [ProjectBranchListing])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Transaction [ProjectBranchListing]
 -> Backend IO [ProjectBranchListing])
-> MaybeT Transaction [ProjectBranchListing]
-> Backend IO [ProjectBranchListing]
forall a b. (a -> b) -> a -> b
$ do
  SqliteProject.Project {ProjectId
projectId :: ProjectId
$sel:projectId:Project :: Project -> ProjectId
projectId} <- Transaction (Maybe Project) -> MaybeT Transaction Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe Project) -> MaybeT Transaction Project)
-> Transaction (Maybe Project) -> MaybeT Transaction Project
forall a b. (a -> b) -> a -> b
$ ProjectName -> Transaction (Maybe Project)
Q.loadProjectByName ProjectName
projectName
  Transaction [(ProjectBranchId, ProjectBranchName)]
-> MaybeT Transaction [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Q.loadAllProjectBranchesBeginningWith ProjectId
projectId (PrefixFilter -> Text
prefix (PrefixFilter -> Text) -> Maybe PrefixFilter -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PrefixFilter
mayPrefix))
    MaybeT Transaction [(ProjectBranchId, ProjectBranchName)]
-> ([(ProjectBranchId, ProjectBranchName)]
    -> [ProjectBranchListing])
-> MaybeT Transaction [ProjectBranchListing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ProjectBranchId, ProjectBranchName) -> ProjectBranchListing)
-> [(ProjectBranchId, ProjectBranchName)] -> [ProjectBranchListing]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchName -> ProjectBranchListing
ProjectBranchListing (ProjectBranchName -> ProjectBranchListing)
-> ((ProjectBranchId, ProjectBranchName) -> ProjectBranchName)
-> (ProjectBranchId, ProjectBranchName)
-> ProjectBranchListing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchId, ProjectBranchName) -> ProjectBranchName
forall a b. (a, b) -> b
snd)