{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Repositories
-- Description : Queries about project repositories
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Repositories where

import Control.Monad.IO.Unlift
import qualified Data.ByteString.Lazy as BSL
import Data.Either
import qualified Data.Text as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client

-- | returns a list of repository files and directories in a project.
repositories ::
  -- | the project
  Project ->
  GitLab [Repository]
repositories :: Project -> GitLab [Repository]
repositories Project
project =
  [Repository]
-> Either (Response ByteString) [Repository] -> [Repository]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [Repository]
forall a. HasCallStack => [Char] -> a
error [Char]
"repositories error") (Either (Response ByteString) [Repository] -> [Repository])
-> ReaderT
     GitLabState IO (Either (Response ByteString) [Repository])
-> GitLab [Repository]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ReaderT
     GitLabState IO (Either (Response ByteString) [Repository])
repositories' (Project -> Int
project_id Project
project)

-- | returns a list of repository files and directories in a project
-- given its project ID.
repositories' ::
  -- | the project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Repository])
repositories' :: Int
-> ReaderT
     GitLabState IO (Either (Response ByteString) [Repository])
repositories' Int
projectId =
  Text
-> ReaderT
     GitLabState IO (Either (Response ByteString) [Repository])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab Text
addr
  where
    addr :: Text
addr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/tree"

-- | get a file archive of the repository files. For example:
--
-- > getFileArchive myProject TarGz "/tmp/myProject.tar.gz"
getFileArchive ::
  -- | project
  Project ->
  -- | file format
  ArchiveFormat ->
  -- | file path to store the archive
  FilePath ->
  GitLab (Either (Response BSL.ByteString) ())
getFileArchive :: Project
-> ArchiveFormat
-> [Char]
-> GitLab (Either (Response ByteString) ())
getFileArchive Project
project = Int
-> ArchiveFormat
-> [Char]
-> GitLab (Either (Response ByteString) ())
getFileArchive' (Project -> Int
project_id Project
project)

-- | get a file archive of the repository files as a
-- 'BSL.ByteString'. For example:
--
-- > getFileArchiveBS myProject TarGz "/tmp/myProject.tar.gz"
getFileArchiveBS ::
  -- | project
  Project ->
  -- | file format
  ArchiveFormat ->
  GitLab (Either (Response BSL.ByteString) BSL.ByteString)
getFileArchiveBS :: Project
-> ArchiveFormat
-> GitLab (Either (Response ByteString) ByteString)
getFileArchiveBS Project
project = Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) ByteString)
getFileArchiveBS' (Project -> Int
project_id Project
project)

-- | get a file archive of the repository files using the project's
--   ID. For example:
--
-- > getFileArchive' 3453 Zip "/tmp/myProject.zip"
getFileArchive' ::
  -- | project ID
  Int ->
  -- | file format
  ArchiveFormat ->
  -- | file path to store the archive
  FilePath ->
  GitLab (Either (Response BSL.ByteString) ())
getFileArchive' :: Int
-> ArchiveFormat
-> [Char]
-> GitLab (Either (Response ByteString) ())
getFileArchive' Int
projectId ArchiveFormat
format [Char]
fPath = do
  Either (Response ByteString) ByteString
attempt <- Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) ByteString)
getFileArchiveBS' Int
projectId ArchiveFormat
format
  case Either (Response ByteString) ByteString
attempt of
    Left Response ByteString
st -> Either (Response ByteString) ()
-> GitLab (Either (Response ByteString) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) ()
forall a b. a -> Either a b
Left Response ByteString
st)
    Right ByteString
archiveData ->
      () -> Either (Response ByteString) ()
forall a b. b -> Either a b
Right (() -> Either (Response ByteString) ())
-> ReaderT GitLabState IO ()
-> GitLab (Either (Response ByteString) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> ReaderT GitLabState IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> ByteString -> IO ()
BSL.writeFile [Char]
fPath ByteString
archiveData)

-- | get a file archive of the repository files as a 'BSL.ByteString'
--   using the project's ID. For example:
--
-- > getFileArchiveBS' 3453 Zip "/tmp/myProject.zip"
getFileArchiveBS' ::
  -- | project ID
  Int ->
  -- | file format
  ArchiveFormat ->
  GitLab (Either (Response BSL.ByteString) BSL.ByteString)
getFileArchiveBS' :: Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) ByteString)
getFileArchiveBS' Int
projectId ArchiveFormat
format =
  Text -> GitLab (Either (Response ByteString) ByteString)
gitlabReqByteString Text
addr
  where
    addr :: Text
addr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/archive"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ArchiveFormat -> [Char]
forall a. Show a => a -> [Char]
show ArchiveFormat
format)