{-# 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
  , winActivityFilter

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

  -- * Window line importance
  , ActivityFilter(..)
  , WindowLineImportance(..)
  , activityFilterStrings
  , applyActivityFilter
  , readActivityFilter

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

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

import Client.Image.PackedImage (Image', imageText)
import Client.Message (IrcSummary)
import Control.Lens (Lens', view, to, from, non, set, makeLenses, Each(..), Getter)
import Control.Monad ((<$!>))
import Data.Bits ((.|.), (.&.), shiftL, shiftR)
import Data.Text.Lazy (Text)
import Data.Time
import Data.Word (Word64)
import Data.List (elemIndex)

-- | 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 -> ActivityFilter
_winActivityFilter :: !ActivityFilter -- ^ Filters for activity
  }

data ActivityLevel = NoActivity | NormalActivity | HighActivity
  deriving (ActivityLevel -> ActivityLevel -> Bool
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
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
Ord, ReadPrec [ActivityLevel]
ReadPrec ActivityLevel
Int -> ReadS ActivityLevel
ReadS [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
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
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
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
Ord, Int -> WindowLineImportance -> ShowS
[WindowLineImportance] -> ShowS
WindowLineImportance -> String
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]
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)

data ActivityFilter
  = AFSilent
  | AFQuieter
  | AFQuiet
  | AFImpOnly
  | AFLoud
  | AFLouder
  deriving (ActivityFilter -> ActivityFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityFilter -> ActivityFilter -> Bool
$c/= :: ActivityFilter -> ActivityFilter -> Bool
== :: ActivityFilter -> ActivityFilter -> Bool
$c== :: ActivityFilter -> ActivityFilter -> Bool
Eq, Eq ActivityFilter
ActivityFilter -> ActivityFilter -> Bool
ActivityFilter -> ActivityFilter -> Ordering
ActivityFilter -> ActivityFilter -> ActivityFilter
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 :: ActivityFilter -> ActivityFilter -> ActivityFilter
$cmin :: ActivityFilter -> ActivityFilter -> ActivityFilter
max :: ActivityFilter -> ActivityFilter -> ActivityFilter
$cmax :: ActivityFilter -> ActivityFilter -> ActivityFilter
>= :: ActivityFilter -> ActivityFilter -> Bool
$c>= :: ActivityFilter -> ActivityFilter -> Bool
> :: ActivityFilter -> ActivityFilter -> Bool
$c> :: ActivityFilter -> ActivityFilter -> Bool
<= :: ActivityFilter -> ActivityFilter -> Bool
$c<= :: ActivityFilter -> ActivityFilter -> Bool
< :: ActivityFilter -> ActivityFilter -> Bool
$c< :: ActivityFilter -> ActivityFilter -> Bool
compare :: ActivityFilter -> ActivityFilter -> Ordering
$ccompare :: ActivityFilter -> ActivityFilter -> Ordering
Ord, Int -> ActivityFilter
ActivityFilter -> Int
ActivityFilter -> [ActivityFilter]
ActivityFilter -> ActivityFilter
ActivityFilter -> ActivityFilter -> [ActivityFilter]
ActivityFilter
-> ActivityFilter -> ActivityFilter -> [ActivityFilter]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ActivityFilter
-> ActivityFilter -> ActivityFilter -> [ActivityFilter]
$cenumFromThenTo :: ActivityFilter
-> ActivityFilter -> ActivityFilter -> [ActivityFilter]
enumFromTo :: ActivityFilter -> ActivityFilter -> [ActivityFilter]
$cenumFromTo :: ActivityFilter -> ActivityFilter -> [ActivityFilter]
enumFromThen :: ActivityFilter -> ActivityFilter -> [ActivityFilter]
$cenumFromThen :: ActivityFilter -> ActivityFilter -> [ActivityFilter]
enumFrom :: ActivityFilter -> [ActivityFilter]
$cenumFrom :: ActivityFilter -> [ActivityFilter]
fromEnum :: ActivityFilter -> Int
$cfromEnum :: ActivityFilter -> Int
toEnum :: Int -> ActivityFilter
$ctoEnum :: Int -> ActivityFilter
pred :: ActivityFilter -> ActivityFilter
$cpred :: ActivityFilter -> ActivityFilter
succ :: ActivityFilter -> ActivityFilter
$csucc :: ActivityFilter -> ActivityFilter
Enum)

activityFilterStrings :: [String]
activityFilterStrings :: [String]
activityFilterStrings = [String
"silent", String
"quieter", String
"quiet", String
"imponly", String
"loud", String
"louder"]

applyActivityFilter :: ActivityFilter -> WindowLineImportance -> WindowLineImportance
applyActivityFilter :: ActivityFilter -> WindowLineImportance -> WindowLineImportance
applyActivityFilter ActivityFilter
AFSilent  WindowLineImportance
_           = WindowLineImportance
WLBoring
applyActivityFilter ActivityFilter
AFQuieter WindowLineImportance
WLNormal    = WindowLineImportance
WLBoring
applyActivityFilter ActivityFilter
AFQuieter WindowLineImportance
WLImportant = WindowLineImportance
WLNormal
applyActivityFilter ActivityFilter
AFImpOnly WindowLineImportance
WLNormal    = WindowLineImportance
WLBoring
applyActivityFilter ActivityFilter
AFQuiet   WindowLineImportance
WLImportant = WindowLineImportance
WLNormal
applyActivityFilter ActivityFilter
AFLouder  WindowLineImportance
WLNormal    = WindowLineImportance
WLImportant
applyActivityFilter ActivityFilter
_ WindowLineImportance
etc = WindowLineImportance
etc

instance Show ActivityFilter where
  show :: ActivityFilter -> String
show ActivityFilter
af = [String]
activityFilterStrings forall a. [a] -> Int -> a
!! forall a. Enum a => a -> Int
fromEnum ActivityFilter
af

readActivityFilter :: String -> Maybe ActivityFilter
readActivityFilter :: String -> Maybe ActivityFilter
readActivityFilter String
s = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
s [String]
activityFilterStrings

makeLenses ''Window
makeLenses ''WindowLine

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

wlText :: Getter WindowLine Text
wlText :: Getter WindowLine Text
wlText = Lens' WindowLine Image'
wlFullImage forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  { _winName' :: Char
_winName'    = Char
'\0'
  , _winMessages :: WindowLines
_winMessages = WindowLines
Nil
  , _winMarker :: Maybe Int
_winMarker   = 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
  , _winActivityFilter :: ActivityFilter
_winActivityFilter   = ActivityFilter
AFLoud
  }

windowClear :: Window -> Window
windowClear :: Window -> Window
windowClear Window
w = Window
w
  { _winMessages :: WindowLines
_winMessages = WindowLines
Nil
  , _winMarker :: Maybe Int
_winMarker = 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.
-- Additionally returns True if this window becomes important as a result of this line.
addToWindow :: WindowLine -> Window -> (Window, Bool)
addToWindow :: WindowLine -> Window -> (Window, Bool)
addToWindow !WindowLine
msg !Window
win = (Window
win', Bool
nowImportant)
    where
      win' :: Window
win' = Window
win
        { _winMessages :: WindowLines
_winMessages = WindowLine
msg WindowLine -> WindowLines -> WindowLines
:- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLines
winMessages Window
win
        , _winTotal :: Int
_winTotal    = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winTotal Window
win forall a. Num a => a -> a -> a
+ Int
1
        , _winMarker :: Maybe Int
_winMarker   = (forall a. Num a => a -> a -> a
+Int
1) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Int)
winMarker Window
win
        , _winUnread :: Int
_winUnread   = if WindowLineImportance
msgImportance forall a. Eq a => a -> a -> Bool
== WindowLineImportance
WLBoring
                         then forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winUnread Window
win
                         else forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winUnread Window
win forall a. Num a => a -> a -> a
+ Int
1
        , _winMention :: WindowLineImportance
_winMention  = forall a. Ord a => a -> a -> a
max WindowLineImportance
oldMention WindowLineImportance
msgImportance
        , _winHideMeta :: Bool
_winHideMeta = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Bool
winHideMeta Window
win
        }
      oldMention :: WindowLineImportance
oldMention = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention Window
win
      nowImportant :: Bool
nowImportant = WindowLineImportance
oldMention forall a. Ord a => a -> a -> Bool
< WindowLineImportance
WLImportant Bool -> Bool -> Bool
&& WindowLineImportance
msgImportance forall a. Ord a => a -> a -> Bool
>= WindowLineImportance
WLImportant
      msgImportance :: WindowLineImportance
msgImportance = ActivityFilter -> WindowLineImportance -> WindowLineImportance
applyActivityFilter (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window ActivityFilter
winActivityFilter Window
win) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine WindowLineImportance
wlImportance WindowLine
msg)

-- | Update the window clearing the unread count and important flag.
windowSeen :: Window -> Window
windowSeen :: Window -> Window
windowSeen = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window Int
winUnread Int
0
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set 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
  | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winUnread Window
win forall a. Eq a => a -> a -> Bool
== Int
0 = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window (Maybe Int)
winMarker 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 = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window (Maybe Int)
winMarker (forall a. a -> Maybe a
Just Int
0)


instance Each WindowLines WindowLines WindowLine WindowLine where
  each :: Traversal WindowLines WindowLines WindowLine WindowLine
each WindowLine -> f WindowLine
_ WindowLines
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure WindowLines
Nil
  each WindowLine -> f WindowLine
f (WindowLine
x :- WindowLines
xs) = WindowLine -> WindowLines -> WindowLines
(:-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowLine -> f WindowLine
f WindowLine
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall a. Num a => PackedTime -> Int -> Int -> a
field (PackedTime Word64
x) Int
off Int
sz = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
off) forall a. Bits a => a -> a -> a
.&. (Word64
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
szforall a. Num a => a -> a -> a
-Word64
1))
{-# INLINE field #-}

packField :: Int -> Int -> Word64
packField :: Int -> Int -> Word64
packField Int
off Int
val = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val 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
  forall a b. (a -> b) -> a -> b
$ Int -> Int -> Word64
packField Int
17 Int
h forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField Int
11 Int
m forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField  Int
5 (forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
s) forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField Int
22 (forall a. Num a => Integer -> a
fromInteger Integer
d) forall a. Bits a => a -> a -> a
.|.
    Int -> Int -> Word64
packField  Int
0 (TimeZone -> Int
timeZoneMinutes TimeZone
z forall a. Integral a => a -> a -> a
`div` Int
60 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 = forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
17 Int
5
    m :: Int
m = forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
11 Int
6
    s :: Pico
s = 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 (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 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 ((forall a. Num a => PackedTime -> Int -> Int -> a
field PackedTime
x Int
0 Int
5 forall a. Num a => a -> a -> a
- Int
12) forall a. Num a => a -> a -> a
* Int
60)
    t :: LocalTime
t = PackedTime -> LocalTime
unpackLocalTime PackedTime
x