{-# Language MultiParamTypeClasses, BangPatterns, TemplateHaskell #-}

{-|
Module      : Client.State.Window
Description : Types and operations for managing message buffers.
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module defines types and operations used to store messages for display
in the client's buffers.
-}

module Client.State.Window
  (
  -- * Windows
    Window(..)
  , winName
  , winMessages
  , winUnread
  , winTotal
  , winMention
  , winMarker
  , winHideMeta
  , winHidden
  , winSilent

  -- * Window lines
  , WindowLines(..)
  , WindowLine(..)
  , wlSummary
  , wlText
  , wlPrefix
  , wlImage
  , wlFullImage
  , wlImportance
  , wlTimestamp

  -- * Window line importance
  , WindowLineImportance(..)

  -- * Window operations
  , emptyWindow
  , addToWindow
  , windowSeen
  , windowActivate
  , windowDeactivate
  , windowClear

    -- * Packed time
  , PackedTime
  , packZonedTime
  , unpackUTCTime
  , unpackTimeOfDay
  ) where

import           Client.Image.PackedImage
import           Client.Message
import           Control.Lens
import           Control.Monad ((<$!>))
import           Data.Text.Lazy (Text)
import           Data.Time
import           Data.Word
import           Data.Bits

-- | A single message to be displayed in a window.
-- The normal message line consists of the image prefix
-- and the image. This allows line wrapping to be applied
-- separately to the image and prefix so that wrapped
-- messages can fall to the right side of the prefix.
data WindowLine = WindowLine
  { WindowLine -> IrcSummary
_wlSummary    :: !IrcSummary  -- ^ Summary value
  , WindowLine -> Image'
_wlPrefix     :: !Image'      -- ^ Normal rendered image prefix
  , WindowLine -> Image'
_wlImage      :: !Image'      -- ^ Normal rendered image
  , WindowLine -> Image'
_wlFullImage  :: !Image'      -- ^ Detailed rendered image
  , WindowLine -> WindowLineImportance
_wlImportance :: !WindowLineImportance -- ^ Importance of message
  , WindowLine -> PackedTime
_wlTimestamp  :: {-# UNPACK #-} !PackedTime
  }

newtype PackedTime = PackedTime Word64

data WindowLines
  = {-# UNPACK #-} !WindowLine :- WindowLines
  | Nil

-- | A 'Window' tracks all of the messages and metadata for a particular
-- message buffer.
data Window = Window
  { Window -> Char
_winName'    :: !Char          -- ^ Shortcut name (or NUL)
  , Window -> WindowLines
_winMessages :: !WindowLines   -- ^ Messages to display, newest first
  , Window -> Maybe Int
_winMarker   :: !(Maybe Int)   -- ^ Location of line drawn to indicate newer messages
  , Window -> Int
_winUnread   :: !Int           -- ^ Messages added since buffer was visible
  , Window -> Int
_winTotal    :: !Int           -- ^ Messages in buffer
  , Window -> WindowLineImportance
_winMention  :: !WindowLineImportance -- ^ Indicates an important event is unread
  , Window -> Bool
_winHideMeta :: !Bool          -- ^ Hide metadata messages
  , Window -> Bool
_winHidden   :: !Bool          -- ^ Remove from jump rotation
  , Window -> Bool
_winSilent   :: !Bool          -- ^ Ignore activity
  }

data ActivityLevel = NoActivity | NormalActivity | HighActivity
  deriving (ActivityLevel -> ActivityLevel -> Bool
(ActivityLevel -> ActivityLevel -> Bool)
-> (ActivityLevel -> ActivityLevel -> Bool) -> Eq ActivityLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityLevel -> ActivityLevel -> Bool
$c/= :: ActivityLevel -> ActivityLevel -> Bool
== :: ActivityLevel -> ActivityLevel -> Bool
$c== :: ActivityLevel -> ActivityLevel -> Bool
Eq, Eq ActivityLevel
Eq ActivityLevel
-> (ActivityLevel -> ActivityLevel -> Ordering)
-> (ActivityLevel -> ActivityLevel -> Bool)
-> (ActivityLevel -> ActivityLevel -> Bool)
-> (ActivityLevel -> ActivityLevel -> Bool)
-> (ActivityLevel -> ActivityLevel -> Bool)
-> (ActivityLevel -> ActivityLevel -> ActivityLevel)
-> (ActivityLevel -> ActivityLevel -> ActivityLevel)
-> Ord ActivityLevel
ActivityLevel -> ActivityLevel -> Bool
ActivityLevel -> ActivityLevel -> Ordering
ActivityLevel -> ActivityLevel -> ActivityLevel
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 :: ActivityLevel -> ActivityLevel -> ActivityLevel
$cmin :: ActivityLevel -> ActivityLevel -> ActivityLevel
max :: ActivityLevel -> ActivityLevel -> ActivityLevel
$cmax :: ActivityLevel -> ActivityLevel -> ActivityLevel
>= :: ActivityLevel -> ActivityLevel -> Bool
$c>= :: ActivityLevel -> ActivityLevel -> Bool
> :: ActivityLevel -> ActivityLevel -> Bool
$c> :: ActivityLevel -> ActivityLevel -> Bool
<= :: ActivityLevel -> ActivityLevel -> Bool
$c<= :: ActivityLevel -> ActivityLevel -> Bool
< :: ActivityLevel -> ActivityLevel -> Bool
$c< :: ActivityLevel -> ActivityLevel -> Bool
compare :: ActivityLevel -> ActivityLevel -> Ordering
$ccompare :: ActivityLevel -> ActivityLevel -> Ordering
$cp1Ord :: Eq ActivityLevel
Ord, ReadPrec [ActivityLevel]
ReadPrec ActivityLevel
Int -> ReadS ActivityLevel
ReadS [ActivityLevel]
(Int -> ReadS ActivityLevel)
-> ReadS [ActivityLevel]
-> ReadPrec ActivityLevel
-> ReadPrec [ActivityLevel]
-> Read ActivityLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivityLevel]
$creadListPrec :: ReadPrec [ActivityLevel]
readPrec :: ReadPrec ActivityLevel
$creadPrec :: ReadPrec ActivityLevel
readList :: ReadS [ActivityLevel]
$creadList :: ReadS [ActivityLevel]
readsPrec :: Int -> ReadS ActivityLevel
$creadsPrec :: Int -> ReadS ActivityLevel
Read, Int -> ActivityLevel -> ShowS
[ActivityLevel] -> ShowS
ActivityLevel -> String
(Int -> ActivityLevel -> ShowS)
-> (ActivityLevel -> String)
-> ([ActivityLevel] -> ShowS)
-> Show ActivityLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityLevel] -> ShowS
$cshowList :: [ActivityLevel] -> ShowS
show :: ActivityLevel -> String
$cshow :: ActivityLevel -> String
showsPrec :: Int -> ActivityLevel -> ShowS
$cshowsPrec :: Int -> ActivityLevel -> ShowS
Show)

-- | Flag for the important of a message being added to a window
data WindowLineImportance
  = WLBoring -- ^ Don't update unread count
  | WLNormal -- ^ Increment unread count
  | WLImportant -- ^ Increment unread count and set important flag
  deriving (WindowLineImportance -> WindowLineImportance -> Bool
(WindowLineImportance -> WindowLineImportance -> Bool)
-> (WindowLineImportance -> WindowLineImportance -> Bool)
-> Eq WindowLineImportance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowLineImportance -> WindowLineImportance -> Bool
$c/= :: WindowLineImportance -> WindowLineImportance -> Bool
== :: WindowLineImportance -> WindowLineImportance -> Bool
$c== :: WindowLineImportance -> WindowLineImportance -> Bool
Eq, Eq WindowLineImportance
Eq WindowLineImportance
-> (WindowLineImportance -> WindowLineImportance -> Ordering)
-> (WindowLineImportance -> WindowLineImportance -> Bool)
-> (WindowLineImportance -> WindowLineImportance -> Bool)
-> (WindowLineImportance -> WindowLineImportance -> Bool)
-> (WindowLineImportance -> WindowLineImportance -> Bool)
-> (WindowLineImportance
    -> WindowLineImportance -> WindowLineImportance)
-> (WindowLineImportance
    -> WindowLineImportance -> WindowLineImportance)
-> Ord WindowLineImportance
WindowLineImportance -> WindowLineImportance -> Bool
WindowLineImportance -> WindowLineImportance -> Ordering
WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
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 :: WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
$cmin :: WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
max :: WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
$cmax :: WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
>= :: WindowLineImportance -> WindowLineImportance -> Bool
$c>= :: WindowLineImportance -> WindowLineImportance -> Bool
> :: WindowLineImportance -> WindowLineImportance -> Bool
$c> :: WindowLineImportance -> WindowLineImportance -> Bool
<= :: WindowLineImportance -> WindowLineImportance -> Bool
$c<= :: WindowLineImportance -> WindowLineImportance -> Bool
< :: WindowLineImportance -> WindowLineImportance -> Bool
$c< :: WindowLineImportance -> WindowLineImportance -> Bool
compare :: WindowLineImportance -> WindowLineImportance -> Ordering
$ccompare :: WindowLineImportance -> WindowLineImportance -> Ordering
$cp1Ord :: Eq WindowLineImportance
Ord, Int -> WindowLineImportance -> ShowS
[WindowLineImportance] -> ShowS
WindowLineImportance -> String
(Int -> WindowLineImportance -> ShowS)
-> (WindowLineImportance -> String)
-> ([WindowLineImportance] -> ShowS)
-> Show WindowLineImportance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowLineImportance] -> ShowS
$cshowList :: [WindowLineImportance] -> ShowS
show :: WindowLineImportance -> String
$cshow :: WindowLineImportance -> String
showsPrec :: Int -> WindowLineImportance -> ShowS
$cshowsPrec :: Int -> WindowLineImportance -> ShowS
Show, ReadPrec [WindowLineImportance]
ReadPrec WindowLineImportance
Int -> ReadS WindowLineImportance
ReadS [WindowLineImportance]
(Int -> ReadS WindowLineImportance)
-> ReadS [WindowLineImportance]
-> ReadPrec WindowLineImportance
-> ReadPrec [WindowLineImportance]
-> Read WindowLineImportance
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowLineImportance]
$creadListPrec :: ReadPrec [WindowLineImportance]
readPrec :: ReadPrec WindowLineImportance
$creadPrec :: ReadPrec WindowLineImportance
readList :: ReadS [WindowLineImportance]
$creadList :: ReadS [WindowLineImportance]
readsPrec :: Int -> ReadS WindowLineImportance
$creadsPrec :: Int -> ReadS WindowLineImportance
Read)

