group-by-date 0.0.1 → 0.1

raw patch · 3 files changed

+41/−26 lines, 3 filesdep +pathtypedep −directorydep −filepath

Dependencies added: pathtype

Dependencies removed: directory, filepath

Files

• group-by-date.cabal +3/−5
• src/GroupByDate.hs +36/−20
• src/Main.hs +2/−1

@@ -1,5 +1,5 @@ Name:           group-by-date-Version:        0.0.1+Version:        0.1 License:        BSD3 License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -49,7 +49,7 @@ Build-Type:     Simple  Source-Repository this-  Tag:         0.0.1+  Tag:         0.1   Type:        darcs   Location:    http://hub.darcs.net/thielema/group-by-date/ @@ -61,9 +61,7 @@   Build-Depends:     hsshellscript >=3.1.0 && <3.4,     filemanip >=0.3.5 && <0.4,-    filepath >=1.3 && <1.5,-    -- version for directory needed for getModificationTime returning UTCTime-    directory >=1.2 && <1.4,+    pathtype >=0.8 && <0.9,     time >=1.5 && <1.9,     unix-compat >=0.3 && <0.5,     explicit-exception >=0.1 && <0.2,

@@ -1,9 +1,10 @@ module GroupByDate where -import qualified System.Directory as Dir import qualified System.PosixCompat.Files as Files-import qualified System.FilePath as FilePath-import System.FilePath ((</>), )+import qualified System.Path.Directory as Dir+import qualified System.Path.PartClass as PartClass+import qualified System.Path as Path+import System.Path ((</>), ) import HsShellScript.Shell (shell_quote, )  import qualified Data.Time.Format as Time@@ -11,56 +12,71 @@  import Text.Printf (printf, ) +import Control.Monad.HT ((<=<), ) import Control.Monad (when, )  -folderFromStatus :: String -> Files.FileStatus -> FilePath+folderFromStatus :: String -> Files.FileStatus -> Either String Path.AbsRelDir folderFromStatus fmt =+   Path.parse .    Time.formatTime Time.defaultTimeLocale fmt .    posixSecondsToUTCTime . realToFrac .    Files.modificationTime -folderFromPath :: String -> FilePath -> IO FilePath+parsePathIO :: (PartClass.FileDir fd) => FilePath -> IO (Path.AbsRel fd)+parsePathIO = either (ioError . userError) return . Path.parse++folderFromPath ::+   (PartClass.AbsRel ar) => String -> Path.File ar -> IO Path.AbsRelDir folderFromPath fmt =-   fmap (Time.formatTime Time.defaultTimeLocale fmt) .+   parsePathIO . Time.formatTime Time.defaultTimeLocale fmt <=<    Dir.getModificationTime  -makeDstPath :: FilePath -> FilePath -> FilePath-makeDstPath src dst = dst </> FilePath.takeFileName src+makeDstPath :: Path.File ar0 -> Path.Dir ar1 -> Path.File ar1+makeDstPath src dst = dst </> Path.takeFileName src -commandFromPath :: Bool -> String -> String -> FilePath -> IO ()+infixl 0 $/++($/) ::+   (PartClass.AbsRel ar, PartClass.FileDir fd) =>+   (FilePath -> a) -> (Path.Path ar fd -> a)+f $/ path = f $ Path.toString path++commandFromPath ::+   (PartClass.AbsRel ar) => Bool -> String -> String -> Path.File ar -> IO () commandFromPath fullDst cmd fmt src = do    dst <- folderFromPath fmt src    printf "mkdir -p %s && %s %s %s\n"-      (shell_quote dst)+      (shell_quote $/ dst)       cmd-      (shell_quote src)-      (shell_quote $-       if fullDst then makeDstPath src dst else dst)+      (shell_quote $/ src)+      (if fullDst+         then shell_quote $/ makeDstPath src dst+         else shell_quote $/ dst) -movePath :: String -> FilePath -> IO ()+movePath :: (PartClass.AbsRel ar) => String -> Path.File ar -> IO () movePath fmt src = do    dst <- folderFromPath fmt src    Dir.createDirectoryIfMissing True dst    Dir.renameFile src (makeDstPath src dst) -copyPath :: String -> FilePath -> IO ()+copyPath :: (PartClass.AbsRel ar) => String -> Path.File ar -> IO () copyPath fmt src = do    dstDir <- folderFromPath fmt src    Dir.createDirectoryIfMissing True dstDir    let dst = makeDstPath src dstDir    Dir.copyFile src dst-   status <- Files.getFileStatus src-   Files.setFileTimes dst+   status <- Files.getFileStatus $/ src+   (Files.setFileTimes $/ dst)       (Files.accessTime status) (Files.modificationTime status)    when False $       -- this could fail, if the owner is 'root' e.g. for data on removeable media-      Files.setOwnerAndGroup dst+      (Files.setOwnerAndGroup $/ dst)          (Files.fileOwner status) (Files.fileGroup status) -symLinkPath :: String -> FilePath -> IO ()+symLinkPath :: (PartClass.AbsRel ar) => String -> Path.File ar -> IO () symLinkPath fmt src = do    dst <- folderFromPath fmt src    Dir.createDirectoryIfMissing True dst-   Files.createSymbolicLink src (makeDstPath src dst)+   Files.createSymbolicLink $/ src $/ makeDstPath src dst

@@ -11,6 +11,7 @@  import qualified Control.Monad.Exception.Synchronous as Exc import Control.Monad.Trans.Class (lift, )+import Control.Monad.HT ((<=<), ) import Control.Monad (liftM, when, )  import Data.Foldable (forM_, )@@ -122,4 +123,4 @@                Copy -> GroupByDate.copyPath (optFormat flags)                SymLink -> GroupByDate.symLinkPath (optFormat flags) -      forM_ files $ lift . process+      forM_ files $ lift . (process <=< GroupByDate.parsePathIO)