{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE MultiParamTypeClasses #-}

{-# LANGUAGE TypeFamilies #-}

{- |

Module : Persistence.Diagnosis.hs

Copyright : (c) Uni Magdeburg 2017

License : GPLv2 or higher, see LICENSE.txt

Maintainer : Eugen Kuksa <kuksa@iks.cs.ovgu.de>

Stability : provisional

Portability : portable

-}

module Persistence.Diagnosis (saveDiagnoses) where

import Persistence.Database

import Persistence.DBConfig

import Persistence.FileVersion

import qualified Persistence.Schema.Enums as Enums

import qualified Persistence.Schema.EvaluationStateType as EvaluationStateType

import Persistence.Range

import Persistence.Schema as SchemaClass

import qualified Common.Result as Result

import Control.Monad.IO.Class (MonadIO (..))

import qualified Data.Text as Text

import Database.Persist

saveDiagnoses :: DBConfig -> DBContext -> Int -> [Result.Diagnosis] -> IO ()

saveDiagnoses dbConfig dbContext verbosity diagnoses =

onDatabase dbConfig $ do

(Entity fileVersionKey _) <- getFileVersion dbContext

mapM_ (saveDiagnosis fileVersionKey) $

Result.filterDiags verbosity diagnoses

let errors = filter ((Result.Error ==) . Result.diagKind) diagnoses

let state = if null errors

then EvaluationStateType.FinishedSuccessfully

else EvaluationStateType.FinishedUnsuccessfully

setFileVersionStateOn fileVersionKey state

saveDiagnosis :: MonadIO m

=> FileVersionId -> Result.Diagnosis -> DBMonad m ()

saveDiagnosis fileVersionKey diagnosis =

let kind = case Result.diagKind diagnosis of

Result.Error -> Enums.Error

Result.Warning -> Enums.Warn

Result.Hint -> Enums.Hint

_ -> Enums.Debug

text = Result.diagString diagnosis

range = Result.diagPos diagnosis

in do

rangeKeyM <- createRange range

insert SchemaClass.Diagnosis

{ diagnosisFileVersionId = fileVersionKey

, diagnosisKind = kind

, diagnosisText = Text.pack text

, diagnosisFileRangeId = rangeKeyM

}

return ()