{-# LANGUAGE FlexibleContexts #-}

module Photoname.Exif
  ( getExifDate
  )
  where

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

import Photoname.Common ( SrcPath (..) )


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

getExifDate :: MonadIO m => SrcPath -> m (Maybe String)
getExifDate :: SrcPath -> m (Maybe String)
getExifDate (SrcPath String
fp) = IO (Maybe String) -> m (Maybe String)
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) =
  -- Find the first date available in the Map
  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
<$> ( (Maybe ExifValue -> First ExifValue)
-> ((Maybe ExifValue -> First ExifValue)
    -> [Maybe ExifValue] -> First ExifValue)
-> [Maybe ExifValue]
-> Maybe ExifValue
forall n n' o' o b.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> ((o -> n) -> b -> n') -> b -> o'
ala Maybe ExifValue -> First ExifValue
forall a. Maybe a -> First a
First (Maybe ExifValue -> First ExifValue)
-> [Maybe ExifValue] -> First ExifValue
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Maybe ExifValue] -> Maybe ExifValue)
-> [Maybe ExifValue] -> Maybe ExifValue
forall a b. (a -> b) -> a -> b
$ (ExifTag -> Maybe ExifValue) -> [ExifTag] -> [Maybe ExifValue]
forall a b. (a -> b) -> [a] -> [b]
map ((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)
    [ExifTag
dateTimeOriginal, ExifTag
dateTimeDigitized, ExifTag
dateTime] )