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
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
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
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
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 :: 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)
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)