{-# LANGUAGE OverloadedStrings #-}
module HMGit.Commands.Porcelain.Init.Core (
    RepositoryName
  , Init (..)
  , initDefault
  , initQuiet
  , init
) where

import           HMGit.Internal.Core.Runner (HMGitT)

import           Control.Exception.Safe     (MonadThrow)
import           Control.Monad.IO.Class     (MonadIO (..))
import qualified Data.ByteString.Lazy       as BL
import           Prelude                    hiding (init)
import           System.Directory           (createDirectoryIfMissing)
import           System.FilePath            ((</>))

type RepositoryName = String

newtype Init m = Init (RepositoryName -> HMGitT m ())

initBase :: MonadIO m
    => String
    -> RepositoryName
    -> HMGitT m ()
initBase :: String -> String -> HMGitT m ()
initBase String
gitName String
repoName = let hmGitRoot :: String
hmGitRoot = String
repoName String -> String -> String
</> String
gitName in IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> HMGitT m ()) -> IO () -> HMGitT m ()
forall a b. (a -> b) -> a -> b
$ (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True) (String -> [String]
dirs String
hmGitRoot)
    IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ByteString -> IO ()
BL.writeFile (String
hmGitRoot String -> String -> String
</> String
"HEAD") ByteString
"ref: refs/heads/master"
    where
        dirs :: String -> [String]
dirs String
hmGitRoot = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
hmGitRoot String -> String -> String
</>) [
            String
"objects"
          , String
"refs" String -> String -> String
</> String
"heads"
          ]

initDefault :: (MonadThrow m, MonadIO m) => String -> Init m
initDefault :: String -> Init m
initDefault String
gitName = (String -> HMGitT m ()) -> Init m
forall (m :: * -> *). (String -> HMGitT m ()) -> Init m
Init ((String -> HMGitT m ()) -> Init m)
-> (String -> HMGitT m ()) -> Init m
forall a b. (a -> b) -> a -> b
$ \String
repoName -> String -> String -> HMGitT m ()
forall (m :: * -> *). MonadIO m => String -> String -> HMGitT m ()
initBase String
gitName String
repoName
    HMGitT m () -> HMGitT m () -> HMGitT m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn (String
"Initialized empty HMGit repository in: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
repoName))

initQuiet :: MonadIO m => String -> Init m
initQuiet :: String -> Init m
initQuiet String
gitName = (String -> HMGitT m ()) -> Init m
forall (m :: * -> *). (String -> HMGitT m ()) -> Init m
Init ((String -> HMGitT m ()) -> Init m)
-> (String -> HMGitT m ()) -> Init m
forall a b. (a -> b) -> a -> b
$ String -> String -> HMGitT m ()
forall (m :: * -> *). MonadIO m => String -> String -> HMGitT m ()
initBase String
gitName

init :: (String -> Init m)
    -> String
    -> RepositoryName
    -> HMGitT m ()
init :: (String -> Init m) -> String -> String -> HMGitT m ()
init String -> Init m
initOpt String
gitName String
dir = case String -> Init m
initOpt String
gitName of Init String -> HMGitT m ()
f -> String -> HMGitT m ()
f String
dir