makeLenses ''Window
makeLenses ''WindowLine

winName :: Lens' Window (Maybe Char)
winName :: (Maybe Char -> f (Maybe Char)) -> Window -> f Window
winName = (Char -> f Char) -> Window -> f Window
Lens' Window Char
winName' ((Char -> f Char) -> Window -> f Window)
-> ((Maybe Char -> f (Maybe Char)) -> Char -> f Char)
-> (Maybe Char -> f (Maybe Char))
-> Window
-> f Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (Maybe Char) (Maybe Char) Char Char
-> Iso Char Char (Maybe Char) (Maybe Char)
forall s t a b. AnIso s t a b -> Iso b a t s
from (Char -> Iso' (Maybe Char) Char
forall a. Eq a => a -> Iso' (Maybe a) a
non Char
'\0')

wlText :: Getter WindowLine Text
wlText :: (Text -> f Text) -> WindowLine -> f WindowLine
wlText = (Image' -> f Image') -> WindowLine -> f WindowLine
Lens' WindowLine Image'
wlFullImage ((Image' -> f Image') -> WindowLine -> f WindowLine)
-> ((Text -> f Text) -> Image' -> f Image')
-> (Text -> f Text)
-> WindowLine
-> f WindowLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Image' -> Text) -> (Text -> f Text) -> Image' -> f Image'
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Image' -> Text
imageText

