refactor
This commit is contained in:
parent
f8e940eb8e
commit
2b14fe2c98
5 changed files with 20 additions and 22 deletions
8
Annex.hs
8
Annex.hs
|
@ -10,7 +10,6 @@
|
|||
module Annex (
|
||||
Annex,
|
||||
AnnexState(..),
|
||||
FileInfo(..),
|
||||
PreferredContentMap,
|
||||
new,
|
||||
newState,
|
||||
|
@ -55,6 +54,7 @@ import Types.TrustLevel
|
|||
import Types.Group
|
||||
import Types.Messages
|
||||
import Types.UUID
|
||||
import Types.FileMatcher
|
||||
import qualified Utility.Matcher
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
@ -74,12 +74,6 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
|
|||
)
|
||||
|
||||
type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
|
||||
|
||||
data FileInfo = FileInfo
|
||||
{ relFile :: FilePath -- may be relative to cwd
|
||||
, matchFile :: FilePath -- filepath to match on; may be relative to top
|
||||
}
|
||||
|
||||
type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FileInfo -> Annex Bool))
|
||||
|
||||
-- internal state storage
|
||||
|
|
|
@ -17,6 +17,7 @@ import Logs.Group
|
|||
import Logs.Remote
|
||||
import Annex.UUID
|
||||
import qualified Annex
|
||||
import Types.FileMatcher
|
||||
import Git.FilePath
|
||||
import Types.Remote (RemoteConfig)
|
||||
|
||||
|
@ -33,9 +34,9 @@ checkFileMatcher' matcher file notpresent def
|
|||
| isEmpty matcher = return def
|
||||
| otherwise = do
|
||||
matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
|
||||
let fi = Annex.FileInfo
|
||||
{ Annex.matchFile = matchfile
|
||||
, Annex.relFile = file
|
||||
let fi = FileInfo
|
||||
{ matchFile = matchfile
|
||||
, relFile = file
|
||||
}
|
||||
matchMrun matcher $ \a -> a notpresent fi
|
||||
|
||||
|
|
|
@ -35,6 +35,7 @@ import Config
|
|||
import Utility.Percentage
|
||||
import Logs.Transfer
|
||||
import Types.TrustLevel
|
||||
import Types.FileMatcher
|
||||
import qualified Limit
|
||||
|
||||
-- a named computation that produces a statistic
|
||||
|
@ -286,7 +287,7 @@ getLocalStatInfo dir = do
|
|||
where
|
||||
initial = (emptyKeyData, emptyKeyData)
|
||||
update matcher key file vs@(presentdata, referenceddata) =
|
||||
ifM (matcher $ Annex.FileInfo file file)
|
||||
ifM (matcher $ FileInfo file file)
|
||||
( (,)
|
||||
<$> ifM (inAnnex key)
|
||||
( return $ addKey key presentdata
|
||||
|
|
21
Limit.hs
21
Limit.hs
|
@ -32,11 +32,12 @@ import Logs.Trust
|
|||
import Types.TrustLevel
|
||||
import Types.Key
|
||||
import Types.Group
|
||||
import Types.FileMatcher
|
||||
import Logs.Group
|
||||
import Utility.HumanTime
|
||||
import Utility.DataUnits
|
||||
|
||||
type MatchFiles = AssumeNotPresent -> Annex.FileInfo -> Annex Bool
|
||||
type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool
|
||||
type MkLimit = String -> Either String MatchFiles
|
||||
type AssumeNotPresent = S.Set UUID
|
||||
|
||||
|
@ -46,10 +47,10 @@ limited = (not . Utility.Matcher.isEmpty) <$> getMatcher'
|
|||
|
||||
{- Gets a matcher for the user-specified limits. The matcher is cached for
|
||||
- speed; once it's obtained the user-specified limits can't change. -}
|
||||
getMatcher :: Annex (Annex.FileInfo -> Annex Bool)
|
||||
getMatcher :: Annex (FileInfo -> Annex Bool)
|
||||
getMatcher = Utility.Matcher.matchM <$> getMatcher'
|
||||
|
||||
getMatcher' :: Annex (Utility.Matcher.Matcher (Annex.FileInfo -> Annex Bool))
|
||||
getMatcher' :: Annex (Utility.Matcher.Matcher (FileInfo -> Annex Bool))
|
||||
getMatcher' = do
|
||||
m <- Annex.getState Annex.limit
|
||||
case m of
|
||||
|
@ -61,7 +62,7 @@ getMatcher' = do
|
|||
return matcher
|
||||
|
||||
{- Adds something to the limit list, which is built up reversed. -}
|
||||
add :: Utility.Matcher.Token (Annex.FileInfo -> Annex Bool) -> Annex ()
|
||||
add :: Utility.Matcher.Token (FileInfo -> Annex Bool) -> Annex ()
|
||||
add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
|
||||
where
|
||||
prepend (Left ls) = Left $ l:ls
|
||||
|
@ -92,11 +93,11 @@ limitExclude glob = Right $ const $ return . not . matchglob glob
|
|||
{- Could just use wildCheckCase, but this way the regex is only compiled
|
||||
- once. Also, we use regex-TDFA when available, because it's less buggy
|
||||
- in its support of non-unicode characters. -}
|
||||
matchglob :: String -> Annex.FileInfo -> Bool
|
||||
matchglob :: String -> FileInfo -> Bool
|
||||
matchglob glob fi =
|
||||
#ifdef WITH_TDFA
|
||||
case cregex of
|
||||
Right r -> case execute r (Annex.matchFile fi) of
|
||||
Right r -> case execute r (matchFile fi) of
|
||||
Right (Just _) -> True
|
||||
_ -> False
|
||||
Left _ -> error $ "failed to compile regex: " ++ regex
|
||||
|
@ -150,7 +151,7 @@ limitPresent u _ = Right $ const $ check $ \key -> do
|
|||
{- Limit to content that is in a directory, anywhere in the repository tree -}
|
||||
limitInDir :: FilePath -> MkLimit
|
||||
limitInDir dir = const $ Right $ const $ \fi -> return $
|
||||
any (== dir) $ splitPath $ takeDirectory $ Annex.matchFile fi
|
||||
any (== dir) $ splitPath $ takeDirectory $ matchFile fi
|
||||
|
||||
{- Adds a limit to skip files not believed to have the specified number
|
||||
- of copies. -}
|
||||
|
@ -228,7 +229,7 @@ limitSize vs s = case readSize dataUnits s of
|
|||
check fi sz Nothing = do
|
||||
filesize <- liftIO $ catchMaybeIO $
|
||||
fromIntegral . fileSize
|
||||
<$> getFileStatus (Annex.relFile fi)
|
||||
<$> getFileStatus (relFile fi)
|
||||
return $ filesize `vs` Just sz
|
||||
|
||||
addTimeLimit :: String -> Annex ()
|
||||
|
@ -244,5 +245,5 @@ addTimeLimit s = do
|
|||
liftIO $ exitWith $ ExitFailure 101
|
||||
else return True
|
||||
|
||||
lookupFile :: Annex.FileInfo -> Annex (Maybe (Key, Backend))
|
||||
lookupFile = Backend.lookupFile . Annex.relFile
|
||||
lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
|
||||
lookupFile = Backend.lookupFile . relFile
|
||||
|
|
3
Seek.hs
3
Seek.hs
|
@ -16,6 +16,7 @@ import System.PosixCompat.Files
|
|||
import Common.Annex
|
||||
import Types.Command
|
||||
import Types.Key
|
||||
import Types.FileMatcher
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Command
|
||||
|
@ -126,7 +127,7 @@ prepFiltered a fs = do
|
|||
matcher <- Limit.getMatcher
|
||||
map (process matcher) <$> fs
|
||||
where
|
||||
process matcher f = ifM (matcher $ Annex.FileInfo f f)
|
||||
process matcher f = ifM (matcher $ FileInfo f f)
|
||||
( a f , return Nothing )
|
||||
|
||||
notSymlink :: FilePath -> IO Bool
|
||||
|
|
Loading…
Reference in a new issue