{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}

-- | Defines utilies for working with timestamped things.
module Achille.Timestamped
    ( Timestamped(..)
    , IsTimestamped
    , timestamp
    , timestamped
    , timestampedWith
    , compareTimestamped
    , recentFirst
    , oldFirst
    ) where

import Data.Ord                   (Ord, compare, Ordering)
import System.FilePath            (FilePath)
import Data.List                  (sortBy, sort)
import Data.Typeable              (Typeable)
import Data.Binary                (Binary, put, get)
import Data.Time.Calendar         (fromGregorian)
import Data.Time                  (UTCTime(..), secondsToDiffTime)
import Data.Time.Format           (readSTime, defaultTimeLocale)
import System.FilePath            (takeFileName)
import Data.Binary.Instances.Time ()

-- | Container for timestamping data.
data Timestamped a = Timestamped UTCTime a
    deriving (Int -> Timestamped a -> ShowS
[Timestamped a] -> ShowS
Timestamped a -> String
(Int -> Timestamped a -> ShowS)
-> (Timestamped a -> String)
-> ([Timestamped a] -> ShowS)
-> Show (Timestamped a)
forall a. Show a => Int -> Timestamped a -> ShowS
forall a. Show a => [Timestamped a] -> ShowS
forall a. Show a => Timestamped a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamped a] -> ShowS
$cshowList :: forall a. Show a => [Timestamped a] -> ShowS
show :: Timestamped a -> String
$cshow :: forall a. Show a => Timestamped a -> String
showsPrec :: Int -> Timestamped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Timestamped a -> ShowS
Show, Timestamped a -> Timestamped a -> Bool
(Timestamped a -> Timestamped a -> Bool)
-> (Timestamped a -> Timestamped a -> Bool) -> Eq (Timestamped a)
forall a. Eq a => Timestamped a -> Timestamped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamped a -> Timestamped a -> Bool
$c/= :: forall a. Eq a => Timestamped a -> Timestamped a -> Bool
== :: Timestamped a -> Timestamped a -> Bool
$c== :: forall a. Eq a => Timestamped a -> Timestamped a -> Bool
Eq, Eq (Timestamped a)
Eq (Timestamped a) =>
(Timestamped a -> Timestamped a -> Ordering)
-> (Timestamped a -> Timestamped a -> Bool)
-> (Timestamped a -> Timestamped a -> Bool)
-> (Timestamped a -> Timestamped a -> Bool)
-> (Timestamped a -> Timestamped a -> Bool)
-> (Timestamped a -> Timestamped a -> Timestamped a)
-> (Timestamped a -> Timestamped a -> Timestamped a)
-> Ord (Timestamped a)
Timestamped a -> Timestamped a -> Bool
Timestamped a -> Timestamped a -> Ordering
Timestamped a -> Timestamped a -> Timestamped a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Timestamped a)
forall a. Ord a => Timestamped a -> Timestamped a -> Bool
forall a. Ord a => Timestamped a -> Timestamped a -> Ordering
forall a. Ord a => Timestamped a -> Timestamped a -> Timestamped a
min :: Timestamped a -> Timestamped a -> Timestamped a
$cmin :: forall a. Ord a => Timestamped a -> Timestamped a -> Timestamped a
max :: Timestamped a -> Timestamped a -> Timestamped a
$cmax :: forall a. Ord a => Timestamped a -> Timestamped a -> Timestamped a
>= :: Timestamped a -> Timestamped a -> Bool
$c>= :: forall a. Ord a => Timestamped a -> Timestamped a -> Bool
> :: Timestamped a -> Timestamped a -> Bool
$c> :: forall a. Ord a => Timestamped a -> Timestamped a -> Bool
<= :: Timestamped a -> Timestamped a -> Bool
$c<= :: forall a. Ord a => Timestamped a -> Timestamped a -> Bool
< :: Timestamped a -> Timestamped a -> Bool
$c< :: forall a. Ord a => Timestamped a -> Timestamped a -> Bool
compare :: Timestamped a -> Timestamped a -> Ordering
$ccompare :: forall a. Ord a => Timestamped a -> Timestamped a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Timestamped a)
Ord, Typeable, a -> Timestamped b -> Timestamped a
(a -> b) -> Timestamped a -> Timestamped b
(forall a b. (a -> b) -> Timestamped a -> Timestamped b)
-> (forall a b. a -> Timestamped b -> Timestamped a)
-> Functor Timestamped
forall a b. a -> Timestamped b -> Timestamped a
forall a b. (a -> b) -> Timestamped a -> Timestamped b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Timestamped b -> Timestamped a
$c<$ :: forall a b. a -> Timestamped b -> Timestamped a
fmap :: (a -> b) -> Timestamped a -> Timestamped b
$cfmap :: forall a b. (a -> b) -> Timestamped a -> Timestamped b
Functor)

