module Data.Git.Phoenix.Repo where

import Relude
import System.Directory
import System.FilePath

initGitRepo :: MonadIO m => FilePath -> m ()
initGitRepo :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
initGitRepo FilePath
rp = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
createDirectory ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
rp FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
rpGit FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
rpGitDirs
  ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
fn, FilePath
fc) -> FilePath -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
writeFile (FilePath
rpGit FilePath -> FilePath -> FilePath
</> FilePath
fn) FilePath
fc)
        [ (FilePath
"HEAD", FilePath
"ref: refs/heads/master")
        , ( FilePath
"description"
          , FilePath
"Unnamed repository; edit this file 'description' to name the repository."
          )
        , ( FilePath
"config"
          , FilePath
"[core]\n\trepositoryformatversion = 0\n\t" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
            FilePath
"filemode = true\n\tbare = false\n\tlogallrefupdates = true\n"
          )
        ]
  where
    rpGit :: FilePath
rpGit = FilePath
rp FilePath -> FilePath -> FilePath
</> FilePath
".git"
    rpGitDirs :: [FilePath]
rpGitDirs =
      (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
rpGit FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$  [FilePath
"branches", FilePath
"hooks", FilePath
"info"]
                       [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
"objects" FilePath -> FilePath -> FilePath
</>) [FilePath
"", FilePath
"info", FilePath
"pack"]
                       [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
"refs" FilePath -> FilePath -> FilePath
</>) [FilePath
"", FilePath
"heads", FilePath
"tags"]