-- | A window with no messages
emptyWindow :: Window
emptyWindow :: Window
emptyWindow = Window :: Char
-> WindowLines
-> Maybe Int
-> Int
-> Int
-> WindowLineImportance
-> Bool
-> Bool
-> Bool
-> Window
Window
  { _winName' :: Char
_winName'    = Char
'\0'
  , _winMessages :: WindowLines
_winMessages = WindowLines
Nil
  , _winMarker :: Maybe Int
_winMarker   = Maybe Int
forall a. Maybe a
Nothing
  , _winUnread :: Int
_winUnread   = Int
0
  , _winTotal :: Int
_winTotal    = Int
0
  , _winMention :: WindowLineImportance
_winMention  = WindowLineImportance
WLBoring
  , _winHideMeta :: Bool
_winHideMeta = Bool
False
  , _winHidden :: Bool
_winHidden   = Bool
False
  , _winSilent :: Bool
_winSilent   = Bool
False
  }

windowClear :: Window -> Window
windowClear :: Window -> Window
windowClear Window
w = Window
w
  { _winMessages :: WindowLines
_winMessages = WindowLines
Nil
  , _winMarker :: Maybe Int
_winMarker = Maybe Int
forall a. Maybe a
Nothing
  , _winUnread :: Int
_winUnread = Int
0
  , _winTotal :: Int
_winTotal = Int
0
  , _winMention :: WindowLineImportance
_winMention  = WindowLineImportance
WLBoring
  }

