module MagicHaskeller.GetTime where
import System.CPUTime
import Data.Time
import System.IO
import Control.Monad(liftM2)
import Control.Monad.IO.Class
batchWrite :: FilePath -> [IO a] -> IO ()
batchWrite :: FilePath -> [IO a] -> IO ()
batchWrite FilePath
filename [IO a]
ios = do [Integer]
is <- [IO a] -> IO [Integer]
forall a. [IO a] -> IO [Integer]
batchRun [IO a]
ios
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (Integer -> FilePath
showCPUTime ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
is) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" seconds in total.")
FilePath -> FilePath -> IO ()
writeFile FilePath
filename (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (Integer -> FilePath) -> [Integer] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> FilePath
showCPUTime [Integer]
is
batchRun :: [IO a] -> IO [Integer]
batchRun :: [IO a] -> IO [Integer]
batchRun [] = [Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return []
batchRun (IO a
io:[IO a]
ios) = (Integer -> [Integer] -> [Integer])
-> IO Integer -> IO [Integer] -> IO [Integer]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (((a, Integer) -> Integer) -> IO (a, Integer) -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (IO (a, Integer) -> IO Integer) -> IO (a, Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ IO a -> IO (a, Integer)
forall (m :: * -> *) a. MonadIO m => m a -> m (a, Integer)
time IO a
io) ([IO a] -> IO [Integer]
forall a. [IO a] -> IO [Integer]
batchRun [IO a]
ios)
time :: MonadIO m => m a -> m (a, Integer)
time :: m a -> m (a, Integer)
time m a
act = do
UTCTime
beginCT <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
Integer
begin <- IO Integer -> m Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
a
result <- m a
act
IO (a, Integer) -> m (a, Integer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Integer) -> m (a, Integer))
-> IO (a, Integer) -> m (a, Integer)
forall a b. (a -> b) -> a -> b
$ do
Integer
end <- IO Integer
getCPUTime
UTCTime
endCT <- IO UTCTime
getCurrentTime
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (NominalDiffTime -> FilePath
forall a. Show a => a -> FilePath
show (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endCT UTCTime
beginCT) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in real,")
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (Integer -> FilePath
showCPUTime (Integer
endInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
begin) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" seconds in CPU time spent.")
(a, Integer) -> IO (a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, Integer
endInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
begin)
showZero :: FilePath -> FilePath
showZero FilePath
"" = FilePath
"0 secs"
showZero FilePath
s = FilePath
s
showCPUTime :: Integer -> String
showCPUTime :: Integer -> FilePath
showCPUTime Integer
t = let s :: FilePath
s = Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
t
l :: Int
l = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s
(FilePath
p,FilePath
f) = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) FilePath
s
in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
12 of Ordering
GT -> FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenPrec) FilePath
f
Ordering
EQ -> FilePath
"0." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenPrec) FilePath
f
Ordering
LT -> FilePath
"0." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
12Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) Char
'0' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenPrec) FilePath
s
lenPrec :: Int
lenPrec = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
cpuTimePrecision)