{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
module Experimenter.Eval.Util where

import           Control.DeepSeq
import           Control.Lens             hiding (Cons, Over, over)
import           Control.Monad.IO.Class
import qualified Data.Text                as T
import           Data.Time.Clock          (diffUTCTime, getCurrentTime)
import           System.FilePath.Posix

import           Experimenter.Result.Type


rootPath :: FilePath
rootPath :: FilePath
rootPath = FilePath
"results"

mainFile :: Experiments a -> FilePath
mainFile :: Experiments a -> FilePath
mainFile Experiments a
exps = FilePath
"main_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getTime Experiments a
exps FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tex"

getTime :: Experiments a -> String
getTime :: Experiments a -> FilePath
getTime Experiments a
exps = FilePath -> (UTCTime -> FilePath) -> Maybe UTCTime -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"unfinished_experiment" (Text -> FilePath
T.unpack (Text -> FilePath) -> (UTCTime -> Text) -> UTCTime -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
" " Text
"_" (Text -> Text) -> (UTCTime -> Text) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (UTCTime -> FilePath) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> FilePath
forall a. Show a => a -> FilePath
show) (Experiments a
exps Experiments a
-> Getting (Maybe UTCTime) (Experiments a) (Maybe UTCTime)
-> Maybe UTCTime
forall s a. s -> Getting a s a -> a
^. Getting (Maybe UTCTime) (Experiments a) (Maybe UTCTime)
forall a. Lens' (Experiments a) (Maybe UTCTime)
experimentsEndTime)

scalarFile :: Experiments a -> FilePath
scalarFile :: Experiments a -> FilePath
scalarFile Experiments a
exps = FilePath
"scalar_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getTime Experiments a
exps FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tex"

repetitionFile :: Experiments a -> FilePath
repetitionFile :: Experiments a -> FilePath
repetitionFile Experiments a
exps = FilePath
"repetition_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getTime Experiments a
exps FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tex"

replicationFile :: Experiments a -> FilePath
replicationFile :: Experiments a -> FilePath
replicationFile Experiments a
exps = FilePath
"replication_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getTime Experiments a
exps FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tex"

periodicFile :: Experiments a -> FilePath
periodicFile :: Experiments a -> FilePath
periodicFile Experiments a
exps = FilePath
"periodic_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getTime Experiments a
exps FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tex"

mainFilePdf :: Experiments a -> FilePath
mainFilePdf :: Experiments a -> FilePath
mainFilePdf Experiments a
exps = Text -> FilePath
T.unpack ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Experiments a -> FilePath
forall a. Experiments a -> FilePath
mainFile Experiments a
exps)) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"pdf"

getExpsName :: Experiments a -> String
getExpsName :: Experiments a -> FilePath
getExpsName Experiments a
exps  = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"/" Text
"_" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
" " Text
"_" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Experiments a
exps Experiments a -> Getting Text (Experiments a) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (Experiments a) Text
forall a. Lens' (Experiments a) Text
experimentsName

expsPath :: Experiments a -> FilePath
expsPath :: Experiments a -> FilePath
expsPath Experiments a
exps = FilePath
rootPath FilePath -> FilePath -> FilePath
</> Experiments a -> FilePath
forall a. Experiments a -> FilePath
getExpsName Experiments a
exps

mkTime :: (MonadIO m, NFData t) => String -> m t -> m t
mkTime :: FilePath -> m t -> m t
mkTime FilePath
name m t
a = do
  UTCTime
start <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  !t
val <- t -> t
forall a. NFData a => a -> a
force (t -> t) -> m t -> m t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m t
a
  UTCTime
end <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let name' :: FilePath
name' | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name = FilePath
name
            | Bool
otherwise = FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
' ']
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath
name' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"Computation Time: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NominalDiffTime -> FilePath
forall a. Show a => a -> FilePath
show (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
end UTCTime
start))
  t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return t
val