instance Binary a => Binary (Timestamped a) where
    put :: Timestamped a -> Put
put (Timestamped d :: UTCTime
d x :: a
x) = UTCTime -> Put
forall t. Binary t => t -> Put
put UTCTime
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    get :: Get (Timestamped a)
get                   = UTCTime -> a -> Timestamped a
forall a. UTCTime -> a -> Timestamped a
Timestamped (UTCTime -> a -> Timestamped a)
-> Get UTCTime -> Get (a -> Timestamped a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get UTCTime
forall t. Binary t => Get t
get Get (a -> Timestamped a) -> Get a -> Get (Timestamped a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
get


-- | Class for values that can be timestamped.
class IsTimestamped a where
    -- | Retrieve a datetime from a value.
    timestamp :: a -> UTCTime

instance IsTimestamped (Timestamped a) where
    timestamp :: Timestamped a -> UTCTime
timestamp (Timestamped d :: UTCTime
d _) = UTCTime
d

instance IsTimestamped FilePath where
    timestamp :: String -> UTCTime
timestamp p :: String
p =
        case Bool -> TimeLocale -> String -> ReadS UTCTime
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
readSTime Bool
False TimeLocale
defaultTimeLocale "%Y-%m-%d" (ShowS
takeFileName String
p) of
            [(t :: UTCTime
t, _)] -> UTCTime
t
            _        -> Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian 1970 01 01) (Integer -> DiffTime
secondsToDiffTime 0)


-- | Wrap a value that can be timestamped.
timestamped :: IsTimestamped a => a -> Timestamped a
timestamped :: a -> Timestamped a
timestamped x :: a
x = UTCTime -> a -> Timestamped a
forall a. UTCTime -> a -> Timestamped a
Timestamped (a -> UTCTime
forall a. IsTimestamped a => a -> UTCTime
timestamp a
x) a
x

-- | Wrap a value that can be timestamped, using the given function for
--   retrieving the timestamp.
timestampedWith :: (a -> UTCTime) -> a -> Timestamped a
timestampedWith :: (a -> UTCTime) -> a -> Timestamped a
timestampedWith f :: a -> UTCTime
f x :: a
x = UTCTime -> a -> Timestamped a
forall a. UTCTime -> a -> Timestamped a
Timestamped (a -> UTCTime
f a
x) a
x

-- | Compare two timestamped values.
compareTimestamped :: IsTimestamped a => a -> a -> Ordering
compareTimestamped :: a -> a -> Ordering
compareTimestamped x :: a
x y :: a
y = UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> UTCTime
forall a. IsTimestamped a => a -> UTCTime
timestamp a
x) (a -> UTCTime
forall a. IsTimestamped a => a -> UTCTime
timestamp a
y)

-- | Sort timestamped values from most recent to oldest.
recentFirst :: IsTimestamped a => [a] -> [a]
recentFirst :: [a] -> [a]
recentFirst = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. IsTimestamped a => a -> a -> Ordering
compareTimestamped)

-- | Sort timestamped values from oldest to most recent.
oldFirst :: IsTimestamped a => [a] -> [a]
oldFirst :: [a] -> [a]
oldFirst = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. IsTimestamped a => a -> a -> Ordering
compareTimestamped