module HMGit.Commands.Porcelain.Add.Core (
    Add (..)
  , AddCfg (..)
  , addDefault
  , addDryRun
) where

import           HMGit.Internal.Core             (IndexEntry (..),
                                                  ObjectInfo (..),
                                                  ObjectType (..), fromContents,
                                                  loadIndex, storeIndex,
                                                  storeObject)
import           HMGit.Internal.Core.Runner      (HMGitT, hmGitRoot)
import           HMGit.Internal.Parser.Pathspecs (lsMatches)

import           Control.Exception.Safe          (MonadCatch, MonadThrow)
import           Control.Monad                   (forM)
import           Control.Monad.IO.Class          (MonadIO (..))
import qualified Data.ByteString                 as B
import qualified Data.ByteString.Lazy            as BL
import           Data.Functor                    ((<&>))
import           Data.List                       (sortBy)
import           Data.Ratio                      (numerator)
import qualified Data.Set                        as S
import qualified Path                            as P
import qualified Path.IO                         as P
import           System.Posix.Files
import           Text.Printf                     (printf)

newtype Add m = Add { Add m -> AddCfg -> HMGitT m ()
add :: AddCfg -> HMGitT m () }

newtype AddCfg = AddCfg {
    AddCfg -> [FilePath]
addPathspecs :: [FilePath]
  }

type BlobGenerator m = BL.ByteString -> HMGitT m B.ByteString

existEntries :: (MonadThrow m, MonadIO m)
    => S.Set (P.Path P.Abs P.File)
    -> HMGitT m [IndexEntry]
existEntries :: Set (Path Abs File) -> HMGitT m [IndexEntry]
existEntries Set (Path Abs File)
paths = do
    Path Abs Dir
root <- HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot
    [Path Rel File]
paths' <- (Path Abs File -> ReaderT HMGitConfig m (Path Rel File))
-> [Path Abs File] -> ReaderT HMGitConfig m [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Path Abs Dir
-> Path Abs File -> ReaderT HMGitConfig m (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
P.stripProperPrefix Path Abs Dir
root) ([Path Abs File] -> ReaderT HMGitConfig m [Path Rel File])
-> [Path Abs File] -> ReaderT HMGitConfig m [Path Rel File]
forall a b. (a -> b) -> a -> b
$ Set (Path Abs File) -> [Path Abs File]
forall a. Set a -> [a]
S.toList Set (Path Abs File)
paths
    HMGitT m [IndexEntry]
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
HMGitT m [IndexEntry]
loadIndex HMGitT m [IndexEntry]
-> ([IndexEntry] -> [IndexEntry]) -> HMGitT m [IndexEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (IndexEntry -> Bool) -> [IndexEntry] -> [IndexEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (IndexEntry -> Bool) -> IndexEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel File -> [Path Rel File] -> Bool)
-> [Path Rel File] -> Path Rel File -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path Rel File -> [Path Rel File] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Path Rel File]
paths' (Path Rel File -> Bool)
-> (IndexEntry -> Path Rel File) -> IndexEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> Path Rel File
iePath)

additionalEntries :: (MonadCatch m, MonadIO m)
    => BlobGenerator m
    -> S.Set (P.Path P.Abs P.File)
    -> HMGitT m [IndexEntry]
additionalEntries :: BlobGenerator m -> Set (Path Abs File) -> HMGitT m [IndexEntry]
additionalEntries BlobGenerator m
blobGen Set (Path Abs File)
paths = [Path Abs File]
-> (Path Abs File -> ReaderT HMGitConfig m IndexEntry)
-> HMGitT m [IndexEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Set (Path Abs File) -> [Path Abs File]
forall a. Set a -> [a]
S.toList Set (Path Abs File)
paths) ((Path Abs File -> ReaderT HMGitConfig m IndexEntry)
 -> HMGitT m [IndexEntry])
-> (Path Abs File -> ReaderT HMGitConfig m IndexEntry)
-> HMGitT m [IndexEntry]
forall a b. (a -> b) -> a -> b
$ \Path Abs File
p -> do
    ByteString
sha1 <- IO ByteString -> ReaderT HMGitConfig m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BL.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Path Abs File
p)
        ReaderT HMGitConfig m ByteString
-> BlobGenerator m -> ReaderT HMGitConfig m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BlobGenerator m
blobGen
        ReaderT HMGitConfig m ByteString
-> (ByteString -> ByteString) -> ReaderT HMGitConfig m ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> ByteString
BL.fromStrict
    FileStatus
