{-# LANGUAGE CPP #-}
module GetTime where
import HaskellIO(hIO)
import DialogueIO

#ifdef VERSION_old_time
getTime :: (ClockTime -> f b ho) -> f b ho
getTime      ClockTime -> f b ho
cont = Request -> (Response -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (Response -> f b ho) -> f b ho
hIO Request
GetTime      ((Response -> f b ho) -> f b ho) -> (Response -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ (ClockTime ClockTime
t)    -> ClockTime -> f b ho
cont ClockTime
t
getLocalTime :: (CalendarTime -> f b ho) -> f b ho
getLocalTime CalendarTime -> f b ho
cont = Request -> (Response -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (Response -> f b ho) -> f b ho
hIO Request
GetLocalTime ((Response -> f b ho) -> f b ho) -> (Response -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ (CalendarTime CalendarTime
t) -> CalendarTime -> f b ho
cont CalendarTime
t
#endif

#ifdef VERSION_time
getCurrentTime :: (UTCTime -> f b ho) -> f b ho
getCurrentTime UTCTime -> f b ho
cont = Request -> (Response -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (Response -> f b ho) -> f b ho
hIO Request
GetCurrentTime ((Response -> f b ho) -> f b ho) -> (Response -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ (UTCTime UTCTime
t)   -> UTCTime -> f b ho
cont UTCTime
t
getZonedTime :: (ZonedTime -> f b ho) -> f b ho
getZonedTime   ZonedTime -> f b ho
cont = Request -> (Response -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (Response -> f b ho) -> f b ho
hIO Request
GetZonedTime   ((Response -> f b ho) -> f b ho) -> (Response -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ (ZonedTime ZonedTime
t) -> ZonedTime -> f b ho
cont ZonedTime
t
#endif