Result.hs

{-# LANGUAGE OverloadedStrings #-}

module Court.Result
  ( Results(..)
  , Result(..)
  , modifyGlobalResults
  , modifyLocalResults
  ) where

import           Control.Applicative

import           Data.Aeson hiding (Result)
import qualified Data.ByteString.Lazy.Char8 as BSL

import           System.Directory
import           System.Exit
import           System.FilePath

import           Court.Job
import           Court.Options

newtype Results = Results [Result] deriving (Show, Eq)

instance FromJSON Results where
  parseJSON (Object v) = Results <$> v .: "results"
  parseJSON _ = fail "object expected"

instance ToJSON Results where
  toJSON (Results results) = object [ "results" .= results ]

data Result = Result
  { resultExitCode :: ExitCode
  , resultOutput   :: String
  , resultPath     :: FilePath
  } deriving (Show, Eq)

instance FromJSON Result where
  parseJSON (Object v) =  Result
                      <$> (fmap read $ v .: "exit_code")
                      <*> v .: "output"
                      <*> v .: "path"
  parseJSON _ = fail "object expected"

instance ToJSON Result where
  toJSON result = object
    [ "exit_code"    .= show (resultExitCode result)
    , "output"       .= resultOutput result
    , "path"         .= resultPath result
    , "project_path" .= (snd . splitFileName .takeDirectory . resultPath $ result)
    , "succeed"      .= (resultExitCode result == ExitSuccess)
    ]

modifyGlobalResults :: Options -> (Results -> Results) -> IO ()
modifyGlobalResults opts f = do
  let path = optDirectory opts </> "results.json"
  modifyResults' path f

modifyLocalResults :: Job -> (Results -> Results) -> IO ()
modifyLocalResults job f = do
  let path = jobProjectPath job </> "results.json"
  modifyResults' path f

modifyResults' :: FilePath -> (Results -> Results) -> IO ()
modifyResults' path f = do
  check   <- doesFileExist path
  results <- if check
    then do
      contents <- BSL.readFile path
      return $ either (const (Results [])) id $ eitherDecode contents
    else
      return $  Results []
  BSL.writeFile path $! encode $ f results