git-monitor 3.1.1 → 3.1.1.1

raw patch · 3 files changed

+4/−65 lines, 3 filessetup-changed

Files

• Main.hs +1/−64
• Setup.hs +2/−0
• git-monitor.cabal +1/−1

@@ -10,8 +10,6 @@ module Main where  import           Control.Concurrent (threadDelay)-import           Control.Concurrent.Async.Lifted-import           Control.Exception import           Control.Logging import           Control.Monad import           Control.Monad.IO.Class (MonadIO(..))@@ -19,7 +17,6 @@ import           Control.Monad.Trans.Class import qualified Data.ByteString as B (readFile) import qualified Data.ByteString.Char8 as B8-import           Data.Foldable (foldl') import           Data.Function (fix) import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as Map@@ -29,8 +26,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import           Data.Time-import           Data.Time.Clock.POSIX (posixSecondsToUTCTime) import           Git hiding (Options)+import           Git.Tree.Working import           Git.Libgit2 (MonadLg, LgRepo, lgFactoryLogger) import           Options.Applicative import           Prelude hiding (log)@@ -38,7 +35,6 @@ import           System.Directory import           System.FilePath.Posix import           System.Locale (defaultTimeLocale)-import           System.Posix.Files  data Options = Options     { optQuiet      :: Bool@@ -228,64 +224,5 @@                     newOid   <- lift $ createBlob (BlobString contents)                     putBlob' fp newOid kind                 | otherwise -> return ()--data FileEntry m = FileEntry-    { fileModTime  :: UTCTime-    , fileBlobOid  :: BlobOid m-    , fileBlobKind :: BlobKind-    , fileChecksum :: BlobOid m-    }--type FileTree m = HashMap TreeFilePath (FileEntry m)--readFileTree :: (MonadGit LgRepo m, MonadLg m)-             => RefName-             -> FilePath-             -> Bool-             -> m (FileTree LgRepo)-readFileTree ref wdir getHash = do-    h <- resolveReference ref-    case h of-        Nothing -> pure Map.empty-        Just h' -> do-            tr <- lookupTree . commitTree =<< lookupCommit (Tagged h')-            readFileTree' tr wdir getHash--readFileTree' :: (MonadGit LgRepo m, MonadLg m)-              => Tree LgRepo -> FilePath -> Bool-              -> m (FileTree LgRepo)-readFileTree' tr wdir getHash = do-    blobs <- treeBlobEntries tr-    stats <- mapConcurrently go blobs-    return $ foldl' (\m (!fp,!fent) -> maybe m (flip (Map.insert fp) m) fent)-        Map.empty stats-  where-    go (!fp,!oid,!kind) = do-        fent <- readModTime wdir getHash (B8.unpack fp) oid kind-        fent `seq` return (fp,fent)--readModTime :: (MonadGit LgRepo m, MonadLg m)-            => FilePath-            -> Bool-            -> FilePath-            -> BlobOid LgRepo-            -> BlobKind-            -> m (Maybe (FileEntry LgRepo))-readModTime wdir getHash fp oid kind = do-    let path = wdir </> fp-    debug' $ pack $ "Checking file: " ++ path-    estatus <- liftIO $ try $ getSymbolicLinkStatus path-    case (estatus :: Either SomeException FileStatus) of-        Right status | isRegularFile status ->-            Just <$> (FileEntry-                          <$> pure (posixSecondsToUTCTime-                                    (realToFrac (modificationTime status)))-                          <*> pure oid-                          <*> pure kind-                          <*> if getHash-                              then hashContents . BlobString-                                  =<< liftIO (B.readFile path)-                              else return oid)-        _ -> return Nothing  -- Main.hs (git-monitor) ends here

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,5 +1,5 @@ Name:    git-monitor-Version: 3.1.1+Version: 3.1.1.1  Synopsis:    Passively snapshots working tree changes efficiently. Description: Passively snapshots working tree changes efficiently.