-- | Adds a given line to a window as the newest message. Window's
-- unread count will be updated according to the given importance.
addToWindow :: WindowLine -> Window -> Window
addToWindow :: WindowLine -> Window -> Window
addToWindow !WindowLine
msg !Window
win = Window
win
    { _winMessages :: WindowLines
_winMessages = WindowLine
msg WindowLine -> WindowLines -> WindowLines
:- Getting WindowLines Window WindowLines -> Window -> WindowLines
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLines Window WindowLines
Lens' Window WindowLines
winMessages Window
win
    , _winTotal :: Int
_winTotal    = Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winTotal Window
win Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    , _winMarker :: Maybe Int
_winMarker   = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Getting (Maybe Int) Window (Maybe Int) -> Window -> Maybe Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Int) Window (Maybe Int)
Lens' Window (Maybe Int)
winMarker Window
win
    , _winUnread :: Int
_winUnread   = if Getting WindowLineImportance WindowLine WindowLineImportance
-> WindowLine -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance WindowLine WindowLineImportance
Lens' WindowLine WindowLineImportance
wlImportance WindowLine
msg WindowLineImportance -> WindowLineImportance -> Bool
forall a. Eq a => a -> a -> Bool
== WindowLineImportance
WLBoring
                     then Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winUnread Window
win
                     else Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winUnread Window
win Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    , _winMention :: WindowLineImportance
_winMention  = WindowLineImportance
-> WindowLineImportance -> WindowLineImportance
forall a. Ord a => a -> a -> a
max (Getting WindowLineImportance Window WindowLineImportance
-> Window -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance Window WindowLineImportance
Lens' Window WindowLineImportance
winMention Window
win) (Getting WindowLineImportance WindowLine WindowLineImportance
-> WindowLine -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance WindowLine WindowLineImportance
Lens' WindowLine WindowLineImportance
wlImportance WindowLine
msg)
    , _winHideMeta :: Bool
_winHideMeta = Getting Bool Window Bool -> Window -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Window Bool
Lens' Window Bool
winHideMeta Window
win
    }

-- | Update the window clearing the unread count and important flag.
windowSeen :: Window -> Window
windowSeen :: Window -> Window
windowSeen = ASetter Window Window Int Int -> Int -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window Int Int
Lens' Window Int
winUnread Int
0
           (Window -> Window) -> (Window -> Window) -> Window -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Window Window WindowLineImportance WindowLineImportance
-> WindowLineImportance -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window WindowLineImportance WindowLineImportance
Lens' Window WindowLineImportance
winMention WindowLineImportance
WLBoring


-- | Update the window when it first becomes active. If only /boring/
-- messages have been added since last time the marker will be hidden.
windowActivate :: Window -> Window
windowActivate :: Window -> Window
windowActivate Window
win
  | Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winUnread Window
win Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ASetter Window Window (Maybe Int) (Maybe Int)
-> Maybe Int -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window (Maybe Int) (Maybe Int)
Lens' Window (Maybe Int)
winMarker Maybe Int
forall a. Maybe a
Nothing Window
win
  | Bool
otherwise               = Window
win


