-- | Time compatibility layer
-- (stuff to support old lambdabot state serialization formats)
--
-- TODO: trim this down to just the explicitly serialization-related stuff
module Lambdabot.Compat.AltTime 
    ( ClockTime
    , getClockTime
    , diffClockTimes
    , addToClockTime
    , timeDiffPretty
    
    , TimeDiff(..)
    , noTimeDiff
    ) where

import Control.Arrow (first)

import Data.Binary

import Data.List
import Data.Time
import Text.Read hiding (get, lexP, readPrec)
import Text.Read.Lex

-- | Wrapping ClockTime (which doesn't provide a Read instance!) seems
-- easier than talking care of the serialization of UserStatus
-- ourselves.
--
newtype ClockTime = ClockTime UTCTime
    deriving ClockTime -> ClockTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockTime -> ClockTime -> Bool
$c/= :: ClockTime -> ClockTime -> Bool
== :: ClockTime -> ClockTime -> Bool
$c== :: ClockTime -> ClockTime -> Bool
Eq

newtype TimeDiff = TimeDiff NominalDiffTime
    deriving (TimeDiff -> TimeDiff -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeDiff -> TimeDiff -> Bool
$c/= :: TimeDiff -> TimeDiff -> Bool
== :: TimeDiff -> TimeDiff -> Bool
$c== :: TimeDiff -> TimeDiff -> Bool
Eq, Eq TimeDiff
TimeDiff -> TimeDiff -> Bool
TimeDiff -> TimeDiff -> Ordering
TimeDiff -> TimeDiff -> TimeDiff
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
min :: TimeDiff -> TimeDiff -> TimeDiff
$cmin :: TimeDiff -> TimeDiff -> TimeDiff
max :: TimeDiff -> TimeDiff -> TimeDiff
$cmax :: TimeDiff -> TimeDiff -> TimeDiff
>= :: TimeDiff -> TimeDiff -> Bool
$c>= :: TimeDiff -> TimeDiff -> Bool
> :: TimeDiff -> TimeDiff -> Bool
$c> :: TimeDiff -> TimeDiff -> Bool
<= :: TimeDiff -> TimeDiff -> Bool
$c<= :: TimeDiff -> TimeDiff -> Bool
< :: TimeDiff -> TimeDiff -> Bool
$c< :: TimeDiff -> TimeDiff -> Bool
compare :: TimeDiff -> TimeDiff -> Ordering
$ccompare :: TimeDiff -> TimeDiff -> Ordering
Ord)

noTimeDiff :: TimeDiff
noTimeDiff :: TimeDiff
noTimeDiff = NominalDiffTime -> TimeDiff
TimeDiff NominalDiffTime
0

epoch :: UTCTime
epoch :: UTCTime
epoch = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
1970 Int
1 Int
1) DiffTime
0

-- convert to/from the format in old-time, so we can serialize things 
-- in the same way as older versions of lambdabot.
toOldTime :: ClockTime -> (Integer, Integer)
toOldTime :: ClockTime -> (Integer, Integer)
toOldTime (ClockTime UTCTime
t) = forall a b. (RealFrac a, Integral b) => a -> b
round (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
epoch forall a. Num a => a -> a -> a
* NominalDiffTime
1e12) forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
1000000000000

fromOldTime :: Integer -> Integer -> ClockTime
fromOldTime :: Integer -> Integer -> ClockTime
fromOldTime Integer
x Integer
y = UTCTime -> ClockTime
ClockTime (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y forall a. Num a => a -> a -> a
* NominalDiffTime
1e-12) UTCTime
epoch)

instance Show ClockTime where
    showsPrec :: Int -> ClockTime -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> (Integer, Integer)
toOldTime

instance Read ClockTime where
    readsPrec :: Int -> ReadS ClockTime
readsPrec Int
p = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> ClockTime
fromOldTime)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec Int
p

instance Show TimeDiff where
    showsPrec :: Int -> TimeDiff -> ShowS
