{-# 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 -> Int -> [Diagnosis] -> IO ()
saveDiagnoses dbConfig :: DBConfig
dbConfig dbContext :: DBContext
dbContext verbosity :: Int
verbosity diagnoses :: [Diagnosis]
diagnoses =
  DBConfig -> DBMonad (NoLoggingT IO) () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadUnliftIO m, MonadFail m) =>
DBConfig -> DBMonad (NoLoggingT m) a -> m a
onDatabase DBConfig
dbConfig (DBMonad (NoLoggingT IO) () -> IO ())
-> DBMonad (NoLoggingT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (Entity fileVersionKey :: Key FileVersion
fileVersionKey _) <- DBContext -> DBMonad (NoLoggingT IO) (Entity FileVersion)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
DBContext -> DBMonad m (Entity FileVersion)
getFileVersion DBContext
dbContext
    (Diagnosis -> DBMonad (NoLoggingT IO) ())
-> [Diagnosis] -> DBMonad (NoLoggingT IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key FileVersion -> Diagnosis -> DBMonad (NoLoggingT IO) ()
forall (m :: * -> *).
MonadIO m =>
Key FileVersion -> Diagnosis -> DBMonad m ()
saveDiagnosis Key FileVersion
fileVersionKey) ([Diagnosis] -> DBMonad (NoLoggingT IO) ())
-> [Diagnosis] -> DBMonad (NoLoggingT IO) ()
forall a b. (a -> b) -> a -> b
$
      Int -> [Diagnosis] -> [Diagnosis]
Result.filterDiags Int
verbosity [Diagnosis]
diagnoses
    let errors :: [Diagnosis]
errors = (Diagnosis -> Bool) -> [Diagnosis] -> [Diagnosis]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DiagKind
Result.Error DiagKind -> DiagKind -> Bool
forall a. Eq a => a -> a -> Bool
==) (DiagKind -> Bool) -> (Diagnosis -> DiagKind) -> Diagnosis -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diagnosis -> DiagKind
Result.diagKind) [Diagnosis]
diagnoses
    let state :: EvaluationStateType
state = if [Diagnosis] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnosis]
errors
                then EvaluationStateType
EvaluationStateType.FinishedSuccessfully
                else EvaluationStateType
EvaluationStateType.FinishedUnsuccessfully
    Key FileVersion
-> EvaluationStateType -> DBMonad (NoLoggingT IO) ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Key FileVersion -> EvaluationStateType -> DBMonad m ()
setFileVersionStateOn Key FileVersion
fileVersionKey EvaluationStateType
state

saveDiagnosis :: MonadIO m
              => FileVersionId -> Result.Diagnosis -> DBMonad m ()
saveDiagnosis :: Key FileVersion -> Diagnosis -> DBMonad m ()
saveDiagnosis fileVersionKey :: Key FileVersion
fileVersionKey diagnosis :: Diagnosis
diagnosis =
    let kind :: DiagnosisKindType
kind = case Diagnosis -> DiagKind
Result.diagKind Diagnosis
diagnosis of
          Result.Error -> DiagnosisKindType
Enums.Error
          Result.Warning -> DiagnosisKindType
Enums.Warn
          Result.Hint -> DiagnosisKindType
Enums.Hint
          _ -> DiagnosisKindType
Enums.Debug
        text :: String
text = Diagnosis -> String
Result.diagString Diagnosis
diagnosis
        range :: Range
range = Diagnosis -> Range
Result.diagPos Diagnosis
diagnosis
    in do
         Maybe FileRangeId
rangeKeyM <- Range -> DBMonad m (Maybe FileRangeId)
forall (m :: * -> *).
MonadIO m =>
Range -> DBMonad m (Maybe FileRangeId)
createRange Range
range
         Diagnosis -> ReaderT SqlBackend m (Key Diagnosis)
forall backend (m :: * -> *) record.
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert $WDiagnosis :: Key FileVersion
-> Maybe FileRangeId -> DiagnosisKindType -> Text -> Diagnosis
SchemaClass.Diagnosis
           { diagnosisFileVersionId :: Key FileVersion
diagnosisFileVersionId = Key FileVersion
fileVersionKey
           , diagnosisKind :: DiagnosisKindType
diagnosisKind = DiagnosisKindType
kind
           , diagnosisText :: Text
diagnosisText = String -> Text
Text.pack String
text
           , diagnosisFileRangeId :: Maybe FileRangeId
diagnosisFileRangeId = Maybe FileRangeId
rangeKeyM
           }
         () -> DBMonad m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()