content: {-# 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 ()
  