showsPrec Int
p TimeDiff
td = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        ( String -> ShowS
showString String
"TimeDiff {tdYear = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
ye
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdMonth = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
mo
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdDay = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
da
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdHour = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
ho
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdMin = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
mi
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdSec = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
se
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", tdPicosec = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Integer
ps
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}")
        where (Int
ye, Int
mo, Int
da, Int
ho, Int
mi, Int
se, Integer
ps) = TimeDiff -> (Int, Int, Int, Int, Int, Int, Integer)
toOldTimeDiff TimeDiff
td

instance Read TimeDiff where
    readsPrec :: Int -> ReadS TimeDiff
readsPrec = forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S forall a b. (a -> b) -> a -> b
$ forall a. ReadPrec a -> ReadPrec a
parens
        (forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 (do
            let lexP :: ReadPrec Lexeme
lexP = forall a. ReadP a -> ReadPrec a
lift ReadP Lexeme
Text.Read.Lex.lex
                readPrec :: Read a => ReadPrec a
                readPrec :: forall a. Read a => ReadPrec a
readPrec = forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec forall a. Read a => Int -> ReadS a
readsPrec
            Ident String
"TimeDiff"    <- ReadPrec Lexeme
lexP
            Punc String
"{"            <- ReadPrec Lexeme
lexP
            Ident String
"tdYear"      <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
ye                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdMonth"     <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
mo                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdDay"       <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
da                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdHour"      <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
ho                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdMin"       <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
mi                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdSec"       <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Int
se                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
","            <- ReadPrec Lexeme
lexP
            Ident String
"tdPicosec"   <- ReadPrec Lexeme
lexP
            Punc String
"="            <- ReadPrec Lexeme
lexP
            Integer
ps                  <- forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
            Punc String
"}"            <- ReadPrec Lexeme
lexP
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
fromOldTimeDiff Int
ye Int
mo Int
da Int
ho Int
mi Int
se Integer
ps)))
    readList :: ReadS [TimeDiff]
readList = forall a. Read a => ReadS [a]
readListDefault
    readListPrec :: ReadPrec [TimeDiff]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

-- | Retrieve the current clocktime
getClockTime :: IO ClockTime
getClockTime :: IO ClockTime
getClockTime = UTCTime -> ClockTime
ClockTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
getCurrentTime

-- | Difference of two clock times
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes (ClockTime UTCTime
ct1) (ClockTime UTCTime
ct2) = NominalDiffTime -> TimeDiff
TimeDiff (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
ct1 UTCTime
ct2)

-- | @'addToClockTime' d t@ adds a time difference @d@ and a -- clock
-- time @t@ to yield a new clock time.
addToClockTime :: TimeDiff -> ClockTime -> ClockTime
addToClockTime :: TimeDiff -> ClockTime -> ClockTime
addToClockTime (TimeDiff NominalDiffTime
td) (ClockTime UTCTime
ct) = UTCTime -> ClockTime
ClockTime (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
td UTCTime
ct)

-- | Pretty-print a TimeDiff. Both positive and negative Timediffs produce
--   the same output.
--
-- 14d 17h 8m 53s
--
timeDiffPretty :: TimeDiff -> String
timeDiffPretty :: TimeDiff -> String
timeDiffPretty TimeDiff
td = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
" " forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    [ forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
ye String
"y"
    , forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
mo String
"m"
    , forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
da String
"d"
    , forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
ho String
"h"
    , forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
mi String
"m"
    , forall {a}. (Eq a, Num a, Show a) => a -> ShowS
prettyP Int
se String
"s"
    ]
  where
    prettyP :: a -> ShowS
prettyP a
0 String
_ = []
    prettyP a
i String
s = forall a. Show a => a -> String
show a
i forall a. [a] -> [a] -> [a]
++ String
s
    
    (Int
ye, Int
mo, Int
da, Int
ho, Int
mi, Int
se, Integer
_) = TimeDiff -> (Int, Int, Int, Int, Int, Int, Integer)
toOldTimeDiff TimeDiff
td

