photoname.hs

{-# LANGUAGE OverloadedRecordDot #-}

import Colog.Simple (logNotice)
-- import Colog.Simple (logTest)
import Control.Monad (filterM, when)
import Formatting ((%), sformat, string)
import Data.Functor ((<&>))
import System.IO
  ( BufferMode (NoBuffering)
  , hSetBuffering
  , stderr, stdout
  )
import System.Posix (FileStatus, getFileStatus, isRegularFile)

import Photoname.Common (CopySwitch (v),
  Extension (Extension, UseExistingExtension), Links, MoveSwitch (v),
  NoActionSwitch (v), Options (copy, extension, links, move, noAction, paths,
  verbosity), SrcPath (SrcPath))
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 (logger)
import Photoname.Monad (Env (..), Ph, liftIO, runRename)
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
  logNotice "------------------------------------------------------------"
  imageDate <- acquireDate srcPath
  mbDestPath <- createNewLink imageDate srcPath
  case mbDestPath of
    (Just destPath) -> do
      setExifDate imageDate destPath
      setArtist destPath
    Nothing -> pure ()


-- 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]
{- HLINT ignore "Use fmap" -}
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
  mapM_ (flip hSetBuffering NoBuffering) [stderr, stdout]
  opts <- parseOpts
  runRename (Env opts (logger . verbosity $ opts)) $ do
    -- Notify user of the switches that will be in effect.
    when opts.noAction.v $
      logNotice "No-action mode, nothing will be changed"

    when opts.copy.v $
      logNotice "Files will be copied instead of the default of hard linking"

    case opts.extension of
      Extension ext -> logNotice $ sformat ("The extension '" % string % "' will be used for all files") ext
      UseExistingExtension -> pure ()

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

    describeHardLinkPolicy . links $ opts

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

    mapM_ processFile actualPaths

    -- logTest