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

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

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