CopyLink.hs

{-# LANGUAGE OverloadedRecordDot #-}

module Photoname.CopyLink
   ( createNewLink
   )
   where

import Colog.Simple (logNotice, logWarning)
import Control.Exception (try)
import Control.Monad (unless, when)
import Data.Time.LocalTime (LocalTime)
import Formatting ((%+), sformat, string)

import GHC.IO.Exception (IOException)
import System.Directory (copyFile, createDirectoryIfMissing)
import System.FilePath ((</>), (<.>), takeDirectory, takeExtension)
import System.Posix (createLink, fileExist, removeLink)

import Photoname.Common (CopySwitch (v), DestPath (..),
  Extension (Extension, UseExistingExtension), MoveSwitch (v),
  NoActionSwitch (v), NoDirsSwitch (NoDirsSwitch), ParentDir (ParentDir),
  Options (copy, formatter, extension, move, noAction, noDirs, parentDir, prefix, suffix),
  Prefix (Prefix), SrcPath (SrcPath), Suffix (Suffix))
import Photoname.Date (PhDate (ExifDate, FilenameDate, NoDateFound),
  formatDateHyphens, formatYear)
import Photoname.Monad (Env (envOptions), Ph, asks, liftIO)


createNewLink :: PhDate -> SrcPath -> Ph (Maybe DestPath)

createNewLink NoDateFound (SrcPath srcFp) = do
  logWarning $ sformat ("Could not extract any date information from" %+ string) srcFp
  pure Nothing

createNewLink (ExifDate lt) srcPath = createNewLink' srcPath lt

createNewLink (FilenameDate lt) srcPath = createNewLink' srcPath lt


createNewLink' :: SrcPath -> LocalTime -> Ph (Maybe DestPath)
createNewLink' srcPath@(SrcPath srcFp) lt = do
  opts <- asks envOptions

  let ext = case opts.extension of
        (Extension ext') -> ext'
        UseExistingExtension -> takeExtension srcFp

  destPath@(DestPath destFp) <- buildDatePath lt ext

  -- Check for existence of the target file
  targetExists <- liftIO $ fileExist destFp
  if targetExists
    then do
      logWarning $ sformat ("Destination" %+ string %+ "exists!") destFp
      pure Nothing
    else do
      -- Display what will be done
      logNotice $ sformat (string %+ "->" %+ string) srcFp destFp

      unless opts.noAction.v $ do
        -- Make the target dir
        liftIO $ createDirectoryIfMissing True $ takeDirectory destFp

        -- Make the new file
        if opts.copy.v
          then liftIO $ copyFile srcFp destFp
          else tryHardLink srcPath destPath

        -- If user has specified, remove the original link
        when opts.move.v $
           liftIO $ removeLink srcFp

      pure $ Just destPath


tryHardLink :: SrcPath -> DestPath -> Ph ()
tryHardLink (SrcPath srcFp) (DestPath destFp) = do
  ei <- liftIO $ try $ createLink srcFp destFp
  either failureHandler pure ei
  where
    failureHandler :: IOException -> Ph ()
    failureHandler _ = do
      logWarning "Hard link failed, attempting to copy instead"
      liftIO $ copyFile srcFp 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 -> FilePath -> Ph DestPath
buildDatePath date ext = do
   (Prefix prefixStr) <- asks $ prefix . envOptions
   (Suffix suffixStr) <- asks $ suffix . envOptions
   dateFormatter <- asks $ formatter . envOptions
   let fileName = prefixStr <> dateFormatter date <> suffixStr

   (ParentDir parentDir') <- asks $ parentDir . envOptions
   (NoDirsSwitch noDirs') <- asks $ noDirs . envOptions
   pure . DestPath $ if noDirs'
      then parentDir' </> fileName <.> ext
      else parentDir' </> formatYear date </>
         formatDateHyphens date </> fileName <.> ext