packages feed

photoname 2.0 → 2.1

raw patch · 10 files changed

+241/−254 lines, 10 files

Files

README view
@@ -12,8 +12,7 @@ and the usually-camera-assigned serial number, often appearing in the filename. -This program is known to work with GHC 6.8.2 on systems where System.Posix-(unix) packages are available.+This program is known to work with GHC 6.8.3 (and probably still 6.8.2) on systems where System.Posix (unix) packages are available.   *install*@@ -24,5 +23,3 @@    $ runhaskell Setup.lhs build    $ runhaskell Setup.lhs test    $ runhaskell Setup.lhs install--A Debian .deb package is available for this project at its home page: http://ui3.info/d/proj/photoname.html
TODO view
@@ -1,13 +1,5 @@-- I wonder if changing to record style for the Opts.Flags would make any of the code simpler in Main- - Add support for different camera filename formats, check with the Olympus. -- Rewrite buildNewPath with MaybeT?-   see: http://haskell.org/haskellwiki/New_monads/MaybeT---features that would be nice:- - First, I think I'd like to see the PARENTDIR argument become a named switch (-d --parent-dir), to better differentiate it from the list of files to be processed.  - Second, I'd like to start using a config file (~/.photoname) that will contain things like default parent dir:@@ -29,4 +21,4 @@  - Deal gracefully with unknown dates. This means not just putting pictures into the 0000/0000-00-00 directory, but making sure that the _### serial number part is incremented from the highest one in there. -- Allow additional switch for part of filenames for initials of photographer: _xyz+- Allow additional switch for part of filenames for initials of photographer: _xyz  Call this the suffix? (-s --suffix)
doc/dev/notes view
@@ -1,7 +1,5 @@ ------rearchitecture of Main:--flags used in: createNewLink, executeCommands, main+Do something with this, better error checking?  - Parse arguments - Look at args, cases:
doc/hcar-photoname view
@@ -15,6 +15,10 @@  photoname is a command-line utility for renaming/moving photo image files. The new folder location and naming are determined by the EXIF photo shoot date and the usually-camera-assigned serial number, often appearing in the filename. +Between versions 2.0 and 2.1 the software is largely the same on the outside but has undergone extensive changes inside. Most of this involving redesign with monad transformers.++photoname is on Hackage and can be acquired using darcs or other methods. See the project page below for more.+  Further reading
photoname.cabal view
@@ -1,5 +1,6 @@ name:                photoname-version:             2.0+cabal-version:       >= 1.2+version:             2.1 build-type:          Simple license:             BSD3 license-file:        LICENSE@@ -13,10 +14,11 @@    Command-line utility for renaming/moving photo image files based on     EXIF tags. Written in Haskell. category:            Unclassified-tested-with:         GHC==6.8.2+tested-with:         GHC>=6.8.2 -executable:          photoname-build-depends:       base, exif, filepath, mtl, old-locale, parsec, time, unix-main-is:             Main.hs-ghc-options:         -Wall-hs-source-dirs:      src+executable           photoname+   main-is:          photoname.hs+   build-depends:    base, exif, filepath, mtl, old-locale, parsec, +                     time, unix+   ghc-options:      -Wall+   hs-source-dirs:   src
− src/Main.hs 
@@ -1,179 +0,0 @@--- Copyright: 2007, 2008 Dino Morelli--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module Main-   where--import Control.Monad.Reader-import Control.Monad.Writer-import qualified Graphics.Exif as Exif-import Photoname.Date-import qualified Photoname.Opts as Opts-import Photoname.Serial ( getSerial )-import System.Environment ( getArgs )-import System.FilePath-import System.Posix---modeDir :: FileMode-modeDir = ownerModes       `unionFileModes`-          groupReadMode    `unionFileModes`-          groupExecuteMode---{- Given a list of lists, make a new list where each sublist element -   consists of the accumulation of all parts that came before it. -   Like this:-      before: [[1], [2], [3], [4], [5]]-      after : [[1], [1,2], [1,2,3], [1,2,3,4], [1,2,3,4,5]]--   Many thanks to Betty Diegel for help with this algorithm.--}-listAcc :: [[a]] -> [[a]]-listAcc []     = [[]]-listAcc (x:xs) = listAcc' x xs-   where-      listAcc' l (y:ys) = [l] ++ listAcc' (l ++ y) ys-      listAcc' l []     = [l]---{- Execute a sequence of m (Maybe a) actions until the first non-Nothing-   evaluation, eval to that.--   Thanks to sjanssen et al on #haskell--   XXX Can this be genericized to be :: (Monad m, Monad n) =>-       [m (n a)] -> m (n a)-   XXX Put this in a more common module.--}-firstSuccess :: Monad m => [m (Maybe a)] -> m (Maybe a)-firstSuccess = foldr f (return Nothing)-   where-      f :: Monad t => t (Maybe m1) -> t (Maybe m1) -> t (Maybe m1)-      f m ms = do  -- m in here, NOT Maybe-         x <- m-         case x of-            Just _  -> return x-            Nothing -> ms---{- Get shoot date from the exif information. There are several tags -   potentially containing dates. Try them in a specific order until we-   find one that has data.--}-getDate :: Exif.Exif -> IO (Maybe String)-getDate exif =-   firstSuccess $ map (Exif.getTag exif)-      ["DateTimeDigitized", "DateTimeOriginal", "DateTime"]---{- Take a file path to a JPEG file and use EXIF information available to -   move the file to a new location below the given basedir.--}-createNewLink :: FilePath -> FilePath -> Ph ()-createNewLink newDir oldPath = do-   flags <- ask-   e <- liftIO $ buildNewPath newDir oldPath-   case e of-      Left err      -> tell [err]-      Right newPath -> do-         -- Check for existance of the target file-         exists <- liftIO $ fileExist newPath-         if exists-            then tell-               ["** " ++ oldPath ++ " -> " ++ newPath ++ " exists!"]-            else do-               -- Display what will be done-               unless (Opts.Quiet `elem` flags) $ -                  tell [(oldPath ++ " -> " ++ newPath)]--               unless (Opts.NoAction `elem` flags) $ do-                  -- Make the target dir-                  liftIO $ makeDirectory $ takeDirectory newPath--                  -- Make the new hard link-                  liftIO $ createLink oldPath newPath--                  -- If user has specified, remove the original link-                  when (Opts.Move `elem` flags) $-                     liftIO $ removeLink oldPath---{- Ensuring that a directory with subs exists turned out to be a painful -   process involving making each parent dir piece by piece but not trying-   to make anything that's already there.--}-makeDirectory :: FilePath -> IO ()-makeDirectory d =-   let makeOneDir dir = do-         exists <- fileExist dir-         unless exists $ createDirectory dir modeDir-   in  mapM_ makeOneDir $ listAcc $ splitPath d---{- Given a path to a file with EXIF data, construct a new path based on the-   date and some serial number info we can parse out of the filename.-   This function got complicated, there are several ways this can fail.--}-buildNewPath :: FilePath -> FilePath -> IO (Either String FilePath)-buildNewPath newDir oldPath = do-   exif <- Exif.fromFile oldPath-   maybeDs <- getDate exif-   case maybeDs of-      Just ds  -> do-         let date = readDate ds-         let maybeSerial = getSerial oldPath-         case maybeSerial of-            Just serial -> do-               let year = formatYear date-               let day = formatDay date-               let prefix = formatPrefix date-               return $ Right $ newDir </> year </> day </> -                  (prefix ++ "_" ++ serial) <.> "jpg"-            Nothing -> return $ Left $ "File " ++ oldPath ++ " has no serial."-      Nothing  -> return $ Left $ "File " ++ oldPath ++ " has no EXIF date."----- Figure out and execute what the user wants based on the supplied args.-executeCommands :: [String] -> Ph ()---- User gave no files at all. Display help-executeCommands [] = tell [Opts.usageText]---- Normal program operation, process the files with the args.-executeCommands (dir:filePaths) = do-   flags <- ask--   -- Get rid of anything not a regular file from the list of paths-   actualPaths <- liftIO $ filterM-      (\p -> getFileStatus p >>= return . isRegularFile) filePaths--   -- Notify user of the switches that will be in effect.-   when (Opts.NoAction `elem` flags) $-      tell ["No-action mode, nothing will be changed."]--   when (Opts.Move `elem` flags) $-      tell ["Removing original links after new links are in place."]--   -- Do the link manipulations.-   mapM_ (createNewLink dir) actualPaths---type Ph a = ReaderT [Opts.Flag] (WriterT [String] IO) a--runMain :: [Opts.Flag] -> Ph a -> IO (a, [String])-runMain env exec = runWriterT $ runReaderT exec env--main :: IO ()-main = do-   -- Parse the arguments-   (flags, paths) <- getArgs >>= Opts.parseOpts--   -- Do the photo naming procedure-   (rval, messages) <- runMain flags $ executeCommands paths--   -- Display collected output log-   putStrLn $ unlines messages--   return rval
src/Photoname/Opts.hs view
@@ -3,8 +3,7 @@ -- Author: Dino Morelli <dino@ui3.info>  module Photoname.Opts-   ( Flag (..)-   , Opts+   ( Options (..)    , parseOpts, usageText    )    where@@ -12,37 +11,45 @@ import System.Console.GetOpt  -data Flag-   = NoAction-   | Quiet-   | Move-   | Help-   deriving Eq+data Options = Options+   { optNoAction :: Bool+   , optQuiet :: Bool+   , optMove :: Bool+   , optHelp :: Bool+   }  --- A convenience type representing all flags and all non-flag strings--- that came in from outside-type Opts = ([Flag], [String])+defaultOptions :: Options+defaultOptions = Options+   { optNoAction = False+   , optQuiet = False+   , optMove = False+   , optHelp = False+   }  -options :: [OptDescr Flag]+options :: [OptDescr (Options -> Options)] options =-   [ Option ['n'] ["no-action"] (NoArg NoAction) -         "Display what would be done, but do nothing"-   , Option ['q'] ["quiet"] (NoArg Quiet) -         "Suppress normal output of what's being done"-   , Option []    ["move"] (NoArg Move)-         "Move the files, don't just hard-link to the new locations"-   , Option ['h'] ["help"] (NoArg Help)-         "This help text"+   [ Option ['n'] ["no-action"]+      (NoArg (\opts -> opts { optNoAction = True } )) +      "Display what would be done, but do nothing"+   , Option ['q'] ["quiet"] +      (NoArg (\opts -> opts { optQuiet = True } )) +      "Suppress normal output of what's being done"+   , Option []    ["move"] +      (NoArg (\opts -> opts { optMove = True } ))+      "Move the files, don't just hard-link to the new locations"+   , Option ['h'] ["help"] +      (NoArg (\opts -> opts { optHelp = True } ))+      "This help text"    ]  -parseOpts :: [String] -> IO Opts+parseOpts :: [String] -> IO (Options, [String]) parseOpts argv =     case getOpt Permute options argv of-      (o,n,[]  ) -> return (o,n)-      (_,_,errs) -> ioError (userError (concat errs ++ usageText))+      (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)+      (_,_,errs) -> ioError $ userError (concat errs ++ usageText)   usageText :: String@@ -55,23 +62,22 @@          , "Options:"          ]       footer = init $ unlines-         [ "This software is for renaming and storing your digital photos. It will extract"-         , "shoot date from the EXIF data in the image file and use that along with the"-         , "usually-camera-assigned serial number to build a meaningful filename."+         [ "This software is for renaming and storing your digital photos. It will extract shoot date from the EXIF data in the image file and use that along with the usually-camera-assigned serial number to build a meaningful filename."          , ""-         , "You get a subdirectory hierarchy consisting of directories for the years,"-         , "then subdirs within those for the day photos were shot. These day dirs"-         , "contain the image files, renamed as follows:"+         , "You get a subdirectory hierarchy consisting of directories for the years, then subdirs within those for the day photos were shot. These day dirs contain the image files, renamed as follows:"          , ""          , "A photo shot on 2002-May-02 with a Canon camera:"          , "   img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502_790.jpg"          , ""-         , "The <PARENTDIR> is the one given on the command-line to this utility, and"-         , "represents the top-level of where you're storing photos."+         , "The code is basically looking for three digits before the file extension to use as a 'serial' number for the day's photos. This is a seemingly common occurrance with cameras that we can pick numbers off the end of the filename, or at least I hope that's the case. Examples of the two that I have:"          , ""-         , "Note that the default behavior of this software is to create hard links to"-         , "the new paths and leave the original links as they were. You can use the"-         , "--move switch to blow away the original location, leaving only the new."+         , "                    vvv (use these digits)"+         , "   Panasonic:  P###0###.jpg"+         , "   Canon:      img_####.jpg"+         , "                    ^^^"+         , "The <PARENTDIR> is the one given on the command-line to this utility, and represents the top-level of where you're storing photos."          , ""-         , "Version 2.0  2008-Mar-04  Dino Morelli <dino@ui3.info>"+         , "Note that the default behavior of this software is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to blow away the original location, leaving only the new."+         , ""+         , "Version 2.1  2008-Oct-10  Dino Morelli <dino@ui3.info>"          ]
src/Photoname/Serial.hs view
@@ -2,16 +2,19 @@ -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> -module Photoname.Serial (-   getSerial-)+{-# LANGUAGE FlexibleContexts #-}++module Photoname.Serial+   ( getSerial+   )    where ---import Debug.Trace+import Control.Monad.Error import Text.ParserCombinators.Parsec  --- Combinator similar to manyTill, but evaluates to end instead of p+{- Combinator similar to manyTill, but evaluates to end instead of p+-} skipTill :: GenParser tok st t1 -> GenParser tok st t -> GenParser tok st t skipTill p end = scan    where@@ -30,13 +33,11 @@       return serial             -- Return those 3 digits  --- Evaluates one or more parsers trying to find the serial number in the--- supplied path. Transforms the result from Either to Maybe-getSerial :: FilePath -> Maybe String-getSerial s =-   case (parse parser "" s) of-      Left _  -> Nothing-      --Left err  -> trace (show err) Nothing-      Right x -> Just x-   where-      parser = serialNum+{- Evaluates one or more parsers trying to find the serial number in the+   supplied path. Transforms the result from Either to Maybe+-}+getSerial :: (MonadError String m) => String -> m String+getSerial path =+   case (parse serialNum "" path) of+      Left _  -> throwError $ "File " ++ path ++ " has no serial"+      Right serial -> return serial
+ src/photoname.hs view
@@ -0,0 +1,166 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++{-# LANGUAGE FlexibleContexts #-}++import Control.Monad.Error+import Control.Monad.Reader+import Graphics.Exif ( fromFile, getTag )+import System.Environment ( getArgs )+import System.FilePath+import System.Posix++import Photoname.Date+import Photoname.Opts ( Options (..) , parseOpts, usageText )+import Photoname.Serial ( getSerial )+++type Ph a = ReaderT Options IO a+++runRename :: Options -> Ph a -> IO a+runRename env action = runReaderT action env+++modeDir :: FileMode+modeDir = ownerModes       `unionFileModes`+          groupReadMode    `unionFileModes`+          groupExecuteMode+++{- Get shoot date from the exif information. There are several tags +   potentially containing dates. Try them in a specific order until we+   find one that has data.+-}+getDate :: (MonadError String m, MonadIO m) => FilePath -> m String+getDate path = do+   exif <- liftIO $ fromFile path++   -- This foldl gets us the first IO (Maybe String) that's not Nothing+   maybeDate <- liftIO $ foldl (liftM2 mplus) (return Nothing) $+      map (getTag exif)+      ["DateTimeDigitized", "DateTimeOriginal", "DateTime"]++   case maybeDate of+      Just d -> return d+      Nothing  -> throwError $ "File " ++ path ++ " has no EXIF date"+++{- Take a file path to a JPEG file and use EXIF information available to +   move the file to a new location below the given basedir.+-}+createNewLink :: FilePath -> FilePath -> Ph ()+createNewLink newDir oldPath = do+   opts <- ask+   result <- liftIO $ runErrorT $ do+      newPath <- buildNewPath newDir oldPath++      -- Check for existance of the target file+      exists <- liftIO $ fileExist newPath+      when exists $ throwError $+         "** " ++ oldPath ++ " -> " ++ newPath ++ " exists!"++      -- Display what will be done+      unless (optQuiet opts) $ +         liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath++      unless (optNoAction opts) $ do+         -- Make the target dir+         liftIO $ makeDirectory $ takeDirectory newPath++         -- Make the new hard link+         liftIO $ createLink oldPath newPath++         -- If user has specified, remove the original link+         when (optMove opts) $+            liftIO $ removeLink oldPath++      return ()++   case result of+      Left errMsg -> liftIO $ putStrLn errMsg+      Right _ -> return ()+++{- Given a list of lists, make a new list where each sublist element +   consists of the accumulation of all parts that came before it. +   Like this:+      before: [[1], [2], [3], [4], [5]]+      after : [[1], [1,2], [1,2,3], [1,2,3,4], [1,2,3,4,5]]++   Many thanks to Betty Diegel for help with this algorithm.++   FIXME Try to rewrite this with a scan or something+-}+listAcc :: [[a]] -> [[a]]+listAcc []     = [[]]+listAcc (x:xs) = listAcc' x xs+   where+      listAcc' l (y:ys) = [l] ++ listAcc' (l ++ y) ys+      listAcc' l []     = [l]+++{- Ensuring that a directory with subs exists turned out to be a painful +   process involving making each parent dir piece by piece but not trying+   to make anything that's already there.+-}+makeDirectory :: FilePath -> IO ()+makeDirectory d =+   let makeOneDir dir = do+         exists <- fileExist dir+         unless exists $ createDirectory dir modeDir+   in  mapM_ makeOneDir $ listAcc $ splitPath d+++{- Given a path to a file with EXIF data, construct a new path based on the+   date and some serial number info we can parse out of the filename.+-}+buildNewPath :: (MonadError String m, MonadIO m) =>+   FilePath -> FilePath -> m FilePath+buildNewPath newDir oldPath = do+   dateString <- getDate oldPath+   serial <- getSerial oldPath+   let date = readDate dateString+   let year = formatYear date+   let day = formatDay date+   let prefix = formatPrefix date+   return (newDir </> year </> day </>+      (prefix ++ "_" ++ serial) <.> "jpg")+++-- Figure out and execute what the user wants based on the supplied args.+executeCommands :: [String] -> Ph ()++-- User gave no files at all. Display help+executeCommands [] = liftIO $ putStrLn usageText++-- Normal program operation, process the files with the args.+executeCommands (dir:filePaths) = do+   opts <- ask++   -- Get rid of anything not a regular file from the list of paths+   actualPaths <- liftIO $ filterM+      (\p -> getFileStatus p >>= return . isRegularFile) filePaths++   -- Notify user of the switches that will be in effect.+   when (optNoAction opts) $+      liftIO $ putStrLn "No-action mode, nothing will be changed."++   when (optMove opts) $+      liftIO $ putStrLn +         "Removing original links after new links are in place."++   -- Do the link manipulations.+   mapM_ (createNewLink dir) actualPaths+++main :: IO ()+main = do+   -- Parse the arguments+   (opts, paths) <- getArgs >>= parseOpts++   -- Do the photo naming procedure+   runRename opts $ executeCommands paths++   -- Perhaps we should get an ExitCode back from all this above?
testsuite/TestLink.hs view
@@ -159,7 +159,7 @@     -- Test output to stdout    assertBool "no EXIF: correct output"-      (output =~ "File testsuite/resources/noExif.jpg has no EXIF date."+      (output =~ "File testsuite/resources/noExif.jpg has no EXIF date"          :: Bool)  @@ -172,7 +172,7 @@     -- Test output to stdout    assertBool "no serial in filename: correct output"-      (output =~ "File testsuite/resources/noSerial.jpg has no serial."+      (output =~ "File testsuite/resources/noSerial.jpg has no serial"          :: Bool)