packages feed

photoname-5.2: src/app/photoname.hs

{-# LANGUAGE OverloadedRecordDot #-}

import Control.Monad (filterM, forM_, when)
import Data.Functor ((<&>))
import System.Posix (FileStatus, getFileStatus, isRegularFile)
import Text.Printf (printf)

import Photoname.Common (CopySwitch (v),
  Extension (Extension, UseExistingExtension), Links, MoveSwitch (v),
  NoActionSwitch (v), Options (copy, extension, links, move, noAction, paths,
  verbosity), Ph, SrcPath (SrcPath, v), liftIO, runRename)
import Photoname.CopyLink (createNewLink)
import Photoname.Date (PhDate, parseExifDate, parseFilenameDate)
import Photoname.Exif (getExifDate)
import Photoname.Exiv2 (getExifDateWithExiv2, setArtist, setExifDate)
import Photoname.Links (describeHardLinkPolicy, linksTest)
import Photoname.Log (errorM, initLogging, infoM, lname)
import Photoname.Opts (parseOpts)


acquireDate :: SrcPath -> Ph PhDate
acquireDate srcPath = do
  mconcat <$> sequence
    [ parseExifDate <$> getExifDate srcPath
    , parseExifDate <$> getExifDateWithExiv2 srcPath
    , pure . parseFilenameDate $ srcPath
    ]


processFile :: SrcPath -> Ph ()
processFile srcPath = do
  liftIO . infoM lname $ "----------"
  imageDate <- acquireDate srcPath
  destPath <- createNewLink imageDate srcPath
  setExifDate imageDate destPath
  setArtist destPath


-- Get rid of anything not a regular file or with a number of links that
-- 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]
filterWantedFiles links inputFiles = map SrcPath <$> filterM (\p ->
    getFileStatus p <&> testFile) inputFiles
  where
    testFile :: FileStatus -> Bool
    testFile fileStatus = isRegularFile fileStatus && linksTest links fileStatus


-- Figure out and execute what the user wants based on the supplied args.
main :: IO ()
main = do
   opts <- parseOpts

   initLogging $ verbosity opts

   -- Notify user of the switches that will be in effect.
   when opts.noAction.v $
      infoM 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"

   case opts.extension of
      Extension ext -> infoM lname $ printf "The extension '%s' will be used for all files" ext
      UseExistingExtension -> pure ()

   when opts.move.v $
      infoM lname "Removing original links after new links are in place"

   describeHardLinkPolicy $ links opts

   actualPaths <- filterWantedFiles (links opts) (paths opts)

   -- Do the link manipulations, and report any errors.
   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)
        pure result

   -- Perhaps we should get an ExitCode back from all this above?