-- | Update the window when it becomes inactive. This resets the activity
-- marker to the bottom of the window.
windowDeactivate :: Window -> Window
windowDeactivate :: Window -> Window
windowDeactivate = ASetter Window Window (Maybe Int) (Maybe Int)
-> Maybe Int -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window (Maybe Int) (Maybe Int)
Lens' Window (Maybe Int)
winMarker (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)


instance Each WindowLines WindowLines WindowLine WindowLine where
  each :: (WindowLine -> f WindowLine) -> WindowLines -> f WindowLines
each WindowLine -> f WindowLine
_ WindowLines
Nil = WindowLines -> f WindowLines
forall (f :: * -> *) a. Applicative f => a -> f a
pure WindowLines
Nil
  each WindowLine -> f WindowLine
f (WindowLine
x :- WindowLines
xs) = WindowLine -> WindowLines -> WindowLines
(:-) (WindowLine -> WindowLines -> WindowLines)
-> f WindowLine -> f (WindowLines -> WindowLines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowLine -> f WindowLine
f WindowLine
x f (WindowLines -> WindowLines) -> f WindowLines -> f WindowLines
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (WindowLine -> f WindowLine) -> WindowLines -> f WindowLines
forall s t a b. Each s t a b => Traversal s t a b
each WindowLine -> f WindowLine
f WindowLines
xs

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

-- Field   Range   Bits Start
-- year:     0..   33     31
-- month:    1..12 4      27
-- day:      1..31 5      22
-- hour:     0..23 5      17
-- minute:   0..60 6      11
-- second:   0..61 6       5
-- offset: -12..14 5       0

field :: Num a => PackedTime -> Int -> Int -> a
field :: PackedTime -> Int -> Int -> a
field (PackedTime Word64
x) Int
off Int
sz = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
2Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^Int
szWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1))
{-# INLINE field #-}

packField :: Int -> Int -> Word64
packField :: Int -> Int -> Word64
packField Int
off Int
val = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
off

packZonedTime :: ZonedTime -> PackedTime
packZonedTime :: ZonedTime -> PackedTime
packZonedTime (ZonedTime (LocalTime (ModifiedJulianDay Integer
d) (TimeOfDay Int
h Int
m Pico
s)) TimeZone
z)
  = Word64 -> PackedTime
PackedTime
  (Word64 -> PackedTime) -> Word64 -> PackedTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Word64
packField Int
17 Int
h Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField Int
11 Int
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField  Int
5 (Pico -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
s) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField Int
22 (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
d) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField  Int
0 (TimeZone -> Int
timeZoneMinutes TimeZone
z Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)

unpackTimeOfDay :: PackedTime -> TimeOfDay
unpackTimeOfDay :: PackedTime -> TimeOfDay
unpackTimeOfDay !PackedTime
x = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s
  where
    h :: Int
h = PackedTime -> Int -> Int -> Int
forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
17 Int
5
    m :: Int
m = PackedTime -> Int -> Int -> Int
forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
11 Int
6
    s :: Pico
s = PackedTime -> Int -> Int -> Pico
forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x  Int
5 Int
6

unpackLocalTime :: PackedTime -> LocalTime
unpackLocalTime :: PackedTime -> LocalTime
unpackLocalTime !PackedTime
x = Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
t
  where
    d :: Day
d = Integer -> Day
ModifiedJulianDay (PackedTime -> Int -> Int -> Integer
forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
22 Int
42)
    t :: TimeOfDay
t = PackedTime -> TimeOfDay
unpackTimeOfDay PackedTime
x

unpackUTCTime :: PackedTime -> UTCTime
unpackUTCTime :: PackedTime -> UTCTime
unpackUTCTime = ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime)
-> (PackedTime -> ZonedTime) -> PackedTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedTime -> ZonedTime
unpackZonedTime

unpackZonedTime :: PackedTime -> ZonedTime
unpackZonedTime :: PackedTime -> ZonedTime
unpackZonedTime !PackedTime
x = LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
t TimeZone
z
  where
    z :: TimeZone
z = Int -> TimeZone
minutesToTimeZone ((PackedTime -> Int -> Int -> Int
forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
0 Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)
    t :: LocalTime
t = PackedTime -> LocalTime
unpackLocalTime PackedTime
x