{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
--
-- Copyright (c) 2005-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--
{- |
Internal module for retaining a history of test runs.
-}
module Test.Framework.History (

    TestHistory, HistoricTestResult(..), emptyTestHistory, Milliseconds, TestResult(..)
  , serializeTestHistory, deserializeTestHistory
  , findHistoricTestResult, findHistoricSuccessfulTestResult
  , updateTestHistory, mkTestRunHistory
  , historyTests

) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.List as L
import qualified Data.Vector as V
import Data.Time.Clock
import Test.HUnit
import Data.Aeson hiding (Error)
import Data.Aeson.TH
import Test.Framework.TestInterface

-- | A type synonym for time in milliseconds.
type Milliseconds = Int

data TestHistory
    = TestHistory
      { th_runs :: !(V.Vector (TestRunHistory)) -- reverse chronologically sorted
      , th_index :: !(Map T.Text (HistoricTestResult))
      , th_successfulIndex :: !(Map T.Text (HistoricTestResult))
      }
    deriving (Eq)

instance Show (TestHistory) where
    showsPrec _ _ = showString "<TestHistory>"

emptyTestHistory :: TestHistory
emptyTestHistory =
    TestHistory V.empty Map.empty Map.empty

data TestRunHistory
    = TestRunHistory
      { trh_startTime :: !UTCTime
      , trh_tests :: !(V.Vector (HistoricTestResult))
      }
    deriving (Eq)

instance Show TestRunHistory where
    showsPrec d trh =
        showParen (d > 10) $
        showString "TestRunHistory <hidden time> " .
        showsPrec 11 (trh_tests trh)

data HistoricTestResult
    = HistoricTestResult
      { htr_testId :: !T.Text
      , htr_result :: !TestResult
      , htr_timedOut :: !Bool
      , htr_timeMs :: !Milliseconds
      }
    deriving (Show, Eq)

mkTestRunHistory :: UTCTime -> [HistoricTestResult] -> TestRunHistory
mkTestRunHistory time results = TestRunHistory {
                                  trh_startTime = time
                                , trh_tests = V.fromList results
                                }

isSuccess :: HistoricTestResult -> Bool
isSuccess r = htr_result r == Pass && not (htr_timedOut r)

updateTestHistory :: TestRunHistory -> TestHistory -> TestHistory
updateTestHistory runHistory history =
    let runs = runHistory : V.toList (th_runs history)
    in TestHistory (V.fromList runs) (createIndex runs (const True)) (createIndex runs isSuccess)

-- The [TestRunHistory] list is sorted reverse chronologically
createIndex :: [TestRunHistory] -> (HistoricTestResult -> Bool) -> Map T.Text (HistoricTestResult)
createIndex list pred =
    L.foldl' updateMap Map.empty flatRunHistory
    where
      updateMap m res =
          Map.insertWith (\_new old -> old) (htr_testId res) res m
      flatRunHistory =
          filter pred $ concatMap (\trh -> V.toList (trh_tests trh)) list

findHistoricTestResult :: T.Text -> TestHistory -> Maybe (HistoricTestResult)
findHistoricTestResult id hist = Map.lookup id (th_index hist)

findHistoricSuccessfulTestResult :: T.Text -> TestHistory -> Maybe (HistoricTestResult)
findHistoricSuccessfulTestResult id hist = Map.lookup id (th_successfulIndex hist)

data SerializableTestHistory
    = SerializableTestHistory
      { sth_version :: Int
      , sth_runs :: !(V.Vector (TestRunHistory)) -- reverse chronologically sorted
      }

_CURRENT_VERSION_ :: Int
_CURRENT_VERSION_ = 0

instance ToJSON TestResult where
    toJSON r = String $
        case L.lookup r testResultStringMapping of
          Just s -> s
          Nothing -> error ("TestResult " ++ show r ++ " not defined in testResultStringMapping")

instance FromJSON TestResult where
    parseJSON v =
        case v of
          String s
              | Just r <- L.lookup s (map (\(x, y) -> (y, x)) testResultStringMapping)
                       -> return r
          _ -> fail ("could not parse JSON value as a test result: " ++ show v)

testResultStringMapping :: [(TestResult, T.Text)]
testResultStringMapping =
    [(Pass, "pass"), (Pending, "pending"), (Fail, "fail"), (Error, "error")]

deriveJSON (defaultOptions { fieldLabelModifier = drop 4 }) ''HistoricTestResult
deriveJSON (defaultOptions { fieldLabelModifier = drop 4 }) ''TestRunHistory
deriveJSON (defaultOptions { fieldLabelModifier = drop 4 }) ''SerializableTestHistory

serializeTestHistory :: TestHistory -> BS.ByteString
serializeTestHistory hist =
    let serHist = SerializableTestHistory {
                    sth_version = _CURRENT_VERSION_
                  , sth_runs = th_runs hist
                  }
    in BSL.toStrict $ encode serHist

deserializeTestHistory :: BS.ByteString -> Either String (TestHistory)
deserializeTestHistory bs =
    -- assume version 0 for now. Later we have to look into the json, find the version and then decide which parser to user
    case decodeStrict bs of
      Nothing -> Left ("could not decode JSON: " ++ show bs)
      Just !serHist ->
          let list = V.toList (sth_runs serHist)
          in Right (TestHistory (sth_runs serHist) (createIndex list (const True)) (createIndex list isSuccess))

testCreateIndex =
    do time <- getCurrentTime
       let index = createIndex (historyList time) (const True)
       if index == expectedIndex
       then return ()
       else assertFailure ("== Expected index:\n" ++ show expectedIndex ++
                           "\n== Given index:\n" ++ show index)
    where
      historyList time =
          [mkHist time [mkRes "foo" 1]
          ,mkHist time [mkRes "foo" 2, mkRes "bar" 10]
          ,mkHist time [mkRes "bar" 20, mkRes "egg" 3]]
      expectedIndex = Map.fromList [("foo", mkRes "foo" 1)
                                   ,("bar", mkRes "bar" 10)
                                   ,("egg", mkRes "egg" 3)]
      mkHist time l = TestRunHistory time (V.fromList l)
      mkRes id ms = HistoricTestResult id Pass False ms

historyTests = [("testCreateIndex", testCreateIndex)]