toOldTimeDiff :: TimeDiff -> (Int, Int, Int, Int, Int, Int, Integer)
toOldTimeDiff :: TimeDiff -> (Int, Int, Int, Int, Int, Int, Integer)
toOldTimeDiff (TimeDiff NominalDiffTime
td) = (forall a. Num a => Integer -> a
fromInteger Integer
ye, forall a. Num a => Integer -> a
fromInteger Integer
mo, forall a. Num a => Integer -> a
fromInteger Integer
da, forall a. Num a => Integer -> a
fromInteger Integer
ho, forall a. Num a => Integer -> a
fromInteger Integer
mi, forall a. Num a => Integer -> a
fromInteger Integer
se, Integer
ps)
    where
        (Integer
a,  Integer
ps) = forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime
td forall a. Num a => a -> a -> a
* NominalDiffTime
1e12) forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
1000000000000
        (Integer
b,  Integer
se) = Integer
a forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
60
        (Integer
c,  Integer
mi) = Integer
b forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
60
        (Integer
d,  Integer
ho) = Integer
c forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
24
        (Integer
e,  Integer
da) = Integer
d forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
28
        (Integer
ye, Integer
mo) = Integer
e forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
12

fromOldTimeDiff :: Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
fromOldTimeDiff :: Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
fromOldTimeDiff Int
ye Int
mo Int
da Int
ho Int
mi Int
se Integer
ps =
    NominalDiffTime -> TimeDiff
TimeDiff
        (NominalDiffTime
1e-12 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
ps 
            forall a. Num a => a -> a -> a
+ Integer
1000000000000 forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
se 
                forall a. Num a => a -> a -> a
+ Integer
60 forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
mi 
                    forall a. Num a => a -> a -> a
+ Integer
60 forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
ho
                        forall a. Num a => a -> a -> a
+ Integer
24 forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
da
                            forall a. Num a => a -> a -> a
+ Integer
28 forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
mo
                                forall a. Num a => a -> a -> a
+ Integer
12 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger Int
ye)))))))

------------------------------------------------------------------------

instance Binary ClockTime where
        put :: ClockTime -> Put
put ClockTime
t = forall t. Binary t => t -> Put
put Integer
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Integer
j
            where (Integer
i, Integer
j) = ClockTime -> (Integer, Integer)
toOldTime ClockTime
t
        get :: Get ClockTime
get = do 
            Integer
i <- forall t. Binary t => Get t
get
            Integer
j <- forall t. Binary t => Get t
get
            forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer -> ClockTime
fromOldTime Integer
i Integer
j)

instance Binary TimeDiff where
        put :: TimeDiff -> Put
put TimeDiff
td = do
            forall t. Binary t => t -> Put
put Int
ye; forall t. Binary t => t -> Put
put Int
mo; forall t. Binary t => t -> Put
put Int
da; forall t. Binary t => t -> Put
put Int
ho; forall t. Binary t => t -> Put
put Int
mi; forall t. Binary t => t -> Put
put Int
se; forall t. Binary t => t -> Put
put Integer
ps
            where (Int
ye, Int
mo, Int
da, Int
ho, Int
mi, Int
se, Integer
ps) = TimeDiff -> (Int, Int, Int, Int, Int, Int, Integer)
toOldTimeDiff TimeDiff
td
        get :: Get TimeDiff
get = do
            Int
ye <- forall t. Binary t => Get t
get
            Int
mo <- forall t. Binary t => Get t
get
            Int
da <- forall t. Binary t => Get t
get
            Int
ho <- forall t. Binary t => Get t
get
            Int
mi <- forall t. Binary t => Get t
get
            Int
se <- forall t. Binary t => Get t
get
            Integer
ps <- forall t. Binary t => Get t
get
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
fromOldTimeDiff Int
ye Int
mo Int
da Int
ho Int
mi Int
se Integer
ps)