module Photoname.Exiv2
  ( setArtist
  , setExifDate
  )
  where

import Control.Monad ( unless )
import Control.Newtype.Generics ( op )
import System.Process ( callCommand )
import Text.Printf ( printf )

import Photoname.Common ( Artist (..), DestPath (..), NoActionSwitch (..),
  Options (..), Ph, ask, liftIO )
import Photoname.Date ( PhDate (FilenameDate), formatDateForExif )
import Photoname.Log ( lname, noticeM )


newtype Command = Command { Command -> String
unCommand :: String }


execCommands :: [Command] -> Ph ()
execCommands :: [Command] -> Ph ()
execCommands [Command]
commands = do
  Options
opts <- ReaderT Options (ExceptT String IO) Options
forall r (m :: * -> *). MonadReader r m => m r
ask

  -- Display what will be done
  IO () -> Ph ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ph ()) -> IO () -> Ph ()
forall a b. (a -> b) -> a -> b
$ (Command -> IO ()) -> [Command] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> String -> IO ()
noticeM String
lname (String -> IO ()) -> (Command -> String) -> Command -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> String
unCommand) [Command]
commands

  -- Execute the commands
  Bool -> Ph () -> Ph ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Bool -> NoActionSwitch) -> NoActionSwitch -> Bool
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op Bool -> NoActionSwitch
NoActionSwitch (NoActionSwitch -> Bool)
-> (Options -> NoActionSwitch) -> Options -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> NoActionSwitch
optNoAction (Options -> Bool) -> Options -> Bool
forall a b. (a -> b) -> a -> b
$ Options
opts) (Ph () -> Ph ()) -> Ph () -> Ph ()
forall a b. (a -> b) -> a -> b
$
    IO () -> Ph ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ph ()) -> IO () -> Ph ()
forall a b. (a -> b) -> a -> b
$ (Command -> IO ()) -> [Command] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
callCommand (String -> IO ()) -> (Command -> String) -> Command -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> String
unCommand) [Command]
commands


setArtist :: DestPath -> Ph ()
setArtist :: DestPath -> Ph ()
setArtist (DestPath String
destFp) = do
  Options
opts <- ReaderT Options (ExceptT String IO) Options
forall r (m :: * -> *). MonadReader r m => m r
ask

  case Options -> Maybe Artist
optArtist Options
opts of
    Maybe Artist
Nothing -> () -> Ph ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (Artist String
"") -> [Command] -> Ph ()
execCommands ([Command] -> Ph ())
-> ([String] -> [Command]) -> [String] -> Ph ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Command) -> [String] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map String -> Command
Command ([String] -> Ph ()) -> [String] -> Ph ()
forall a b. (a -> b) -> a -> b
$
      [ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"exiv2 --Modify 'del Exif.Image.Artist' %s" String
destFp ]
    Just (Artist String
artistInfo) -> [Command] -> Ph ()
execCommands ([Command] -> Ph ())
-> ([String] -> [Command]) -> [String] -> Ph ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Command) -> [String] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map String -> Command
Command ([String] -> Ph ()) -> [String] -> Ph ()
forall a b. (a -> b) -> a -> b
$
      [ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"exiv2 --Modify 'set Exif.Image.Artist %s' %s" String
artistInfo String
destFp ]


setExifDate :: PhDate -> DestPath -> Ph ()

setExifDate :: PhDate -> DestPath -> Ph ()
setExifDate (FilenameDate LocalTime
lt) (DestPath String
destFp) =
  [Command] -> Ph ()
execCommands ([Command] -> Ph ())
-> ([String] -> [Command]) -> [String] -> Ph ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Command) -> [String] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map String -> Command
Command ([String] -> Ph ()) -> [String] -> Ph ()
forall a b. (a -> b) -> a -> b
$
    [ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"exiv2 --Modify 'set Exif.Image.DateTime Ascii %s' --Modify 'set Exif.Photo.UserComment charset=Ascii DateTime is a guess' %s" (LocalTime -> String
formatDateForExif LocalTime
lt) String
destFp
    ]

setExifDate PhDate
_ DestPath
_ = () -> Ph ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()