stat <- IO FileStatus -> ReaderT HMGitConfig m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> ReaderT HMGitConfig m FileStatus)
-> IO FileStatus -> ReaderT HMGitConfig m FileStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
getFileStatus (FilePath -> IO FileStatus) -> FilePath -> IO FileStatus
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Path Abs File
p
    Path Abs Dir
root <- HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot
    Path Rel File
p' <- Path Abs Dir
-> Path Abs File -> ReaderT HMGitConfig m (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
P.stripProperPrefix Path Abs Dir
root Path Abs File
p
    IndexEntry -> ReaderT HMGitConfig m IndexEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndexEntry -> ReaderT HMGitConfig m IndexEntry)
-> IndexEntry -> ReaderT HMGitConfig m IndexEntry
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word16
-> Path Rel File
-> IndexEntry
IndexEntry
        (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Int
forall a. Enum a => a -> Int
fromEnum (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ EpochTime -> Rational
forall a. Real a => a -> Rational
toRational (EpochTime -> Rational) -> EpochTime -> Rational
forall a b. (a -> b) -> a -> b
$ FileStatus -> EpochTime
statusChangeTime FileStatus
stat)
        (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational) -> POSIXTime -> Rational
forall a b. (a -> b) -> a -> b
$ FileStatus -> POSIXTime
statusChangeTimeHiRes FileStatus
stat)
        (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Int
forall a. Enum a => a -> Int
fromEnum (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ EpochTime -> Rational
forall a. Real a => a -> Rational
toRational (EpochTime -> Rational) -> EpochTime -> Rational
forall a b. (a -> b) -> a -> b
$ FileStatus -> EpochTime
modificationTime FileStatus
stat)
        (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational) -> POSIXTime -> Rational
forall a b. (a -> b) -> a -> b
$ FileStatus -> POSIXTime
modificationTimeHiRes FileStatus
stat)
        (DeviceID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DeviceID -> Word32) -> DeviceID -> Word32
forall a b. (a -> b) -> a -> b
$ FileStatus -> DeviceID
deviceID FileStatus
stat)
        (FileID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileID -> Word32) -> FileID -> Word32
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileID
fileID FileStatus
stat)
        (FileStatus -> Word32
forall p. Num p => FileStatus -> p
fileModeRegular FileStatus
stat)
        (UserID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UserID -> Word32) -> UserID -> Word32
forall a b. (a -> b) -> a -> b
$ FileStatus -> UserID
fileOwner FileStatus
stat)
        (GroupID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GroupID -> Word32) -> GroupID -> Word32
forall a b. (a -> b) -> a -> b
$ FileStatus -> GroupID
fileGroup FileStatus
stat)
        (FileOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Word32) -> FileOffset -> Word32
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileOffset
fileSize FileStatus
stat)
        ByteString
sha1
        (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Path Abs File
p)
        Path Rel File
p'
    where
        fileModeRegular :: FileStatus -> p
fileModeRegular FileStatus
stat
            | FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
0o100664 = p
0o100644
            | Bool
otherwise = FileMode -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileMode -> p) -> FileMode -> p
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileMode
fileMode FileStatus
stat

addDefault :: (MonadIO m, MonadCatch m) => Add m
addDefault :: Add m
addDefault = (AddCfg -> HMGitT m ()) -> Add m
forall (m :: * -> *). (AddCfg -> HMGitT m ()) -> Add m
Add ((AddCfg -> HMGitT m ()) -> Add m)
-> (AddCfg -> HMGitT m ()) -> Add m
forall a b. (a -> b) -> a -> b
$ \AddCfg
addCfg -> do
    Set (Path Abs File)
