{-# LANGUAGE CPP #-}
module GetModificationTime where
import HaskellIO
import DialogueIO

#ifdef VERSION_old_time
getModificationTime :: FilePath -> (IOError -> f b ho) -> (ClockTime -> f b ho) -> f b ho
getModificationTime FilePath
path IOError -> f b ho
err ClockTime -> f b ho
cont =
    Request -> (IOError -> f b ho) -> (Response -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (IOError -> f b ho) -> (Response -> f b ho) -> f b ho
hIOerr (FilePath -> Request
GetModificationTime FilePath
path) IOError -> f b ho
err ((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
#else
getModificationTime path err cont =
    hIOerr (GetModificationTime path) err $ \ (UTCTime t) ->
    cont t
#endif