photoname 2.3.0 → 3.0.0
raw patch · 18 files changed
+490/−287 lines, 18 filesdep +directory
Dependencies added: directory
Files
- LICENSE +1/−1
- README +3/−5
- TODO +0/−22
- doc/dev/notes +9/−32
- photoname.cabal +6/−6
- src/Photoname/Common.hs +26/−0
- src/Photoname/Date.hs +34/−20
- src/Photoname/DateFormat.hs +35/−0
- src/Photoname/Exif.hs +50/−0
- src/Photoname/Opts.hs +129/−25
- src/Photoname/Serial.hs +0/−43
- src/Photoname/SerialFormat.hs +70/−0
- src/photoname.hs +38/−108
- testsuite/TestHelp.hs +2/−2
- testsuite/TestLink.hs +77/−19
- testsuite/Util.hs +1/−1
- testsuite/runtests.hs +5/−3
- util/resources/test.conf +4/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2007-2010 Dino Morelli+Copyright (c) 2007-2011 Dino Morelli All rights reserved. Redistribution and use in source and binary forms, with or without
README view
@@ -7,12 +7,10 @@ *about* photoname is a command-line utility for renaming/moving photo image-files. The new folder location and naming are determined by two things:-the photo shoot date information contained within the file's EXIF tags-and the usually-camera-assigned serial number, often appearing in the-filename.+files. The new folder location and naming are determined by the the+photo shoot date information contained within the file's EXIF tags. -This program is known to work with GHC 6.10.3 on systems where System.Posix (unix) and exif packages are available.+This program is known to build with GHC 6.12.3 *install*
TODO view
@@ -1,27 +1,5 @@-- Add support for different camera filename formats, check with the Olympus.--- 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:- parent-dir=/foo/bar/baz-- This would be used in the event that none was specified. Other switches could be specified here perhaps.-- This config file behavior will require a config file API, I can try to use the one I started a few months ago.--- I'm wondering if it would be possible to have a post-command switch that could specify something to be done after other processing is done. This came up when i was thinking about rolling jhead -autorot rotation behavior into this program. But I'm reluctant to make this program have direct knowledge of such tools and procedures.- An example:- --post-cmd='jhead -autorot %f'-- What syntax to use for variables in such strings?- - Allow user to specify permissions for newly-created dirs and files. Bonus points for parsing the octal codes everyone knows and loves. - Add a --force switch to disregard existing links. - 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 Call this the suffix? (-s --suffix)--- Add the Homepage item to the debian/control that you see now in more recent packages. Use dh_make on something to see what it looks like, something like this:- Homepage: <url>
doc/dev/notes view
@@ -1,47 +1,24 @@ ------Do something with this, better error checking?--- Parse arguments-- Look at args, cases:- - --help- - no files- - no parent path- - normal processing (ReaderT)------- - To change the app version:- - Edit photoname.cabal: version: xx.yy+ - Edit photoname.cabal - Edit src/Photoname/Opts.hs, usageText near the bottom of footer- - darcs rec these changes as "Changed version to xx.yy"- - darcs tag "xx.yya"- Use a, b, c as attempts for version xx.yy I'd like to make a script in util/ to automate this. After such a script has been made, may want to put developer notes on using it in doc/dev/<somefile> -----------File serial number formats:--Panasonic: P###0###.jpg- First part is dir, second is serial. We can use the second part.-Canon: img_####.jpg- Can use the last 3 digits of this-Olympus:---Photo naming scheme (this info needs to go into usage help at some point)+File naming format: yyyymmdd_[oth_]nnn[-e[n]].jpg+yyyymmdd-hhmmss[_oth][_ss].jpg date: year month day-other author: 2 or 3 character initials-photo serial: last 3 digits of camera-supplied number, if possible-e or s: edited or sized, optional number for more than one- -sp -ep : sized/edited for printing- -sd -ed : sized/edited for desktop- -sw -ew : sized/edited for web--Photo serial: Note that 3-digits is standard for Panasonic cameras. 4 digits is standard for Canon cameras. But we'll use 3 digits for Canon too, seems like unique within each day.+time: hour minute second+oth: could be photographer: 2 or 3 character initials+ss: edited or sized, optional number for more than one+ _sp _ep : sized/edited for printing+ _sd1920x1080 _ed : sized/edited for desktop+ _sw _ew : sized/edited for web These files are arranged into a dir structure
photoname.cabal view
@@ -1,10 +1,10 @@ name: photoname cabal-version: >= 1.2-version: 2.3.0+version: 3.0.0 build-type: Simple license: BSD3 license-file: LICENSE-copyright: 2007-2010 Dino Morelli +copyright: 2007-2011 Dino Morelli author: Dino Morelli maintainer: Dino Morelli <dino@ui3.info> stability: stable@@ -12,13 +12,13 @@ synopsis: Rename JPEG photo files based on shoot date description: Command-line utility for renaming/moving photo image files based on - EXIF tags. Written in Haskell.-category: Unclassified+ EXIF tags.+category: Application, Console tested-with: GHC>=6.8.2 executable photoname main-is: photoname.hs- build-depends: base >= 3 && < 5, exif, filepath, mtl, old-locale, - parsec, time, unix+ build-depends: base >= 3 && < 5, directory, exif, filepath, mtl, + old-locale, parsec, time, unix ghc-options: -Wall hs-source-dirs: src
+ src/Photoname/Common.hs view
@@ -0,0 +1,26 @@+-- Copyright: 2007-2011 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Photoname.Common+ ( Ph, runRename++ -- Re-exporting:+ , MonadError+ , ask, asks+ , liftIO+ , throwError+ )+ where++import Control.Monad.Error+import Control.Monad.Reader++import Photoname.Opts ( Options (..) )+++type Ph a = ReaderT Options (ErrorT String IO) a+++runRename :: Options -> Ph a -> IO (Either String a)+runRename env action = runErrorT $ runReaderT action env
src/Photoname/Date.hs view
@@ -1,11 +1,13 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> -module Photoname.Date (- formatYear, formatDay, formatPrefix,- readDate-)+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module Photoname.Date+ ( formatYear, formatDateHyphens, formatDate, formatDateTime+ , readDate+ ) where import Data.Time.Calendar@@ -15,9 +17,10 @@ import Text.ParserCombinators.Parsec --- Parse a date string in the form "yyyy:mm:dd hh:mm:ss" into a --- CalendarTime datatype. Strings that fail to parse in this manner are--- returned as Nothing+{- Parse a date string in the form "yyyy:mm:dd hh:mm:ss" into a + CalendarTime datatype. Strings that fail to parse in this manner are+ returned as Nothing+-} readDate :: String -> Maybe LocalTime readDate s = case (parse dateParser "" s) of@@ -39,22 +42,33 @@ (fromIntegral ((read second) :: Integer))) --- Format a Maybe CalendarTime into a "yyyy" string. Dates that are--- Nothing in value format to "0000"+{- Format a Maybe CalendarTime into a "yyyy" string. Dates that are+ Nothing in value format to "0000"+-} formatYear :: Maybe LocalTime -> String formatYear Nothing = "0000" formatYear (Just x) = formatTime defaultTimeLocale "%Y" x --- Format a Maybe CalendarTime into a "yyyy-mm-dd" string. Dates that are--- Nothing in value format to "0000-00-00"-formatDay :: Maybe LocalTime -> String-formatDay Nothing = "0000-00-00"-formatDay (Just x) = formatTime defaultTimeLocale "%Y-%m-%d" x+{- Format a Maybe CalendarTime into a "yyyy-mm-dd" string. Dates that are+ Nothing in value format to "0000-00-00"+-}+formatDateHyphens :: Maybe LocalTime -> String+formatDateHyphens Nothing = "0000-00-00"+formatDateHyphens (Just x) = formatTime defaultTimeLocale "%Y-%m-%d" x --- Format a Maybe CalendarTime into a "yyyymmdd" string. Dates that are--- Nothing in value format to "00000000"-formatPrefix :: Maybe LocalTime -> String-formatPrefix Nothing = "00000000"-formatPrefix (Just x) = formatTime defaultTimeLocale "%Y%m%d" x+{- Format a Maybe CalendarTime into a "yyyymmdd" string. Dates that are+ Nothing in value format to "00000000"+-}+formatDate :: Maybe LocalTime -> String+formatDate Nothing = "00000000"+formatDate (Just x) = formatTime defaultTimeLocale "%Y%m%d" x+++{- Format a Maybe CalendarTime into a "yyyymmdd-HHMMSS" string. Dates + that are Nothing in value format to "00000000-000000"+-}+formatDateTime :: Maybe LocalTime -> String+formatDateTime Nothing = "00000000-000000"+formatDateTime (Just x) = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" x
+ src/Photoname/DateFormat.hs view
@@ -0,0 +1,35 @@+-- Copyright: 2007-2011 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Photoname.DateFormat+ ( buildDatePath+ )+ where++import System.FilePath+import Text.Printf++import Photoname.Common+import Photoname.Date+import Photoname.Exif+import Photoname.Opts ( Options (..) )+++{- 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.+-}+buildDatePath :: FilePath -> Ph FilePath+buildDatePath oldPath = do+ dateString <- getDate oldPath+ let date = readDate dateString++ suffix <- asks optSuffix+ let fileName = printf "%s%s.jpg" (formatDateTime date) suffix++ parentDir <- asks optParentDir+ noDirs <- asks optNoDirs+ return $ if (noDirs)+ then parentDir </> fileName+ else parentDir </> (formatYear date) </>+ (formatDateHyphens date) </> fileName
+ src/Photoname/Exif.hs view
@@ -0,0 +1,50 @@+-- Copyright: 2007-2011 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++{-# LANGUAGE FlexibleContexts #-}++module Photoname.Exif+ where++import Control.Monad.Error+import Graphics.Exif ( fromFile, getTag, Exif )+import System.IO.Error+++{- load Exif information from a filename, returning Nothing if libexif+ encounters a NULL instead of raising an IO error.++ This is somewhat bogus because of the error type that is used by+ the EXIF library. We have to compare the error string to see if it+ is the kind of user error that we expect. If we build against an+ EXIF library that raises some other exception, then this build will+ still succeed, and the exception will be propagated instead of+ transformed into a handled photoname error.+-}+safeExif :: FilePath -> IO (Maybe Exif)+safeExif = try . fromFile >=> either handleBadExif (return . Just)+ where+ isBadExif e =+ ioeGetErrorString e == "mkExif: NULL" && isUserError e+ handleBadExif e =+ if isBadExif e then return Nothing else ioError e+++{- 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 = loadExif >=> getOneOf dateTagNames+ where+ loadExif = (liftIO . safeExif) >=>+ maybe (throwError "Failed EXIF loading") return++ getOneOf [] _ = throwError "has no EXIF date"+ getOneOf (tagName:tagNames) exif =+ maybe (getOneOf tagNames exif) return =<<+ liftIO (getTag exif tagName)++ dateTagNames =+ ["DateTimeDigitized", "DateTimeOriginal", "DateTime"]
src/Photoname/Opts.hs view
@@ -1,4 +1,4 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> @@ -8,76 +8,180 @@ ) where +import Control.Applicative import System.Console.GetOpt+import System.Directory data Options = Options- { optNoAction :: Bool- , optQuiet :: Bool- , optMove :: Bool+ { optConfig :: String , optHelp :: Bool+ , optMove :: Bool+ , optNoAction :: Bool+ , optNoConfig :: Bool+ , optNoDirs :: Bool+ , optOldStyle :: Bool+ , optParentDir :: String+ , optQuiet :: Bool+ , optSuffix :: String } +defaultConfig :: String+defaultConfig = "~/.config/photoname.conf" defaultOptions :: Options defaultOptions = Options- { optNoAction = False- , optQuiet = False- , optMove = False+ { optConfig = defaultConfig , optHelp = False+ , optMove = False+ , optNoAction = False+ , optNoConfig = False+ , optNoDirs = False+ , optOldStyle = False+ , optParentDir = "."+ , optQuiet = False+ , optSuffix = "" } options :: [OptDescr (Options -> Options)] options =- [ Option ['n'] ["no-action"]+ [ Option ['c'] ["config"]+ (ReqArg (\c opts -> opts { optConfig = c }) "FILE")+ ("Defaults to " ++ defaultConfig ++ ". See CONFIG")+ , Option ['C'] ["no-config"]+ (NoArg (\opts -> opts { optNoConfig = True } )) + "Do not load config file"+ , Option ['D'] ["no-dirs"]+ (NoArg (\opts -> opts { optNoDirs = True } )) + "No subdirectory hierarchy. Just do DIR/NEWFILE"+ , Option ['h'] ["help"] + (NoArg (\opts -> opts { optHelp = True } ))+ "This help text"+ , Option [] ["move"] + (NoArg (\opts -> opts { optMove = True } ))+ "Move the files, don't just hard-link to the new locations"+ , Option ['n'] ["no-action"] (NoArg (\opts -> opts { optNoAction = True } )) "Display what would be done, but do nothing"+ , Option ['o'] ["old-style"]+ (NoArg (\opts -> opts { optOldStyle = True } )) + "Use older name format with serial. See FILENAME FORMAT"+ , Option ['p'] ["parent-dir"]+ (ReqArg (\d opts -> opts { optParentDir = d } ) "DIR") + "Top-level directory where new links are created. Default: ." , 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"+ , Option ['s'] ["suffix"]+ (ReqArg (\s opts -> opts { optSuffix = s } ) "SUF") + "Add optional suffix to each name. See SUFFIX" ] -parseOpts :: [String] -> IO (Options, [String])-parseOpts argv = - case getOpt Permute options argv of+{- Try to load a config file, converting its lines into a [String] + of long options to be parsed+-}+loadConfig :: FilePath -> IO [String]+loadConfig path = do+ confExists <- doesFileExist path++ if confExists+ then (map ("--" ++) . lines) <$> readFile path+ else return []+++{- Perform the actual parse of a [String]+-}+parseOpts' :: [String] -> IO (Options, [String])+parseOpts' args =+ case getOpt Permute options args of (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) (_,_,errs) -> ioError $ userError (concat errs ++ usageText) +{- The set of steps to parse args from both the command-line and a + config file+-}+parseOpts :: [String] -> IO (Options, [String])+parseOpts cliArgs = do+ -- Parse argv first time to get -c and/or -C+ (prelimOpts, _) <- parseOpts' cliArgs++ -- Load config file+ confArgs <- if (optNoConfig prelimOpts)+ then return []+ else loadConfig $ optConfig prelimOpts++ -- Parse second time with all args+ parseOpts' (confArgs ++ cliArgs)++ usageText :: String usageText = (usageInfo header options) ++ "\n" ++ footer where header = init $ unlines- [ "Usage: photoname [OPTIONS] PARENTDIR FILES"+ [ "Usage: photoname [OPTIONS] FILES" , "Rename and move photo files based on EXIF data" , "" , "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 attempt to construct a meaningful filename based on the EXIF shoot date in the file and optionally some other information." , ""- , "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:"+ , "CONFIG" , ""- , "A photo shot on 2002-May-02 with a Canon camera:"+ , "The program will attempt to load a config file from this location: " ++ defaultConfig ++ " A different path may be specified with the --config switch"+ , "Entries in this file should be the long switches above minus the -- and including any arguments they may have. To completely ignore an existing config file, use the --no-config switch."+ , ""+ , "Example config contents:"+ , ""+ , " move"+ , " old-style"+ , " parent-dir=~/mypics"+ , " suffix=_dwm"+ , ""+ , ""+ , "FILENAME FORMAT"+ , ""+ , "Normal operation builds 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, named as follows:"+ , ""+ , "A photo shot on 2002-May-02 01:23:07 PM:"+ , " img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502-132307.jpg"+ , ""+ , "The EXIF date/time stamp used for naming is the first of these fields to be found: DateTimeDigitized, DateTimeOriginal, DateTime"+ , ""+ , "The <PARENTDIR> is the one given by the --parent-dir switch and represents the top-level of where you're storing photos."+ , ""+ , "The --no-dirs switch will suppress the directory-hierarchy-creating part of this, instead placing the new links directly in <PARENTDIR>. So you get files like:"+ , ""+ , " <PARENTDIR>/20020502-132307.jpg"+ , ""+ , "Default behavior is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to not leave the original links."+ , ""+ , "The --old-style switch specifies the prior behavior of photoname where the name is a date followed by the last three digits of the camera-assigned number from the original filename:"+ , "" , " img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502_790.jpg" , ""- , "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:"+ , "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. Examples of the two that I have:" , "" , " 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."+ , " ^^^" , ""- , "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."+ , "The --old-style behavior in photoname remains for backwards compatibility. Many cameras today (and particularly camera phones) don't generate a name we can use in this way, and so something needed to change in this software." , ""- , "Version 2.3.0 2010-Jan-17 Dino Morelli <dino@ui3.info>"+ , "Another nagging problem is the old-style naming is non-deterministic. Using photoname --old-style on a file may not always give you the same name, say if the serial info in the name is ever lost. Naming based on the EXIF data alone is more reliable."+ , ""+ , ""+ , "SUFFIX"+ , ""+ , "The optional --suffix switch can be used to provide a string placed between the date/time and extension. Use it for anything you like. An example is photographer initials or series info. Example:"+ , ""+ , "photoname invoked with --suffix=_dwm :"+ , " 20020502-132307_dwm.jpg"+ , ""+ , "Version 3.0.0 Dino Morelli <dino@ui3.info>" ]
− src/Photoname/Serial.hs
@@ -1,43 +0,0 @@--- Copyright: 2007-2010 Dino Morelli--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# LANGUAGE FlexibleContexts #-}--module Photoname.Serial- ( getSerial- )- where--import Control.Monad.Error-import Text.ParserCombinators.Parsec---{- 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- scan = do { end } -- If end succeeds, return that.- <|>- do { p; scan } -- Otherwise, match p and recurse.---serialNum :: GenParser Char st [Char]-serialNum =- skipTill anyChar $ try $ do -- Skip anything up to..- serial <- count 3 digit -- 3 digits..- char '.' -- followed by a period..- count 3 alphaNum -- followed by 3 alphaNumS..- eof -- at the end of the string.- 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 :: (MonadError String m) => String -> m String-getSerial path =- case (parse serialNum "" path) of- Left _ -> throwError "has no serial"- Right serial -> return serial
+ src/Photoname/SerialFormat.hs view
@@ -0,0 +1,70 @@+-- Copyright: 2007-2011 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module Photoname.SerialFormat+ ( buildSerialPath+ )+ where++import System.FilePath+import Text.ParserCombinators.Parsec++import Photoname.Common+import Photoname.Date+import Photoname.Exif+import Photoname.Opts ( Options (..) )+++{- 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+ scan = do { end } -- If end succeeds, return that.+ <|>+ do { p; scan } -- Otherwise, match p and recurse.+++serialNum :: GenParser Char st [Char]+serialNum =+ skipTill anyChar $ try $ do -- Skip anything up to..+ serial <- count 3 digit -- 3 digits..+ char '.' -- followed by a period..+ count 3 alphaNum -- followed by 3 alphaNumS..+ eof -- at the end of the string.+ 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 :: (MonadError String m) => String -> m String+getSerial path =+ case (parse serialNum "" path) of+ Left _ -> throwError "Can't determine serial"+ Right serial -> return serial+++{- 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.+-}+buildSerialPath :: FilePath -> Ph FilePath+buildSerialPath oldPath = do+ dateString <- getDate oldPath+ serial <- getSerial oldPath+ let date = readDate dateString++ suffix <- asks optSuffix+ let fileName = (formatDate date) ++ "_" ++ serial+ ++ suffix <.> "jpg"++ parentDir <- asks optParentDir+ noDirs <- asks optNoDirs+ return $ if (noDirs)+ then parentDir </> fileName+ else parentDir </> (formatYear date) </>+ (formatDateHyphens date) </> fileName
src/photoname.hs view
@@ -1,27 +1,19 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 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, Exif )+import Control.Monad import System.Environment ( getArgs ) import System.FilePath-import System.IO.Error import System.Posix+import Text.Printf -import Photoname.Date+import Photoname.Common 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+import Photoname.DateFormat ( buildDatePath )+import Photoname.SerialFormat ( buildSerialPath ) modeDir :: FileMode@@ -30,81 +22,38 @@ groupExecuteMode -{- load Exif information from a filename, returning Nothing if libexif- encounters a NULL instead of raising an IO error.-- This is somewhat bogus because of the error type that is used by- the EXIF library. We have to compare the error string to see if it- is the kind of user error that we expect. If we build against an- EXIF library that raises some other exception, then this build will- still succeed, and the exception will be propagated instead of- transformed into a handled photoname error.--}-safeExif :: FilePath -> IO (Maybe Exif)-safeExif = try . fromFile >=> either handleBadExif (return . Just)- where- isBadExif e =- ioeGetErrorString e == "mkExif: NULL" && isUserError e- handleBadExif e =- if isBadExif e then return Nothing else ioError e---{- 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 = loadExif >=> getOneOf dateTagNames- where- loadExif = (liftIO . safeExif) >=>- maybe (throwError "failed EXIF loading") return-- getOneOf [] _ = throwError "has no EXIF date"- getOneOf (tagName:tagNames) exif =- maybe (getOneOf tagNames exif) return =<<- liftIO (getTag exif tagName)-- dateTagNames =- ["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.+ link the file at its new location below the given basedir. -}-createNewLink :: FilePath -> FilePath -> Ph ()-createNewLink newDir oldPath = do+createNewLink :: FilePath -> Ph ()+createNewLink oldPath = do opts <- ask- result <- liftIO $ runErrorT $ do- newPath <- buildNewPath newDir oldPath+ newPath <- if (optOldStyle opts)+ then buildSerialPath oldPath+ else buildDatePath oldPath - -- Check for existance of the target file- exists <- liftIO $ fileExist newPath- when exists $ throwError $ "Destination " ++ newPath ++ " exists!"+ -- Check for existance of the target file+ exists <- liftIO $ fileExist newPath+ when exists $ throwError $ "Destination " ++ newPath ++ " exists!" - -- Display what will be done- unless (optQuiet opts) $- liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath+ -- Display what will be done+ unless (optQuiet opts) $+ liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath - unless (optNoAction opts) $ do- -- Make the target dir- liftIO $ makeDirectory $ takeDirectory newPath+ unless (optNoAction opts) $ do+ -- Make the target dir+ liftIO $ makeDirectory $ takeDirectory newPath - -- Make the new hard link- liftIO $ createLink oldPath newPath+ -- Make the new hard link+ liftIO $ createLink oldPath newPath - -- If user has specified, remove the original link- when (optMove opts) $- liftIO $ removeLink oldPath+ -- If user has specified, remove the original link+ when (optMove opts) $+ liftIO $ removeLink oldPath return () - let errPrefix = "** Processing " ++ oldPath ++ ": " - case result of- Left errMsg -> liftIO $ putStrLn $ errPrefix ++ 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:@@ -135,49 +84,30 @@ 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 ()+executeCommands :: Options -> [String] -> IO () -- User gave no files at all. Display help-executeCommands [] = liftIO $ putStrLn usageText---- User gave just a dir and no files at all. Display help-executeCommands [_] = liftIO $ putStrLn usageText+executeCommands _ [] = putStrLn usageText -- Normal program operation, process the files with the args.-executeCommands (dir:filePaths) = do- opts <- ask-+executeCommands opts filePaths = do -- Get rid of anything not a regular file from the list of paths- actualPaths <- liftIO $ filterM+ actualPaths <- 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."+ putStrLn "No-action mode, nothing will be changed." when (optMove opts) $- liftIO $ putStrLn - "Removing original links after new links are in place."+ putStrLn "Removing original links after new links are in place." - -- Do the link manipulations.- mapM_ (createNewLink dir) actualPaths+ -- Do the link manipulations, and report any errors.+ forM_ actualPaths $ \path -> do+ result <- runRename opts $ createNewLink path+ either (\em -> printf "** Processing %s: %s\n" path em)+ (const return ()) result main :: IO ()@@ -186,6 +116,6 @@ (opts, paths) <- getArgs >>= parseOpts -- Do the photo naming procedure- runRename opts $ executeCommands paths+ executeCommands opts paths -- Perhaps we should get an ExitCode back from all this above?
testsuite/TestHelp.hs view
@@ -1,4 +1,4 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> @@ -18,7 +18,7 @@ ] expectedFirstLine :: String-expectedFirstLine = "Usage: photoname [OPTIONS] PARENTDIR FILES"+expectedFirstLine = "Usage: photoname [OPTIONS] FILES" testHelpSwitch :: Test
testsuite/TestLink.hs view
@@ -1,4 +1,4 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> @@ -8,7 +8,7 @@ where import System.Directory ( copyFile, removeDirectoryRecursive )-import System.FilePath.Posix ( (</>) )+import System.FilePath.Posix ( (</>), (<.>) ) import System.Posix.Files ( fileExist ) import System.Process ( waitForProcess ) import Test.HUnit ( Test (..), assertBool, assertString )@@ -23,12 +23,14 @@ testLinkAll :: Test testLinkAll = TestList- [ TestLabel "testLink" testLink+ [ TestLabel "testLinkDate" testLinkDate+ , TestLabel "testLinkSerial" testLinkSerial , TestLabel "testMove" testMove , TestLabel "testLinkNoAction" testLinkNoAction , TestLabel "testLinkNoActionLong" testLinkNoActionLong , TestLabel "testLinkQuiet" testLinkQuiet , TestLabel "testLinkQuietLong" testLinkQuietLong+ , TestLabel "testLinkSuffix" testLinkSuffix , TestLabel "testNoExif" testNoExif , TestLabel "testNoSerial" testNoSerial , TestLabel "testDirForFile" testDirForFile@@ -37,17 +39,19 @@ topDir = Util.resourcesPath </> "foo" oldPath = Util.resourcesPath </> "img_1220.jpg"-newLinkPath = topDir </> "2003/2003-09-02/20030902_220.jpg"+newLinkPathDate = topDir </> "2003/2003-09-02/20030902-114303.jpg"+newLinkPathSerial = topDir </> "2003/2003-09-02/20030902_220.jpg" -testLink :: Test-testLink = TestCase $ do+testLinkDate :: Test+testLinkDate = TestCase $ do -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput [ topDir, oldPath ]+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ topDir, oldPath ] waitForProcess procH -- Check that the correct output path exists- existsNew <- fileExist newLinkPath+ existsNew <- fileExist newLinkPathDate assertBool "make link: existance of new link" existsNew -- Check that old path still exists@@ -59,9 +63,32 @@ -- Test output to stdout assertBool "make link: correct output"- (output =~ newLinkPath :: Bool)+ (output =~ newLinkPathDate :: Bool) +testLinkSerial :: Test+testLinkSerial = TestCase $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ topDir, "--old-style", oldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathSerial+ assertBool "make link: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool "make link: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive topDir++ -- Test output to stdout+ assertBool "make link: correct output"+ (output =~ newLinkPathSerial :: Bool)++ testMove :: Test testMove = TestCase $ do let newNewLinkPath = topDir </> "2003/2003-09-02/20030902_321.jpg"@@ -73,7 +100,7 @@ -- Run the program with known input data (output, procH) <- Util.getBinaryOutput- [ "--move", topDir, newOldPath ]+ [ "--move", "--parent-dir=" ++ topDir, "--old-style", newOldPath ] waitForProcess procH -- Check that the correct output path exists@@ -103,7 +130,8 @@ testLinkNoAction' :: String -> String -> Test testLinkNoAction' label switch = TestCase $ do -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ]+ (output, procH) <- Util.getBinaryOutput+ [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ] waitForProcess procH -- Check that the correct output path exists@@ -116,7 +144,7 @@ -- Test output to stdout assertBool (label ++ ": correct output")- (output =~ newLinkPath :: Bool)+ (output =~ newLinkPathSerial :: Bool) testLinkQuiet :: Test@@ -131,11 +159,12 @@ testLinkQuiet' :: String -> String -> Test testLinkQuiet' label switch = TestCase $ do -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ]+ (output, procH) <- Util.getBinaryOutput+ [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ] waitForProcess procH -- Check that the correct output path exists- existsNew <- fileExist newLinkPath+ existsNew <- fileExist newLinkPathSerial assertBool (label ++ ": existance of new link") existsNew -- Check that old path still exists@@ -147,6 +176,34 @@ -- Test output to stdout Util.assertFalse (label ++ ": no output")+ (output =~ newLinkPathSerial :: Bool)+++testLinkSuffix :: Test+testLinkSuffix = TestCase $ do+ let suffix = "_dwm"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ topDir, "--suffix=" ++ suffix, oldPath ]+ waitForProcess procH++ let newLinkPath = topDir </>+ ("2003/2003-09-02/20030902-114303" ++ suffix) <.> "jpg"++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPath+ assertBool "make link: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool "make link: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive topDir++ -- Test output to stdout+ assertBool "make link: correct output" (output =~ newLinkPath :: Bool) @@ -154,31 +211,32 @@ testNoExif = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput- [ topDir, Util.resourcesPath </> "noExif.jpg" ]+ [ "--parent-dir=" ++ topDir, Util.resourcesPath </> "noExif.jpg" ] waitForProcess procH -- Test output to stdout assertBool "no EXIF: correct output"- (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: failed EXIF loading" :: Bool)+ (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: Failed EXIF loading" :: Bool) testNoSerial :: Test testNoSerial = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput- [ topDir, Util.resourcesPath </> "noSerial.jpg" ]+ [ "--parent-dir=" ++ topDir+ , "--old-style", Util.resourcesPath </> "noSerial.jpg" ] waitForProcess procH -- Test output to stdout assertBool "no serial in filename: correct output"- (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: has no serial" :: Bool)+ (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: Can't determine serial" :: Bool) testDirForFile :: Test testDirForFile = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput- [ topDir, Util.resourcesPath ]+ [ "--parent-dir=" ++ topDir, Util.resourcesPath ] waitForProcess procH -- Test output to stdout
testsuite/Util.hs view
@@ -1,4 +1,4 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info>
testsuite/runtests.hs view
@@ -1,4 +1,4 @@--- Copyright: 2007-2010 Dino Morelli+-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli <dino@ui3.info> @@ -10,8 +10,10 @@ import TestLink -main :: IO Counts-main = runTestTT tests+main :: IO ()+main = do+ runTestTT tests+ return () tests :: Test
+ util/resources/test.conf view
@@ -0,0 +1,4 @@+move+old-style+parent-dir=~/mypics+suffix=_dwm