2013-02-14 20:17:40 +00:00
|
|
|
{- Caching a file's inode, size, and modification time to see when it's changed.
|
|
|
|
-
|
|
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Utility.InodeCache where
|
|
|
|
|
|
|
|
import Common
|
2013-05-11 20:03:00 +00:00
|
|
|
import System.PosixCompat.Types
|
2013-02-28 01:48:46 +00:00
|
|
|
import Utility.QuickCheck
|
2013-02-14 20:17:40 +00:00
|
|
|
|
2013-03-11 16:56:47 +00:00
|
|
|
data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime
|
|
|
|
deriving (Show, Eq, Ord)
|
|
|
|
|
|
|
|
newtype InodeCache = InodeCache InodeCachePrim
|
2013-03-11 06:57:48 +00:00
|
|
|
deriving (Show)
|
|
|
|
|
2013-03-11 16:56:47 +00:00
|
|
|
{- Inode caches can be compared in two different ways, either weakly
|
|
|
|
- or strongly. -}
|
|
|
|
data InodeComparisonType = Weakly | Strongly
|
|
|
|
deriving (Eq, Ord)
|
|
|
|
|
|
|
|
{- Strong comparison, including inodes. -}
|
2013-03-11 06:57:48 +00:00
|
|
|
compareStrong :: InodeCache -> InodeCache -> Bool
|
2013-03-11 16:56:47 +00:00
|
|
|
compareStrong (InodeCache x) (InodeCache y) = x == y
|
2013-02-14 20:17:40 +00:00
|
|
|
|
2013-03-11 16:56:47 +00:00
|
|
|
{- Weak comparison of the inode caches, comparing the size and mtime,
|
|
|
|
- but not the actual inode. Useful when inodes have changed, perhaps
|
2013-02-19 20:26:07 +00:00
|
|
|
- due to some filesystems being remounted. -}
|
|
|
|
compareWeak :: InodeCache -> InodeCache -> Bool
|
2013-03-11 16:56:47 +00:00
|
|
|
compareWeak (InodeCache (InodeCachePrim _ size1 mtime1)) (InodeCache (InodeCachePrim _ size2 mtime2)) =
|
2013-02-19 20:26:07 +00:00
|
|
|
size1 == size2 && mtime1 == mtime2
|
|
|
|
|
2013-03-11 16:56:47 +00:00
|
|
|
compareBy :: InodeComparisonType -> InodeCache -> InodeCache -> Bool
|
|
|
|
compareBy Strongly = compareStrong
|
|
|
|
compareBy Weakly = compareWeak
|
|
|
|
|
|
|
|
{- For use in a Map; it's determined at creation time whether this
|
|
|
|
- uses strong or weak comparison for Eq. -}
|
|
|
|
data InodeCacheKey = InodeCacheKey InodeComparisonType InodeCachePrim
|
|
|
|
deriving (Ord)
|
|
|
|
|
|
|
|
instance Eq InodeCacheKey where
|
|
|
|
(InodeCacheKey ctx x) == (InodeCacheKey cty y) =
|
|
|
|
compareBy (maximum [ctx,cty]) (InodeCache x ) (InodeCache y)
|
|
|
|
|
|
|
|
inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey
|
|
|
|
inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim
|
|
|
|
|
2013-02-14 20:17:40 +00:00
|
|
|
showInodeCache :: InodeCache -> String
|
2013-03-11 16:56:47 +00:00
|
|
|
showInodeCache (InodeCache (InodeCachePrim inode size mtime)) = unwords
|
2013-02-14 20:17:40 +00:00
|
|
|
[ show inode
|
|
|
|
, show size
|
|
|
|
, show mtime
|
|
|
|
]
|
|
|
|
|
|
|
|
readInodeCache :: String -> Maybe InodeCache
|
|
|
|
readInodeCache s = case words s of
|
2013-03-11 16:56:47 +00:00
|
|
|
(inode:size:mtime:_) ->
|
|
|
|
let prim = InodeCachePrim
|
|
|
|
<$> readish inode
|
|
|
|
<*> readish size
|
|
|
|
<*> readish mtime
|
|
|
|
in InodeCache <$> prim
|
2013-02-14 20:17:40 +00:00
|
|
|
_ -> Nothing
|
|
|
|
|
|
|
|
genInodeCache :: FilePath -> IO (Maybe InodeCache)
|
|
|
|
genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
|
|
|
|
|
|
|
|
toInodeCache :: FileStatus -> Maybe InodeCache
|
|
|
|
toInodeCache s
|
2013-03-11 16:56:47 +00:00
|
|
|
| isRegularFile s = Just $ InodeCache $ InodeCachePrim
|
2013-02-14 20:17:40 +00:00
|
|
|
(fileID s)
|
|
|
|
(fileSize s)
|
|
|
|
(modificationTime s)
|
|
|
|
| otherwise = Nothing
|
2013-02-28 01:42:07 +00:00
|
|
|
|
|
|
|
instance Arbitrary InodeCache where
|
2013-03-11 16:56:47 +00:00
|
|
|
arbitrary =
|
|
|
|
let prim = InodeCachePrim
|
|
|
|
<$> arbitrary
|
|
|
|
<*> arbitrary
|
|
|
|
<*> arbitrary
|
|
|
|
in InodeCache <$> prim
|
2013-02-28 01:42:07 +00:00
|
|
|
|
|
|
|
prop_read_show_inodecache :: InodeCache -> Bool
|
2013-03-11 06:57:48 +00:00
|
|
|
prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
|
|
|
|
Nothing -> False
|
|
|
|
Just c' -> compareStrong c c'
|