{-# LANGUAGE ScopedTypeVariables #-}

module Photoname.CopyLink
   ( createNewLink
   )
   where

import Control.Exception ( try )
import Control.Monad ( unless, when )
import Control.Newtype.Generics ( op )
import Data.Time.LocalTime ( LocalTime )
import GHC.IO.Exception ( IOException )
import System.Directory ( copyFile, createDirectoryIfMissing )
import System.FilePath ( (</>), takeDirectory )
import System.Posix ( createLink, fileExist, removeLink )
import Text.Printf ( printf )

import Photoname.Common ( CopySwitch (..), DestPath (..), MoveSwitch (..),
  NoActionSwitch (..), NoDirsSwitch (..), ParentDir (..), Options (..),
  Ph, Prefix (..), SrcPath (..), Suffix (..),
  ask, asks, liftIO, throwError )
import Photoname.Date
  ( PhDate (ExifDate, FilenameDate, NoDateFound)
  , formatDateHyphens, formatDateTime, formatYear
  )
import Photoname.Log ( lname, noticeM, warningM )


createNewLink :: PhDate -> SrcPath -> Ph DestPath
createNewLink :: PhDate -> SrcPath -> Ph DestPath
createNewLink PhDate
imageDate srcPath :: SrcPath
srcPath@(SrcPath FilePath
srcFp) = do
  Options
opts <- ReaderT Options (ExceptT FilePath IO) Options
forall r (m :: * -> *). MonadReader r m => m r
ask
  destPath :: DestPath
destPath@(DestPath FilePath
destFp) <- case PhDate
imageDate of
    ExifDate LocalTime
lt -> LocalTime -> Ph DestPath
buildDatePath LocalTime
lt
    FilenameDate LocalTime
lt -> LocalTime -> Ph DestPath
buildDatePath LocalTime
lt
    PhDate
NoDateFound -> FilePath -> Ph DestPath
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"Could not extract any date information"

  -- Check for existence of the target file
  Bool
exists <- IO Bool -> ReaderT Options (ExceptT FilePath IO) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Options (ExceptT FilePath IO) Bool)
-> IO Bool -> ReaderT Options (ExceptT FilePath IO) Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
fileExist FilePath
destFp
  Bool
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (ReaderT Options (ExceptT FilePath IO) ()
 -> ReaderT Options (ExceptT FilePath IO) ())
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ReaderT Options (ExceptT FilePath IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ReaderT Options (ExceptT FilePath IO) ())
-> FilePath -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Destination " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destFp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" exists!"

  -- Display what will be done
  IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
noticeM FilePath
lname (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
srcFp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destFp

  Bool
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
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) (ReaderT Options (ExceptT FilePath IO) ()
 -> ReaderT Options (ExceptT FilePath IO) ())
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ do
    -- Make the target dir
    IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
destFp

    -- Make the new file
    if (Bool -> CopySwitch) -> CopySwitch -> Bool
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op Bool -> CopySwitch
CopySwitch (CopySwitch -> Bool) -> (Options -> CopySwitch) -> Options -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> CopySwitch
optCopy (Options -> Bool) -> Options -> Bool
forall a b. (a -> b) -> a -> b
$ Options
opts
      then IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
srcFp FilePath
destFp
      else SrcPath -> DestPath -> ReaderT Options (ExceptT FilePath IO) ()
tryHardLink SrcPath
srcPath DestPath
destPath

    -- If user has specified, remove the original link
    Bool
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> MoveSwitch) -> MoveSwitch -> Bool
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op Bool -> MoveSwitch
MoveSwitch (MoveSwitch -> Bool) -> (Options -> MoveSwitch) -> Options -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> MoveSwitch
optMove (Options -> Bool) -> Options -> Bool
forall a b. (a -> b) -> a -> b
$ Options
opts) (ReaderT Options (ExceptT FilePath IO) ()
 -> ReaderT Options (ExceptT FilePath IO) ())
-> ReaderT Options (ExceptT FilePath IO) ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$
       IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeLink FilePath
srcFp

  DestPath -> Ph DestPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure DestPath
destPath


