{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Time
  (
    Time,
    ParseTime(..),
    FormatTime(..),
    _Time,
    day,
    time,
    now
  ) where

import Lawless
import Data.Time.Clock
import Data.Time.Calendar
import Data.Time.Format
import Generics
import Data.Binary

import qualified Textual as T

newtype Time = Time UTCTime deriving (Show, Eq, Ord, ParseTime, FormatTime, Generic)
makePrisms ''Time

day :: Lens' Time Day
day = lens (utctDay ∘ view _Time) (\(Time (UTCTime{..})) d → Time $ UTCTime d utctDayTime)

time ∷ Lens' Time DiffTime
time = lens (utctDayTime ∘ view _Time) (\(Time (UTCTime{..})) t → Time $ UTCTime utctDay t)

now ∷ IO Time
now = Time <$> getCurrentTime

instance Binary Time where
  put t =
    put (toModifiedJulianDay (t ^. day)) >>
    put (toRational (t ^. time))

  get = do
    d ← ModifiedJulianDay <$> get
    t ← fromRational <$> get
    return ∘ Time $ UTCTime d t

instance T.Printable Time where
  print = T.print ∘ formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S%QZ"))