module HSBencher.Backend.Dribble
( defaultDribblePlugin,
DribblePlugin(), DribbleConf(..)
)
where
import HSBencher.Types
import HSBencher.Internal.Logging (log, chatter)
import Control.Concurrent.MVar
import Control.Monad.Reader
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Typeable
import Data.Default (Default(def))
import System.IO.Unsafe (unsafePerformIO)
import System.Directory
import System.FilePath ((</>),(<.>), splitExtension)
import Prelude hiding (log)
data DribblePlugin = DribblePlugin deriving (Read,Show,Eq,Ord)
defaultDribblePlugin :: DribblePlugin
defaultDribblePlugin = DribblePlugin
data DribbleConf = DribbleConf { csvfile :: Maybe String }
deriving (Read,Show,Eq,Ord, Typeable)
instance Default DribblePlugin where
def = defaultDribblePlugin
instance Default DribbleConf where
def = DribbleConf { csvfile = Nothing }
instance Plugin DribblePlugin where
type PlugConf DribblePlugin = DribbleConf
type PlugFlag DribblePlugin = ()
plugName _ = "dribble"
plugCmdOpts _ = ("Dribble plugin loaded.\n"++
" No additional flags, but uses --name for the base filename.\n"
,[])
plugUploadRow p cfg row = runReaderT (uploadBenchResult row) cfg
plugInitialize p gconf = do
putStrLn " [dribble] Dribble-to-file plugin initializing..."
let DribbleConf{csvfile} = getMyConf DribblePlugin gconf
case csvfile of
Just x -> do putStrLn$ " [dribble] Using dribble file specified in configuration: "++show x
return gconf
Nothing -> do
cabalD <- getAppUserDataDirectory "cabal"
chk1 <- doesDirectoryExist cabalD
unless chk1 $ error $ " [dribble] Plugin cannot initialize, cabal data directory does not exist: "++cabalD
let dribbleD = cabalD </> "hsbencher"
createDirectoryIfMissing False dribbleD
base <- case benchsetName gconf of
Nothing -> do putStrLn " [dribble] no --name set, chosing default.csv for dribble file.."
return "dribble"
Just x -> return x
let path = dribbleD </> base <.> "csv"
putStrLn $ " [dribble] Defaulting to dribble location "++show path++", done initializing."
return $! setMyConf p (DribbleConf{csvfile=Just path}) gconf
foldFlags p flgs cnf0 = cnf0
fileLock :: MVar ()
fileLock = unsafePerformIO (newMVar ())
uploadBenchResult :: BenchmarkResult -> BenchM ()
uploadBenchResult br@BenchmarkResult{..} = do
let tuple = resultToTuple br
(cols,vals) = unzip tuple
conf <- ask
let DribbleConf{csvfile} = getMyConf DribblePlugin conf
case csvfile of
Nothing -> error "[dribble] internal plugin error, csvfile config should have been set during initialization."
Just path -> do
log$ " [dribble] Adding a row of data to: "++path
lift $ withMVar fileLock $ \ () -> do
b <- doesFileExist path
unless b$ writeFile path (concat (L.intersperse "," cols)++"\n")
appendFile path (concat (L.intersperse "," (map show vals))++"\n")
return ()