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

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

import Data.OpenApi (ToParamSchema)
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.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Project (ProjectName)
import Unison.Server.Backend (Backend)
import Unison.Server.Local.Endpoints.Projects.Queries qualified as PG
import Unison.Server.Local.Endpoints.Projects.Queries qualified as PQ
import Unison.Server.Local.Endpoints.Projects.Types
import Unison.Symbol (Symbol)

type ListProjectsEndpoint =
  QueryParam "query" Query
    :> Get '[JSON] [ProjectListing]

type ListProjectBranchesEndpoint =
  QueryParam "query" Query
    :> 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"

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

instance ToParamSchema Query

instance ToParam (QueryParam "query" Query) where
  toParam :: Proxy (QueryParam "query" Query) -> DocQueryParam
toParam Proxy (QueryParam "query" Query)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"query"
      [String
"my-proj"]
      String
"Filter for results containing the given text."
      ParamKind
Normal

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

projectListingEndpoint ::
  Codebase IO Symbol Ann ->
  -- Infix Query
  Maybe Query ->
  Backend IO [ProjectListing]
projectListingEndpoint :: Codebase IO Symbol Ann
-> Maybe Query -> Backend IO [ProjectListing]
projectListingEndpoint Codebase IO Symbol Ann
codebase Maybe Query
mayQuery = 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
  Maybe Text -> Transaction [ProjectListing]
PQ.listProjects (Query -> Text
getQuery (Query -> Text) -> Maybe Query -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Query
mayQuery)

projectBranchListingEndpoint ::
  Codebase IO Symbol Ann ->
  ProjectName ->
  Maybe Query ->
  Backend IO [ProjectBranchListing]
projectBranchListingEndpoint :: Codebase IO Symbol Ann
-> ProjectName -> Maybe Query -> Backend IO [ProjectBranchListing]
projectBranchListingEndpoint Codebase IO Symbol Ann
codebase ProjectName
projectName Maybe Query
mayQuery = 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 [ProjectBranchListing]
-> MaybeT Transaction [ProjectBranchListing]
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 [ProjectBranchListing]
PG.listProjectBranches ProjectId
projectId (Query -> Text
getQuery (Query -> Text) -> Maybe Query -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Query
mayQuery))