Date.hs

{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# LANGUAGE FlexibleContexts #-}

module Photoname.Date
  ( PhDate (..)
  , formatYear, formatDateHyphens, formatDate, formatDateTime
  , formatDateForExif
  , mkDateFormatter
  , parseExifDate
  , parseFilenameDate
  )
  where

import Data.Functor.Identity (Identity)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..))
import System.FilePath (takeFileName)
import Text.Parsec (ParsecT)
import Text.ParserCombinators.Parsec (anyChar, char, count, digit,
  lookAhead, manyTill, parse, space, try)

import Photoname.Common (SrcPath (SrcPath), defaultDateTimeFormat)


data PhDate
  = ExifDate LocalTime
  | FilenameDate LocalTime
  | NoDateFound
  deriving (Eq, Show)

instance Semigroup PhDate where
  (<>) e@(ExifDate _)     _              = e
  (<>)   (FilenameDate _) e@(ExifDate _) = e
  (<>) f@(FilenameDate _) _              = f
  (<>)    NoDateFound     x              = x

instance Monoid PhDate where
  mempty = NoDateFound


-- Parsec helper defs

colon :: ParsecT String u Identity Char
colon = char ':'

digit2, digit4 :: ParsecT String u Identity [Char]
digit2 = count 2 digit
digit4 = count 4 digit


{- Parse a string in the form "yyyy:mm:dd hh:mm:ss" into a 
   LocalTime datatype. Strings that fail to parse in this manner are
   returned as Nothing
-}
parseExifDate :: Maybe String -> PhDate
parseExifDate Nothing = NoDateFound
parseExifDate (Just s) =
   case parse dateParser "" s of
      Left _  -> NoDateFound
      Right x -> ExifDate x
   where
      dateParser = do
         year <- digit4 ; colon ; month <- digit2 ; colon ; day <- digit2
         space
         hour <- digit2 ; colon ; minute <- digit2
         colon ; second <- digit2
         pure $
            LocalTime
               (fromGregorian (read year) (read month) (read day))
               (TimeOfDay (read hour) (read minute)
                  (fromIntegral (read second :: Integer)))


{- Parse a string in one of the the forms below into a LocalTime datatype.

    /some/path/ANYTHINGyyyy-mm-dd-hhmmss.jpg
    /some/path/ANYTHINGyyyy-mm-dd-hh-mm-ss-ttt.jpg
    ANYTHINGyyyy-mm-dd-hhmmss.jpg
    ANYTHINGyyyy-mm-dd-hh-mm-ss-ttt.jpg
    yyyymmdd-hhmmss.jpg
    yyyymmdd-hhmmss_xyz.jpg
    PXL_yyyymmdd_hhmmssttt.jpg
    PXL_yyyymmdd_hhmmssttt_xyz.jpg
-}
parseFilenameDate :: SrcPath -> PhDate
parseFilenameDate (SrcPath srcPath) =
  case parse dateParser "" (takeFileName srcPath) of
    Left _  -> NoDateFound
    Right x -> FilenameDate x
  where
    dateParser = do
      manyTill anyChar (try $ lookAhead digit4)
      year <- digit4
      manyTill anyChar (try $ lookAhead digit2)
      month <- digit2
      manyTill anyChar (try $ lookAhead digit2)
      day <- digit2
      manyTill anyChar (try $ lookAhead digit2)
      hour <- digit2
      manyTill anyChar (try $ lookAhead digit2)
      minute <- digit2
      manyTill anyChar (try $ lookAhead digit2)
      second <- digit2
      pure $
         LocalTime
            (fromGregorian (read year) (read month) (read day))
            (TimeOfDay (read hour) (read minute)
               (fromIntegral (read second :: Integer)))


{- Format a LocalTime into a "yyyy" string
-}
formatYear :: LocalTime -> String
formatYear = formatTime defaultTimeLocale "%Y"


{- Format a LocalTime into a "yyyy-mm-dd" string
-}
formatDateHyphens :: LocalTime -> String
formatDateHyphens = formatTime defaultTimeLocale "%Y-%m-%d"


{- Format a LocalTime into a "yyyymmdd" string
-}
formatDate :: LocalTime -> String
formatDate = formatTime defaultTimeLocale "%Y%m%d"


{- Format a LocalTime into a "yyyymmdd-HHMMSS" string
-}
formatDateTime :: LocalTime -> String
formatDateTime = mkDateFormatter defaultDateTimeFormat


{- Format a LocalTime into a "yyyy:mm:dd HH:MM:SS" string
-}
formatDateForExif :: LocalTime -> String
formatDateForExif = formatTime defaultTimeLocale "%Y:%m:%d %H:%M:%S"


mkDateFormatter :: String -> LocalTime -> String
mkDateFormatter = formatTime defaultTimeLocale