git-monitor 1.1.0 → 1.3.0
raw patch · 2 files changed
+42/−37 lines, 2 filesdep ~gitlibdep ~gitlib-libgit2dep ~gitlib-utils
Dependency ranges changed: gitlib, gitlib-libgit2, gitlib-utils
Files
- Main.hs +38/−33
- git-monitor.cabal +4/−4
Main.hs view
@@ -14,23 +14,19 @@ import Control.Monad import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.ByteString as B (readFile)-import Data.Function (fix) import Data.Foldable (foldlM)+import Data.Function (fix) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Text (Text) import qualified Data.Text as T (Text, pack, unpack)-#if MIN_VERSION_shelly(1, 0, 0)-import qualified Data.Text as TL (Text, pack, unpack, init)-#else import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict, init)-#endif import Data.Time import Filesystem (getModified, isDirectory, isFile, canonicalizePath) import Filesystem.Path.CurrentOS (FilePath, (</>), parent, null) import Git hiding (Options)-import Git.Libgit2 (lgFactory, withLibGitDo)+import Git.Libgit2 (LgRepository, lgFactory, withLibGitDo) import Git.Utils (treeBlobEntries) import Options.Applicative import Prelude hiding (FilePath, null)@@ -43,11 +39,7 @@ import System.Log.Logger toStrict :: TL.Text -> T.Text-#if MIN_VERSION_shelly(1, 0, 0)-toStrict = id-#else toStrict = TL.toStrict-#endif instance Read FilePath @@ -154,12 +146,14 @@ -- | 'snapshotTree' is the core workhorse of this utility. It periodically -- checks the filesystem for changes to Git-tracked files, and snapshots -- any changes that have occurred in them.-snapshotTree :: (Repository m, MonadIO m)+snapshotTree :: MonadGit m => Options -> FilePath -> Text -> Text -> Text -> Text- -> Commit m -> Tree m -> TreeOid m- -> Map FilePath (FileEntry m)- -> m ()+ -> Commit (LgRepository m)+ -> Tree (LgRepository m) MutableTree+ -> TreeOid (LgRepository m)+ -> Map FilePath (FileEntry (LgRepository m))+ -> LgRepository m () snapshotTree opts wd name email ref sref = fix $ \loop sc str toid ft -> do -- Read the current working tree's state on disk ft' <- readFileTree ref wd False@@ -203,36 +197,40 @@ else loop sc' str toid' ft' where- scanOldEntry :: (Repository m, MonadIO m)- => Tree m- -> Map FilePath (FileEntry m)- -> FilePath -> FileEntry m -> m ()+ scanOldEntry :: MonadGit m+ => Tree (LgRepository m) MutableTree+ -> Map FilePath (FileEntry (LgRepository m))+ -> FilePath+ -> FileEntry (LgRepository m)+ -> LgRepository m () scanOldEntry str ft fp _ = case Map.lookup fp ft of Nothing -> do infoL $ "Removed: " ++ fileStr fp- dropFromTree str fp+ void $ unsafeMutateTree str $ dropEntry fp _ -> return () - scanNewEntry :: (Repository m, MonadIO m)- => Tree m- -> Map FilePath (FileEntry m)- -> FilePath -> FileEntry m -> m ()+ scanNewEntry :: MonadGit m+ => Tree (LgRepository m) MutableTree+ -> Map FilePath (FileEntry (LgRepository m))+ -> FilePath+ -> FileEntry (LgRepository m)+ -> LgRepository m () scanNewEntry str ft fp (FileEntry mt (BlobEntry oid exe) _) = case Map.lookup fp ft of Nothing -> do infoL $ "Added to snapshot: " ++ fileStr fp- putBlob' str fp oid exe+ void $ unsafeMutateTree str $ putBlob' fp oid exe Just (FileEntry oldMt (BlobEntry oldOid oldExe) fileOid) | oid /= oldOid || exe /= oldExe -> do infoL $ "Changed: " ++ fileStr fp- putBlob' str fp oid exe+ void $ unsafeMutateTree str $ putBlob' fp oid exe | mt /= oldMt || oid /= fileOid -> do path <- fileStr <$> liftIO (canonicalizePath (wd </> fp)) infoL $ "Changed: " ++ fileStr fp contents <- liftIO $ B.readFile path newOid <- createBlob (BlobString contents)- putBlob' str fp newOid exe+ void $ unsafeMutateTree str $ putBlob' fp newOid exe | otherwise -> return () _ -> return () scanNewEntry _str _ft _fp (FileEntry _mt _ _foid) = return ()@@ -245,8 +243,11 @@ type FileTree m = Map FilePath (FileEntry m) -readFileTree :: (Repository m, MonadIO m)- => Text -> FilePath -> Bool -> m (FileTree m)+readFileTree :: MonadGit m+ => Text+ -> FilePath+ -> Bool+ -> LgRepository m (FileTree (LgRepository m)) readFileTree ref wdir getHash = do h <- resolveRef ref case h of@@ -255,8 +256,9 @@ tr <- resolveTreeRef . commitTree =<< resolveCommitRef h' readFileTree' tr wdir getHash -readFileTree' :: (Repository m, MonadIO m)- => Tree m -> FilePath -> Bool -> m (FileTree m)+readFileTree' :: MonadGit m+ => Tree (LgRepository m) MutableTree -> FilePath -> Bool+ -> LgRepository m (FileTree (LgRepository m)) readFileTree' tr wdir getHash = do blobs <- treeBlobEntries tr foldlM (\m (fp,ent) -> do@@ -264,9 +266,12 @@ return $ maybe m (flip (Map.insert fp) m) fent) Map.empty blobs -readModTime :: (Repository m, MonadIO m)- => FilePath -> Bool -> FilePath -> TreeEntry m- -> m (Maybe (FileEntry m))+readModTime :: MonadGit m+ => FilePath+ -> Bool+ -> FilePath+ -> TreeEntry (LgRepository m)+ -> LgRepository m (Maybe (FileEntry (LgRepository m))) readModTime wdir getHash fp ent = do let path = wdir </> fp debugL $ "Checking file: " ++ fileStr path
git-monitor.cabal view
@@ -1,5 +1,5 @@ Name: git-monitor-Version: 1.1.0+Version: 1.3.0 Synopsis: Passively snapshots working tree changes efficiently. Description: Passively snapshots working tree changes efficiently.@@ -23,9 +23,9 @@ Build-depends: base >= 4 && < 5 , bytestring >= 0.9.2.1 , containers >= 0.4.2.1- , gitlib >= 1.0.1- , gitlib-utils >= 1.0.1- , gitlib-libgit2 >= 1.0.1+ , gitlib >= 1.1.0+ , gitlib-utils >= 1.1.0+ , gitlib-libgit2 >= 1.1.0 , hslogger >= 1.2 , old-locale >= 1.0.0.4 , optparse-applicative >= 0.5.2.1