tryHardLink :: SrcPath -> DestPath -> Ph ()
tryHardLink :: SrcPath -> DestPath -> ReaderT Options (ExceptT FilePath IO) ()
tryHardLink (SrcPath FilePath
srcFp) (DestPath FilePath
destFp) = do
  Either IOException ()
ei <- IO (Either IOException ())
-> ReaderT Options (ExceptT FilePath IO) (Either IOException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
 -> ReaderT Options (ExceptT FilePath IO) (Either IOException ()))
-> IO (Either IOException ())
-> ReaderT Options (ExceptT FilePath IO) (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createLink FilePath
srcFp FilePath
destFp
  (IOException -> ReaderT Options (ExceptT FilePath IO) ())
-> (() -> ReaderT Options (ExceptT FilePath IO) ())
-> Either IOException ()
-> ReaderT Options (ExceptT FilePath IO) ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> ReaderT Options (ExceptT FilePath IO) ()
failureHandler () -> ReaderT Options (ExceptT FilePath IO) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either IOException ()
ei
  where
    failureHandler :: IOException -> Ph ()
    failureHandler :: IOException -> ReaderT Options (ExceptT FilePath IO) ()
failureHandler IOException
_ = do
      IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
warningM FilePath
lname FilePath
"Hard link failed, attempting to copy instead"
      IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Options (ExceptT FilePath IO) ())
-> IO () -> ReaderT Options (ExceptT FilePath IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
srcFp FilePath
destFp


{- Construct the destination file path based on the information we have (parent
   dir, subdirs wanted or not, prefix and suffix, and the date info that was
   gathered).
-}
buildDatePath :: LocalTime -> Ph DestPath
buildDatePath :: LocalTime -> Ph DestPath
buildDatePath LocalTime
date = do
   FilePath
prefixStr <- (Options -> FilePath)
-> ReaderT Options (ExceptT FilePath IO) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((FilePath -> Prefix) -> Prefix -> FilePath
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op FilePath -> Prefix
Prefix (Prefix -> FilePath) -> (Options -> Prefix) -> Options -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Prefix
optPrefix)
   FilePath
suffixStr <- (Options -> FilePath)
-> ReaderT Options (ExceptT FilePath IO) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((FilePath -> Suffix) -> Suffix -> FilePath
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op FilePath -> Suffix
Suffix (Suffix -> FilePath) -> (Options -> Suffix) -> Options -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Suffix
optSuffix)
   let fileName :: FilePath
fileName = FilePath -> FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%s%s%s.jpg" FilePath
prefixStr (LocalTime -> FilePath
formatDateTime LocalTime
date) FilePath
suffixStr

   FilePath
parentFp <- (Options -> FilePath)
-> ReaderT Options (ExceptT FilePath IO) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((FilePath -> ParentDir) -> ParentDir -> FilePath
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op FilePath -> ParentDir
ParentDir (ParentDir -> FilePath)
-> (Options -> ParentDir) -> Options -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ParentDir
optParentDir)
   Bool
noDirs <- (Options -> Bool) -> ReaderT Options (ExceptT FilePath IO) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Bool -> NoDirsSwitch) -> NoDirsSwitch -> Bool
forall n o. (Newtype n, o ~ O n) => (o -> n) -> n -> o
op Bool -> NoDirsSwitch
NoDirsSwitch (NoDirsSwitch -> Bool)
-> (Options -> NoDirsSwitch) -> Options -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> NoDirsSwitch
optNoDirs)
   DestPath -> Ph DestPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DestPath -> Ph DestPath)
-> (FilePath -> DestPath) -> FilePath -> Ph DestPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DestPath
DestPath (FilePath -> Ph DestPath) -> FilePath -> Ph DestPath
forall a b. (a -> b) -> a -> b
$ if Bool
noDirs
      then FilePath
parentFp FilePath -> FilePath -> FilePath
</> FilePath
fileName
      else FilePath
parentFp FilePath -> FilePath -> FilePath
</> LocalTime -> FilePath
formatYear LocalTime
date FilePath -> FilePath -> FilePath
</>
         LocalTime -> FilePath
formatDateHyphens LocalTime
date FilePath -> FilePath -> FilePath
</> FilePath
fileName