Follow symbolic links when doing validation
Needed for files stored with git-annex.
This commit is contained in:
parent
2dbcedb40e
commit
70fc7b8d31
@ -15,7 +15,6 @@ import System.FilePath
|
|||||||
import System.Directory
|
import System.Directory
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Control.Conditional (unlessM, whenM, unless, when)
|
import Control.Conditional (unlessM, whenM, unless, when)
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
import qualified Data.Conduit.List as CL
|
import qualified Data.Conduit.List as CL
|
||||||
@ -154,8 +153,15 @@ testDirFilter :: FindClause Bool
|
|||||||
testDirFilter = (SFF.fileType ==? Directory) &&? (SFF.fileName ~~? "dev-*"
|
testDirFilter = (SFF.fileType ==? Directory) &&? (SFF.fileName ~~? "dev-*"
|
||||||
||? SFF.fileName ~~? "test-*")
|
||? SFF.fileName ~~? "test-*")
|
||||||
|
|
||||||
|
fileTypeFollowed :: FindClause FileType
|
||||||
|
fileTypeFollowed = do
|
||||||
|
status <- followStatus
|
||||||
|
case status of
|
||||||
|
Just status' -> return $ statusType status'
|
||||||
|
Nothing -> fileType
|
||||||
|
|
||||||
fileFilter :: String -> FindClause Bool
|
fileFilter :: String -> FindClause Bool
|
||||||
fileFilter fileName = (SFF.fileType ==? RegularFile) &&? (SFF.fileName ~~? fileName ||? SFF.fileName ~~? fileName ++ exts)
|
fileFilter fileName = (fileTypeFollowed ==? RegularFile) &&? (SFF.fileName ~~? fileName ||? SFF.fileName ~~? fileName ++ exts)
|
||||||
where
|
where
|
||||||
exts = Prelude.concat [ "(", intercalate "|" compressedFilesHandled, ")" ]
|
exts = Prelude.concat [ "(", intercalate "|" compressedFilesHandled, ")" ]
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user