-- 
-- (c) Susumu Katayama
--
module MagicHaskeller.GetTime where
import System.CPUTime
-- import System.Time -- better than Time in Haskell98 Library in that the former supports pretty printing TimeDiff.
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,")
--          hPutStrLn stderr (shows (end-begin) " plusminus " ++ shows cpuTimePrecision " picoseconds spent.")
              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)