    -- | 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
    (ClockTime -> ClockTime -> Bool)
    -> (ClockTime -> ClockTime -> Bool) -> Eq ClockTime
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ClockTime -> ClockTime -> Bool
    == :: ClockTime -> ClockTime -> Bool
    $c/= :: ClockTime -> ClockTime -> Bool
    /= :: ClockTime -> ClockTime -> Bool
    Eq

    newtype TimeDiff = TimeDiff NominalDiffTime
        deriving (TimeDiff -> TimeDiff -> Bool
    (TimeDiff -> TimeDiff -> Bool)
    -> (TimeDiff -> TimeDiff -> Bool) -> Eq TimeDiff
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TimeDiff -> TimeDiff -> Bool
    == :: TimeDiff -> TimeDiff -> Bool
    $c/= :: TimeDiff -> TimeDiff -> Bool
    /= :: TimeDiff -> TimeDiff -> Bool
    Eq, Eq TimeDiff
    Eq TimeDiff =>
    (TimeDiff -> TimeDiff -> Ordering)
    -> (TimeDiff -> TimeDiff -> Bool)
    -> (TimeDiff -> TimeDiff -> Bool)
    -> (TimeDiff -> TimeDiff -> Bool)
    -> (TimeDiff -> TimeDiff -> Bool)
    -> (TimeDiff -> TimeDiff -> TimeDiff)
    -> (TimeDiff -> TimeDiff -> TimeDiff)
    -> Ord 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
    $ccompare :: TimeDiff -> TimeDiff -> Ordering
    compare :: TimeDiff -> TimeDiff -> Ordering
    $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
    >= :: TimeDiff -> TimeDiff -> Bool
    $cmax :: TimeDiff -> TimeDiff -> TimeDiff
    max :: TimeDiff -> TimeDiff -> TimeDiff
    $cmin :: TimeDiff -> TimeDiff -> TimeDiff
    min :: TimeDiff -> TimeDiff -> TimeDiff
    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) = NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    t UTCTime
    epoch NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    1e12) Integer -> Integer -> (Integer, Integer)
    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 (Integer -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    x NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    + Integer -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    y NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    1e-12) UTCTime
    epoch)

    instance Show ClockTime where
        showsPrec :: Int -> ClockTime -> ShowS
    showsPrec Int
    p = Int -> (Integer, Integer) -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p ((Integer, Integer) -> ShowS)
    -> (ClockTime -> (Integer, Integer)) -> ClockTime -> ShowS
    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 = (((Integer, Integer), String) -> (ClockTime, String))
    -> [((Integer, Integer), String)] -> [(ClockTime, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Integer, Integer) -> ClockTime)
    -> ((Integer, Integer), String) -> (ClockTime, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Integer -> Integer -> ClockTime)
    -> (Integer, Integer) -> ClockTime
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Integer -> Integer -> ClockTime
    fromOldTime)) ([((Integer, Integer), String)] -> [(ClockTime, String)])
    -> (String -> [((Integer, Integer), String)]) -> ReadS ClockTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> [((Integer, Integer), String)]
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
            ( String -> ShowS
    showString String
    "TimeDiff {tdYear = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    ye
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdMonth = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    mo
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdDay = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    da
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdHour = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    ho
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdMin = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    mi
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdSec = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    se
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", tdPicosec = "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Integer
    ps
            ShowS -> ShowS -> ShowS
    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 = ReadPrec TimeDiff -> Int -> ReadS TimeDiff
    forall a. ReadPrec a -> Int -> ReadS a
    readPrec_to_S (ReadPrec TimeDiff -> Int -> ReadS TimeDiff)
    -> ReadPrec TimeDiff -> Int -> ReadS TimeDiff
    forall a b. (a -> b) -> a -> b
    $ ReadPrec TimeDiff -> ReadPrec TimeDiff
    forall a. ReadPrec a -> ReadPrec a
    parens
            (Int -> ReadPrec TimeDiff -> ReadPrec TimeDiff
    forall a. Int -> ReadPrec a -> ReadPrec a
    prec Int
    11 (do
                let lexP :: ReadPrec Lexeme
    lexP = ReadP Lexeme -> ReadPrec Lexeme
    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 = (Int -> ReadS a) -> ReadPrec a
    forall a. (Int -> ReadS a) -> ReadPrec a
    readS_to_Prec Int -> ReadS a
    forall a. Read a => Int -> ReadS a
    readsPrec
                Ident "TimeDiff"    <- ReadPrec Lexeme
    lexP
                Punc "{"            <- lexP
                Ident "tdYear"      <- lexP
                Punc "="            <- lexP
                ye                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdMonth"     <- lexP
                Punc "="            <- lexP
                mo                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdDay"       <- lexP
                Punc "="            <- lexP
                da                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdHour"      <- lexP
                Punc "="            <- lexP
                ho                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdMin"       <- lexP
                Punc "="            <- lexP
                mi                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdSec"       <- lexP
                Punc "="            <- lexP
                se                  <- reset readPrec
                Punc ","            <- lexP
                Ident "tdPicosec"   <- lexP
                Punc "="            <- lexP
                ps                  <- reset readPrec
                Punc "}"            <- lexP
                return (fromOldTimeDiff ye mo da ho mi se ps)))
        readList :: ReadS [TimeDiff]
    readList = ReadS [TimeDiff]
    forall a. Read a => ReadS [a]
    readListDefault
        readListPrec :: ReadPrec [TimeDiff]
    readListPrec = ReadPrec [TimeDiff]
    forall a. Read a => ReadPrec [a]
    readListPrecDefault

    -- | Retrieve the current clocktime
    getClockTime :: IO ClockTime
    getClockTime :: IO ClockTime
    getClockTime = UTCTime -> ClockTime
    ClockTime (UTCTime -> ClockTime) -> IO UTCTime -> IO ClockTime
    forall a b. (a -> b) -> IO a -> IO b
    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 = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    " " ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null)
        [ Int -> ShowS
    forall {a}. (Eq a, Num a, Show a) => a -> ShowS
    prettyP Int
    ye String
    "y"
        , Int -> ShowS
    forall {a}. (Eq a, Num a, Show a) => a -> ShowS
    prettyP Int
    mo String
    "m"
        , Int -> ShowS
    forall {a}. (Eq a, Num a, Show a) => a -> ShowS
    prettyP Int
    da String
    "d"
        , Int -> ShowS
    forall {a}. (Eq a, Num a, Show a) => a -> ShowS
    prettyP Int
    ho String
    "h"
        , Int -> ShowS
    forall {a}. (Eq a, Num a, Show a) => a -> ShowS
    prettyP Int
    mi String
    "m"
        , Int -> ShowS
    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 = a -> String
    forall a. Show a => a -> String
    show a
    i String -> ShowS
    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) = (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    ye, Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    mo, Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    da, Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    ho, Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    mi, Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    se, Integer
    ps)
        where
            (Integer
    a,  Integer
    ps) = NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (NominalDiffTime
    td NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    1e12) Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    1000000000000
            (Integer
    b,  Integer
    se) = Integer
    a Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    60
            (Integer
    c,  Integer
    mi) = Integer
    b Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    60
            (Integer
    d,  Integer
    ho) = Integer
    c Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    24
            (Integer
    e,  Integer
    da) = Integer
    d Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    28
            (Integer
    ye, Integer
    mo) = Integer
    e Integer -> Integer -> (Integer, Integer)
    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 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * Integer -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    ps
                Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1000000000000 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    se
                    Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    60 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mi
                        Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    60 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    ho
                            Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    24 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    da
                                Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    28 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    mo
                                    Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    12 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    ye)))))))

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

    instance Binary ClockTime where
            put :: ClockTime -> Put
    put ClockTime
    t = Integer -> Put
    forall t. Binary t => t -> Put
    put Integer
    i Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Integer -> Put
    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
                i <- Get Integer
    forall t. Binary t => Get t
    get
                j <- get
                return (fromOldTime i j)

    instance Binary TimeDiff where
            put :: TimeDiff -> Put
    put TimeDiff
    td = do
                Int -> Put
    forall t. Binary t => t -> Put
    put Int
    ye; Int -> Put
    forall t. Binary t => t -> Put
    put Int
    mo; Int -> Put
    forall t. Binary t => t -> Put
    put Int
    da; Int -> Put
    forall t. Binary t => t -> Put
    put Int
    ho; Int -> Put
    forall t. Binary t => t -> Put
    put Int
    mi; Int -> Put
    forall t. Binary t => t -> Put
    put Int
    se; Integer -> Put
    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
                ye <- Get Int
    forall t. Binary t => Get t
    get
                mo <- get
                da <- get
                ho <- get
                mi <- get
                se <- get
                ps <- get
                return (fromOldTimeDiff ye mo da ho mi se ps)