-- Copyright: 2007, 2008 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli <dino@ui3.info>

module Main
   where

import Control.Monad.Reader
import Control.Monad.Writer
import qualified Graphics.Exif as Exif
import Photoname.Date
import qualified Photoname.Opts as Opts
import Photoname.Serial ( getSerial )
import System.Environment ( getArgs )
import System.FilePath
import System.Posix


modeDir :: FileMode
modeDir = ownerModes       `unionFileModes`
          groupReadMode    `unionFileModes`
          groupExecuteMode


{- Given a list of lists, make a new list where each sublist element 
   consists of the accumulation of all parts that came before it. 
   Like this:
      before: [[1], [2], [3], [4], [5]]
      after : [[1], [1,2], [1,2,3], [1,2,3,4], [1,2,3,4,5]]

   Many thanks to Betty Diegel for help with this algorithm.
-}
listAcc :: [[a]] -> [[a]]
listAcc []     = [[]]
listAcc (x:xs) = listAcc' x xs
   where
      listAcc' l (y:ys) = [l] ++ listAcc' (l ++ y) ys
      listAcc' l []     = [l]


{- Execute a sequence of m (Maybe a) actions until the first non-Nothing
   evaluation, eval to that.

   Thanks to sjanssen et al on #haskell

   XXX Can this be genericized to be :: (Monad m, Monad n) =>
       [m (n a)] -> m (n a)
   XXX Put this in a more common module.
-}
firstSuccess :: Monad m => [m (Maybe a)] -> m (Maybe a)
firstSuccess = foldr f (return Nothing)
   where
      f :: Monad t => t (Maybe m1) -> t (Maybe m1) -> t (Maybe m1)
      f m ms = do  -- m in here, NOT Maybe
         x <- m
         case x of
            Just _  -> return x
            Nothing -> ms


{- Get shoot date from the exif information. There are several tags 
   potentially containing dates. Try them in a specific order until we
   find one that has data.
-}
getDate :: Exif.Exif -> IO (Maybe String)
getDate exif =
   firstSuccess $ map (Exif.getTag exif)
      ["DateTimeDigitized", "DateTimeOriginal", "DateTime"]


{- Take a file path to a JPEG file and use EXIF information available to 
   move the file to a new location below the given basedir.
-}
createNewLink :: FilePath -> FilePath -> Ph ()
createNewLink newDir oldPath = do
   flags <- ask
   e <- liftIO $ buildNewPath newDir oldPath
   case e of
      Left err      -> tell [err]
      Right newPath -> do
         -- Check for existance of the target file
         exists <- liftIO $ fileExist newPath
         if exists
            then tell
               ["** " ++ oldPath ++ " -> " ++ newPath ++ " exists!"]
            else do
               -- Display what will be done
               unless (Opts.Quiet `elem` flags) $ 
                  tell [(oldPath ++ " -> " ++ newPath)]

               unless (Opts.NoAction `elem` flags) $ do
                  -- Make the target dir
                  liftIO $ makeDirectory $ takeDirectory newPath

                  -- Make the new hard link
                  liftIO $ createLink oldPath newPath

                  -- If user has specified, remove the original link
                  when (Opts.Move `elem` flags) $
                     liftIO $ removeLink oldPath


{- Ensuring that a directory with subs exists turned out to be a painful 
   process involving making each parent dir piece by piece but not trying
   to make anything that's already there.
-}
makeDirectory :: FilePath -> IO ()
makeDirectory d =
   let makeOneDir dir = do
         exists <- fileExist dir
         unless exists $ createDirectory dir modeDir
   in  mapM_ makeOneDir $ listAcc $ splitPath d


{- Given a path to a file with EXIF data, construct a new path based on the
   date and some serial number info we can parse out of the filename.
   This function got complicated, there are several ways this can fail.
-}
buildNewPath :: FilePath -> FilePath -> IO (Either String FilePath)
buildNewPath newDir oldPath = do
   exif <- Exif.fromFile oldPath
   maybeDs <- getDate exif
   case maybeDs of
      Just ds  -> do
         let date = readDate ds
         let maybeSerial = getSerial oldPath
         case maybeSerial of
            Just serial -> do
               let year = formatYear date
               let day = formatDay date
               let prefix = formatPrefix date
               return $ Right $ newDir </> year </> day </> 
                  (prefix ++ "_" ++ serial) <.> "jpg"
            Nothing -> return $ Left $ "File " ++ oldPath ++ " has no serial."
      Nothing  -> return $ Left $ "File " ++ oldPath ++ " has no EXIF date."


-- Figure out and execute what the user wants based on the supplied args.
executeCommands :: [String] -> Ph ()

-- User gave no files at all. Display help
executeCommands [] = tell [Opts.usageText]

-- Normal program operation, process the files with the args.
executeCommands (dir:filePaths) = do
   flags <- ask

   -- Get rid of anything not a regular file from the list of paths
   actualPaths <- liftIO $ filterM
      (\p -> getFileStatus p >>= return . isRegularFile) filePaths

   -- Notify user of the switches that will be in effect.
   when (Opts.NoAction `elem` flags) $
      tell ["No-action mode, nothing will be changed."]

   when (Opts.Move `elem` flags) $
      tell ["Removing original links after new links are in place."]

   -- Do the link manipulations.
   mapM_ (createNewLink dir) actualPaths


type Ph a = ReaderT [Opts.Flag] (WriterT [String] IO) a

runMain :: [Opts.Flag] -> Ph a -> IO (a, [String])
runMain env exec = runWriterT $ runReaderT exec env

main :: IO ()
main = do
   -- Parse the arguments
   (flags, paths) <- getArgs >>= Opts.parseOpts

   -- Do the photo naming procedure
   (rval, messages) <- runMain flags $ executeCommands paths

   -- Display collected output log
   putStrLn $ unlines messages

   return rval