paths <- ReaderT HMGitConfig m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
P.getCurrentDir ReaderT HMGitConfig m (Path Abs Dir)
-> (Path Abs Dir -> ReaderT HMGitConfig m (Set (Path Abs File)))
-> ReaderT HMGitConfig m (Set (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Path Abs Dir
 -> [FilePath] -> ReaderT HMGitConfig m (Set (Path Abs File)))
-> [FilePath]
-> Path Abs Dir
-> ReaderT HMGitConfig m (Set (Path Abs File))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path Abs Dir
-> [FilePath] -> ReaderT HMGitConfig m (Set (Path Abs File))
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Path Abs Dir -> [FilePath] -> HMGitT m (Set (Path Abs File))
lsMatches (AddCfg -> [FilePath]
addPathspecs AddCfg
addCfg)
    ([IndexEntry] -> [IndexEntry] -> [IndexEntry]
forall a. Semigroup a => a -> a -> a
(<>) ([IndexEntry] -> [IndexEntry] -> [IndexEntry])
-> ReaderT HMGitConfig m [IndexEntry]
-> ReaderT HMGitConfig m ([IndexEntry] -> [IndexEntry])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Path Abs File) -> ReaderT HMGitConfig m [IndexEntry]
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
Set (Path Abs File) -> HMGitT m [IndexEntry]
existEntries Set (Path Abs File)
paths ReaderT HMGitConfig m ([IndexEntry] -> [IndexEntry])
-> ReaderT HMGitConfig m [IndexEntry]
-> ReaderT HMGitConfig m [IndexEntry]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlobGenerator m
-> Set (Path Abs File) -> ReaderT HMGitConfig m [IndexEntry]
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
BlobGenerator m -> Set (Path Abs File) -> HMGitT m [IndexEntry]
additionalEntries (ObjectType -> BlobGenerator m
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
ObjectType -> ByteString -> HMGitT m ByteString
storeObject ObjectType
Blob) Set (Path Abs File)
paths)
        ReaderT HMGitConfig m [IndexEntry]
-> ([IndexEntry] -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IndexEntry] -> HMGitT m ()
forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Foldable t) =>
t IndexEntry -> HMGitT m ()
storeIndex ([IndexEntry] -> HMGitT m ())
-> ([IndexEntry] -> [IndexEntry]) -> [IndexEntry] -> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndexEntry -> IndexEntry -> Ordering)
-> [IndexEntry] -> [IndexEntry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\IndexEntry
x IndexEntry
y -> Path Rel File -> Path Rel File -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IndexEntry -> Path Rel File
iePath IndexEntry
x) (IndexEntry -> Path Rel File
iePath IndexEntry
y))

addDryRun :: (MonadCatch m, MonadIO m) => Add m
addDryRun :: Add m
addDryRun = (AddCfg -> HMGitT m ()) -> Add m
forall (m :: * -> *). (AddCfg -> HMGitT m ()) -> Add m
Add ((AddCfg -> HMGitT m ()) -> Add m)
-> (AddCfg -> HMGitT m ()) -> Add m
forall a b. (a -> b) -> a -> b
$ \AddCfg
addCfg -> ReaderT HMGitConfig m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
P.getCurrentDir
    ReaderT HMGitConfig m (Path Abs Dir)
-> (Path Abs Dir -> ReaderT HMGitConfig m (Set (Path Abs File)))
-> ReaderT HMGitConfig m (Set (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Path Abs Dir
 -> [FilePath] -> ReaderT HMGitConfig m (Set (Path Abs File)))
-> [FilePath]
-> Path Abs Dir
-> ReaderT HMGitConfig m (Set (Path Abs File))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path Abs Dir
-> [FilePath] -> ReaderT HMGitConfig m (Set (Path Abs File))
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Path Abs Dir -> [FilePath] -> HMGitT m (Set (Path Abs File))
lsMatches (AddCfg -> [FilePath]
addPathspecs AddCfg
addCfg)
    ReaderT HMGitConfig m (Set (Path Abs File))
-> (Set (Path Abs File) -> ReaderT HMGitConfig m [IndexEntry])
-> ReaderT HMGitConfig m [IndexEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BlobGenerator m
-> Set (Path Abs File) -> ReaderT HMGitConfig m [IndexEntry]
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
BlobGenerator m -> Set (Path Abs File) -> HMGitT m [IndexEntry]
additionalEntries ((ObjectInfo -> ByteString)
-> ReaderT HMGitConfig m ObjectInfo
-> ReaderT HMGitConfig m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectInfo -> ByteString
objectId (ReaderT HMGitConfig m ObjectInfo
 -> ReaderT HMGitConfig m ByteString)
-> (ByteString -> ReaderT HMGitConfig m ObjectInfo)
-> BlobGenerator m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> ByteString -> ReaderT HMGitConfig m ObjectInfo
forall (m :: * -> *).
MonadCatch m =>
ObjectType -> ByteString -> HMGitT m ObjectInfo
fromContents ObjectType
Blob)
    ReaderT HMGitConfig m [IndexEntry]
-> ([IndexEntry] -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IndexEntry -> HMGitT m ()) -> [IndexEntry] -> HMGitT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HMGitT m ())
-> (IndexEntry -> IO ()) -> IndexEntry -> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (IndexEntry -> FilePath) -> IndexEntry -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"add '%s'" (FilePath -> FilePath)
-> (IndexEntry -> FilePath) -> IndexEntry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath (Path Rel File -> FilePath)
-> (IndexEntry -> Path Rel File) -> IndexEntry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> Path Rel File
iePath)