{-# 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