packages feed

photoname 5.2 → 5.3

raw patch · 7 files changed

+86/−56 lines, 7 filesdep +formattingdep ~ansi-wl-pprintdep ~containersdep ~directory

Dependencies added: formatting

Dependency ranges changed: ansi-wl-pprint, containers, directory, filepath, heredoc, hsexif, hslogger, mtl, optparse-applicative, parsec, process, time, unix

Files

changelog.md view
@@ -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
photoname.cabal view
@@ -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
src/app/Photoname/Opts.hs view
@@ -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 -> <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: 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 <dino@ui3.info>|]+Version|] %+ string %+ " Dino Morelli <dino@ui3.info>"
src/app/photoname.hs view
@@ -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?
src/lib/Photoname/Exif.hs view
@@ -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])
src/lib/Photoname/Exiv2.hs view
@@ -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 ()
src/lib/Photoname/Links.hs view
@@ -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 ()