{-# LANGUAGE FlexibleContexts #-}

module Photoname.Exif
  ( getExifDate
  )
  where

import Control.Monad.Trans (MonadIO, liftIO)
import qualified Data.Map as M
import Data.Monoid (First (..))
import Graphics.HsExif (ExifTag, ExifValue, dateTime, dateTimeDigitized,
  dateTimeOriginal, parseFileExif)

import Photoname.Common (SrcPath (SrcPath))


{-
  Load EXIF information from filepath, or evaluate to Nothing
-}

getExifDate :: MonadIO m => SrcPath -> m (Maybe String)
getExifDate :: forall (m :: * -> *). MonadIO m => SrcPath -> m (Maybe String)
getExifDate (SrcPath String
fp) = IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ Either String (Map ExifTag ExifValue) -> Maybe String
extractDate (Either String (Map ExifTag ExifValue) -> Maybe String)
-> IO (Either String (Map ExifTag ExifValue)) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either String (Map ExifTag ExifValue))
parseFileExif String
fp


{-
  Extract the date from the passed in EXIF data, if we got any from the file.
  Evaluate to Nothing if we can't locate a date at all.
-}

extractDate :: Either String (M.Map ExifTag ExifValue) -> Maybe String
extractDate :: Either String (Map ExifTag ExifValue) -> Maybe String
extractDate (Left String
_) = Maybe String
forall a. Maybe a
Nothing
extractDate (Right Map ExifTag ExifValue
exifMap) =
  ExifValue -> String
forall a. Show a => a -> String
show (ExifValue -> String) -> Maybe ExifValue -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  -- Turn the (Maybe ExifValue) into a (Maybe String)
  ( First ExifValue -> Maybe ExifValue
forall a. First a -> Maybe a
getFirst  -- Remove the First wrapper
  (First ExifValue -> Maybe ExifValue)
-> ([ExifTag] -> First ExifValue) -> [ExifTag] -> Maybe ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [First ExifValue] -> First ExifValue
forall a. Monoid a => [a] -> a
mconcat  -- Collapse these to the first not-Nothing
  -- Look up all of them (resulting in [Maybe ExifValue]), wrap in First data structures
  ([First ExifValue] -> First ExifValue)
-> ([ExifTag] -> [First ExifValue]) -> [ExifTag] -> First ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExifTag -> First ExifValue) -> [ExifTag] -> [First ExifValue]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe ExifValue -> First ExifValue
forall a. Maybe a -> First a
First (Maybe ExifValue -> First ExifValue)
-> (ExifTag -> Maybe ExifValue) -> ExifTag -> First ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue)
-> Map ExifTag ExifValue -> ExifTag -> Maybe ExifValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map ExifTag ExifValue
exifMap)
  -- EXIF tags we're intersted in, in the order we want them left-to-right
  ([ExifTag] -> Maybe ExifValue) -> [ExifTag] -> Maybe ExifValue
forall a b. (a -> b) -> a -> b
$ [ExifTag
dateTimeOriginal, ExifTag
dateTimeDigitized, ExifTag
dateTime])