diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +5.3 (2024-11-18) + + * Now looking for the 3 EXIF tags when using exiv2 + * Switched from Text.Printf to Formatting + * Moved base dependency to lang stanza + * Changed default verbosity + * Fixed a bug with doubled percent symbols in usage + * Changed log level for links behavior to NOTICE + * Cleaned up some whitespace + * Switched order back to DateTimeDigitized, DateTimeOriginal... + + 5.2 (2024-08-10) * Add an option to specify date format string diff --git a/photoname.cabal b/photoname.cabal --- a/photoname.cabal +++ b/photoname.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: photoname -version: 5.2 +version: 5.3 synopsis: Rename photo image files based on EXIF shoot date description: Command-line utility for renaming/moving photo image files based on EXIF tags. @@ -50,6 +50,7 @@ DeriveTraversable EmptyCase GeneralizedNewtypeDeriving + ImportQualifiedPost InstanceSigs KindSignatures LambdaCase @@ -69,9 +70,10 @@ -Wpartial-fields -Wredundant-constraints build-depends: - directory - , filepath - , unix + base >=4.5 && <5.0 + , directory >= 1.3.6 && < 1.4 + , filepath >= 1.4.2 && < 1.5 + , unix >= 2.7.2 && < 2.8 library import: lang @@ -90,14 +92,14 @@ hs-source-dirs: src/lib build-depends: - base >=4.5 && <5.0 - , containers - , hsexif - , hslogger - , mtl - , parsec - , process - , time + containers >= 0.6.5 && < 0.7 + , formatting >= 7.2.0 && < 7.3 + , hsexif >= 0.6.1 && < 0.7 + , hslogger >= 1.3.1 && < 1.4 + , mtl >= 2.2.2 && < 2.3 + , parsec >= 3.1.15 && < 3.2 + , process >= 1.6.16 && < 1.7 + , time >= 1.11.1 && < 1.13 executable photoname import: lang @@ -110,11 +112,11 @@ hs-source-dirs: src/app build-depends: - ansi-wl-pprint - , base >=4.5 && <5.0 - , heredoc - , hslogger - , optparse-applicative + ansi-wl-pprint >= 0.6.9 && < 0.7 + , formatting >= 7.2.0 && < 7.3 + , heredoc >= 0.2.0 && < 0.3 + , hslogger >= 1.3.1 && < 1.4 + , optparse-applicative >= 0.17.1 && < 0.18 , photoname test-suite photoname-tests @@ -128,11 +130,10 @@ hs-source-dirs: src/tests build-depends: - base >=4.5 && <5.0 - , photoname - , process + photoname + , process >= 1.6.16 && < 1.7 , regex-posix , tasty , tasty-hunit , tasty-quickcheck - , time + , time >= 1.11.1 && < 1.13 diff --git a/src/app/Photoname/Opts.hs b/src/app/Photoname/Opts.hs --- a/src/app/Photoname/Opts.hs +++ b/src/app/Photoname/Opts.hs @@ -6,16 +6,16 @@ where import Data.Version (showVersion) +import Formatting ((%), (%+), formatToString, string) import Options.Applicative import Paths_photoname (version) import System.Directory (doesFileExist) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) -import System.Log (Priority (INFO)) +import System.Log (Priority (NOTICE)) import Text.Heredoc (here) -import Text.PrettyPrint.ANSI.Leijen (string) -import Text.Printf (printf) +import Text.PrettyPrint.ANSI.Leijen qualified as Leijen import Photoname.Common ( Artist (..) @@ -75,7 +75,8 @@ ( long "date-formatter" <> short 'f' <> metavar "STR" - <> help (printf "Format string for date/time in the new filenames. Default \"%s\" See DATE FORMATTER" + <> help (formatToString + ("Format string for date/time in the new filenames. Default \"" % string % "\" See DATE FORMATTER") defaultDateTimeFormat) <> value formatDateTime ) @@ -128,7 +129,7 @@ <> metavar "NUM" <> help "Verbosity level. 0=quiet, 1=normal messages, 2=more info, 3=debug" <> showDefault - <> value (Verbose INFO) + <> value (Verbose NOTICE) ) <*> some ( strArgument $ metavar "FILES..." @@ -151,7 +152,7 @@ versionHelper :: String -> Parser (a -> a) versionHelper progName = - infoOption (printf "%s %s" progName (showVersion version)) $ mconcat + infoOption (formatToString (string %+ string) progName (showVersion version)) $ mconcat [ long "version" , help "Show version information" , hidden @@ -176,7 +177,7 @@ handleParseResult $ execParserPure defaultPrefs ( info (parser <**> helper <**> versionHelper pn) - ( header (printf "%s - Rename and move photo files based on EXIF data" pn) + ( header (formatToString (string %+ "- Rename and move photo files based on EXIF data") pn) <> footer' ) ) @@ -184,7 +185,8 @@ footer' :: InfoMod a -footer' = footerDoc . Just . string $ printf content defaultDateTimeFormat (showVersion version) +footer' = footerDoc . Just . Leijen.string + $ formatToString content defaultDateTimeFormat (showVersion version) where content = [here|OVERVIEW 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 or possibly date/time info in the old filename, and optionally some other information. @@ -196,7 +198,7 @@ A photo shot on 2002-May-02 01:23:07 PM: img_1790.jpg -> /2002/2002-05-02/20020502-132307.jpg -The EXIF date/time stamp used for naming is the first of these fields to be found: Exif.Photo.DateTimeOriginal, Exif.Photo.DateTimeDigitized, Exif.Image.DateTime +The EXIF date/time stamp used for naming is the first of these fields to be found: Exif.Photo.DateTimeDigitized, Exif.Photo.DateTimeOriginal, Exif.Image.DateTime If none of the EXIF tags listed above is found, the program will try to gather date/time info from the filename itself. Filenames that are parsable look like: @@ -217,8 +219,8 @@ DATE FORMATTER -The default date format string is "%s" which yields strings like "yyyymmdd-HHMMSS" -Another example: "%%Y-%%m-%%dt%%H%%M_img" -> "yyyy-mm-ddtHHMM_img" +The default date format string is|] %+ string %+ [here|which yields strings like "yyyymmdd-HHMMSS" +Another example: "%Y-%m-%dt%H%M_img" -> "yyyy-mm-ddtHHMM_img" Any valid date format string is allowed for the -f|--date-formatter option. Please see the API documentation for help on format strings: https://downloads.haskell.org/ghc/latest/docs/libraries/time-1.12.2-dfcf/Data-Time-Format.html @@ -270,4 +272,4 @@ parent-dir=~/mypics suffix=_dwm -Version %s Dino Morelli |] +Version|] %+ string %+ " Dino Morelli " diff --git a/src/app/photoname.hs b/src/app/photoname.hs --- a/src/app/photoname.hs +++ b/src/app/photoname.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedRecordDot, OverloadedStrings #-} import Control.Monad (filterM, forM_, when) +import Formatting ((%), (%+), formatToString, string) import Data.Functor ((<&>)) import System.Posix (FileStatus, getFileStatus, isRegularFile) -import Text.Printf (printf) import Photoname.Common (CopySwitch (v), Extension (Extension, UseExistingExtension), Links, MoveSwitch (v), @@ -14,7 +14,7 @@ import Photoname.Exif (getExifDate) import Photoname.Exiv2 (getExifDateWithExiv2, setArtist, setExifDate) import Photoname.Links (describeHardLinkPolicy, linksTest) -import Photoname.Log (errorM, initLogging, infoM, lname) +import Photoname.Log (errorM, initLogging, lname, noticeM) import Photoname.Opts (parseOpts) @@ -29,7 +29,7 @@ processFile :: SrcPath -> Ph () processFile srcPath = do - liftIO . infoM lname $ "----------" + liftIO . noticeM lname $ "----------" imageDate <- acquireDate srcPath destPath <- createNewLink imageDate srcPath setExifDate imageDate destPath @@ -40,6 +40,7 @@ -- doesn't match our links amount which is either passed in by the user with -- the -l|--links switch or any number of links is fine. filterWantedFiles :: Links -> [FilePath] -> IO [SrcPath] +{- HLINT ignore "Use fmap" -} filterWantedFiles links inputFiles = map SrcPath <$> filterM (\p -> getFileStatus p <&> testFile) inputFiles where @@ -56,17 +57,17 @@ -- Notify user of the switches that will be in effect. when opts.noAction.v $ - infoM lname "No-action mode, nothing will be changed" + noticeM lname "No-action mode, nothing will be changed" when opts.copy.v $ - infoM lname "Files will be copied instead of the default of hard linking" + noticeM lname "Files will be copied instead of the default of hard linking" case opts.extension of - Extension ext -> infoM lname $ printf "The extension '%s' will be used for all files" ext + Extension ext -> noticeM lname $ formatToString ("The extension '" % string % "' will be used for all files") ext UseExistingExtension -> pure () when opts.move.v $ - infoM lname "Removing original links after new links are in place" + noticeM lname "Removing original links after new links are in place" describeHardLinkPolicy $ links opts @@ -76,9 +77,7 @@ forM_ actualPaths $ \srcPath -> do result <- runRename opts $ processFile srcPath either - {- HLINT ignore "Avoid lambda" -} - -- Because the compiler can't figure out printf is expecting an argument at compile time - (\em -> errorM lname $ printf "** Processing %s: %s" srcPath.v em) + (errorM lname . formatToString ("** Processing" %+ string % ":" %+ string) srcPath.v) pure result -- Perhaps we should get an ExitCode back from all this above? diff --git a/src/lib/Photoname/Exif.hs b/src/lib/Photoname/Exif.hs --- a/src/lib/Photoname/Exif.hs +++ b/src/lib/Photoname/Exif.hs @@ -5,7 +5,7 @@ ) where -import Control.Monad.Except (MonadIO, liftIO) +import Control.Monad.Trans (MonadIO, liftIO) import qualified Data.Map as M import Data.Monoid (First (..)) import Graphics.HsExif (ExifTag, ExifValue, dateTime, dateTimeDigitized, @@ -36,4 +36,4 @@ -- Look up all of them (resulting in [Maybe ExifValue]), wrap in First data structures . map (First . flip M.lookup exifMap) -- EXIF tags we're intersted in, in the order we want them left-to-right - $ [dateTimeOriginal, dateTimeDigitized, dateTime]) + $ [dateTimeDigitized, dateTimeOriginal, dateTime]) diff --git a/src/lib/Photoname/Exiv2.hs b/src/lib/Photoname/Exiv2.hs --- a/src/lib/Photoname/Exiv2.hs +++ b/src/lib/Photoname/Exiv2.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Photoname.Exiv2 ( getExifDateWithExiv2 , setArtist @@ -9,10 +11,11 @@ import Control.Monad (void) import Control.Monad.IO.Class (MonadIO) import Data.Char (isSpace) +import Data.Monoid (First (..)) +import Formatting ((%), (%+), formatToString, string) import GHC.IO.Exception import System.Process hiding (proc) import qualified System.Process as Proc -import Text.Printf (printf) import Photoname.Common (Artist (Artist), DestPath (DestPath), NoActionSwitch (NoActionSwitch), Options (artist, noAction), Ph, @@ -85,7 +88,8 @@ postProcess :: Either IOException (ExitCode, String, String) -> IO (Either String String) -postProcess (Left e ) = pure . Left $ printf "%s: %s" program (ioe_description e) +postProcess (Left e ) = + pure . Left $ formatToString (string % ":" %+ string) program (ioe_description e) postProcess (Right (ExitSuccess , stdOut, _ )) = pure . Right $ stdOut postProcess (Right (ExitFailure 1, _ , "" )) = pure . Left $ "EXIF tag not found" postProcess (Right (ExitFailure _, _ , stdErr)) = pure . Left $ stdErr @@ -104,10 +108,19 @@ getExifDateWithExiv2 :: SrcPath -> Ph (Maybe String) -getExifDateWithExiv2 (SrcPath srcFp) = do - let tag = "Exif.Image.DateTime" - eResult <- execReadingCommand $ Command infoM program ["--Print", "v", "--grep", tag, srcFp] - pure . either (const Nothing) Just $ eResult +getExifDateWithExiv2 (SrcPath srcFp) = + getFirst -- Remove the First wrapper + . mconcat -- Collapse these to the first not-Nothing + . map First -- Wrap in First data structures + -- Look up all of them (resulting in Ph [Maybe ExifValue]) + <$> mapM mbResult + -- EXIF tags we're intersted in, in the order we want them left-to-right + ["Exif.Photo.DateTimeOriginal", "Exif.Photo.DateTimeDigitized", "Exif.Image.DateTime"] + + where + mbResult tag = do + eResult <- execReadingCommand $ Command infoM program ["--Print", "v", "--grep", tag, srcFp] + pure . either (const Nothing) Just $ eResult setExifDate :: PhDate -> DestPath -> Ph () diff --git a/src/lib/Photoname/Links.hs b/src/lib/Photoname/Links.hs --- a/src/lib/Photoname/Links.hs +++ b/src/lib/Photoname/Links.hs @@ -1,14 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + module Photoname.Links ( describeHardLinkPolicy , linksTest ) where +import Formatting ((%+), formatToString, int) import System.Posix (FileStatus, linkCount) -import Text.Printf (printf) import Photoname.Common (Links (Exactly, NoLimit)) -import Photoname.Log (infoM, lname) +import Photoname.Log (lname, noticeM) linksTest :: Links -> FileStatus -> Bool @@ -18,7 +20,8 @@ describeHardLinkPolicy :: Links -> IO () describeHardLinkPolicy l = case l of - Exactly 1 -> infoM lname "Only processing files with 1 hard link" - Exactly n -> infoM lname $ printf "Only processing files with %d hard links" (toInteger n) + Exactly 1 -> noticeM lname "Only processing files with 1 hard link" + Exactly n -> noticeM lname $ formatToString + ("Only processing files with" %+ int %+ "hard links") (toInteger n) NoLimit -> pure ()