{-|
Functions needed for getting templates from remote git repositories
-}

module ProjectForge.Get.Git (
  GitCloneArgs(..)
  , GitURL
  , Branch
  , gitClone
) where

import           System.Process.Typed (ProcessConfig, proc)


-- | A git branch as a @String@.
type Branch = String

-- | A git url as a @String@.
type GitURL = String

{-|
A limited set of arguments for @git clone@ that correspond
to the following command:

@
git clone \
   --branch <OptionalBranch>\
   --depth <OptionalDepth> \
   <repository> \
   <directory>
@

-}
data GitCloneArgs = MkGitCloneArgs {
  -- | [git clone repository](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt-ltrepositorygt)
    GitCloneArgs -> String
repository :: !GitURL
  -- | [git clone directory](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt-ltdirectorygt)
  , GitCloneArgs -> String
directory  :: !FilePath
  -- | [git clone branch](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt---branchltnamegt)
  , GitCloneArgs -> Maybe String
branch     :: !(Maybe Branch)
  -- | [git clone depth](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt---depthltdepthgt)
  , GitCloneArgs -> Maybe Integer
depth      :: !(Maybe Integer)
  } deriving (GitCloneArgs -> GitCloneArgs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitCloneArgs -> GitCloneArgs -> Bool
$c/= :: GitCloneArgs -> GitCloneArgs -> Bool
== :: GitCloneArgs -> GitCloneArgs -> Bool
$c== :: GitCloneArgs -> GitCloneArgs -> Bool
Eq, Int -> GitCloneArgs -> ShowS
[GitCloneArgs] -> ShowS
GitCloneArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitCloneArgs] -> ShowS
$cshowList :: [GitCloneArgs] -> ShowS
show :: GitCloneArgs -> String
$cshow :: GitCloneArgs -> String
showsPrec :: Int -> GitCloneArgs -> ShowS
$cshowsPrec :: Int -> GitCloneArgs -> ShowS
Show)

-- Convert @GitCloneArgs@ to a list for @'System.Process.Typed.proc'@.
cloneArgsToList :: GitCloneArgs -> [String]
cloneArgsToList :: GitCloneArgs -> [String]
cloneArgsToList GitCloneArgs
args =
     forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [String
"--branch", String
x]) (GitCloneArgs -> Maybe String
branch GitCloneArgs
args)
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
x-> [String
"--depth", forall a. Show a => a -> String
show Integer
x]) (GitCloneArgs -> Maybe Integer
depth GitCloneArgs
args)
  forall a. Semigroup a => a -> a -> a
<> [ GitCloneArgs -> String
repository GitCloneArgs
args, GitCloneArgs -> String
directory GitCloneArgs
args ]

{-|
A @'System.Process.Typed.ProcessConfig'@ for:

@
git clone <<args>>
@

NOTE:
According to the
[`typed-process` documentaiton](https://github.com/fpco/typed-process#readme),
"it's highly recommended that you compile any program
using this library with the multi-threaded runtime,
usually by adding ghc-options: -threaded to your executable stanza
in your cabal or package.yaml file.
The single-threaded runtime necessitates some inefficient polling
to be used under the surface."

-}
gitClone :: GitCloneArgs -> ProcessConfig () () ()
gitClone :: GitCloneArgs -> ProcessConfig () () ()
gitClone = String -> [String] -> ProcessConfig () () ()
proc String
"git" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String
"clone"] forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitCloneArgs -> [String]
cloneArgsToList