sizes 2.1.2 → 2.1.3

raw patch · 2 files changed

+20/−13 lines, 2 files

Files

• Main.hs +19/−12
• sizes.cabal +1/−1

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}  module Main where@@ -174,19 +175,24 @@ returnEmpty path = return (newEntry path False, DL.empty)  gatherSizes :: SizesOpts -> Int -> FilePath -> IO (EntryInfo, DList EntryInfo)-gatherSizes opts curDepth path =-  catch (go =<< if curDepth == 0-                then getFileStatus path'-                else getSymbolicLinkStatus path')-        (\e -> do putStrLn $ path' ++ ": " ++ show (e :: IOException)-                  returnEmpty path)+gatherSizes opts curDepth path = do+  excl <- if L.null (exclude opts)+          then return $ Right False+          else try $ return $ path' =~ exclude opts -- jww (2013-08-15): poor+  case excl of+    Left (_ :: SomeException) -> returnEmpty path+    Right True -> returnEmpty path+    _ ->+      catch (go =<< if curDepth == 0+                    then getFileStatus path'+                    else getSymbolicLinkStatus path')+            (\e -> do putStrLn $ path' ++ ": " ++ show (e :: IOException)+                      returnEmpty path)   where-    path'    = unpack (toTextIgnore path)-    annexRe  = unpack "\\.git/annex/"+    pathT = toTextIgnore path+    path' = unpack pathT      go status-      | not (L.null (exclude opts)) && path' =~ exclude opts = returnEmpty path-       | isDirectory status =         foldM (\(y, ys) x -> do                   (x',xs') <- gatherSizes opts (curDepth + 1) (collapse x)@@ -197,14 +203,15 @@                   return $! x'' `seq` xs'' `seq` (x'', xs''))               (newEntry path True, DL.empty) =<< listDirectory path -      | (isRegularFile status && not (annex opts && path' =~ annexRe))+      | (isRegularFile status+         && not (annex opts && ".git/annex/" `isInfixOf` pathT))         || (annex opts && isSymbolicLink status) = do         status' <-           -- If status is for a symbolic link, it must be a Git-annex'd file           if isSymbolicLink status           then do             destPath <- readSymbolicLink path'-            if destPath =~ annexRe+            if ".git/annex/" `L.isInfixOf` destPath               then do                 let destFilePath  = fromText (T.pack destPath)                     destPath'     = if relative destFilePath

@@ -1,6 +1,6 @@ Name: sizes -Version:  2.1.2+Version:  2.1.3 Synopsis: Recursively show space (size and i-nodes) used in subdirectories  Description: Recursively show space (size and i-nodes) used in subdirectories