Persistence/DevGraph/Cleaning.hs

{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

{- |
Module      :  ./Persistence.DevGraph.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.DevGraph.Cleaning (clean) where

import Persistence.Database
import Persistence.Schema

import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (..))
import Database.Persist
import Database.Persist.Sql
import GHC.Int

clean :: MonadIO m => Entity LocIdBase -> DBMonad m ()
clean (Entity documentKey documentValue) = do
  deleteDocument documentKey
  deleteDiagnoses $ locIdBaseFileVersionId documentValue

deleteDiagnoses :: MonadIO m => FileVersionId -> DBMonad m ()
deleteDiagnoses key = deleteCascadeWhere [DiagnosisFileVersionId ==. key]

deleteDocument :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteDocument key = do
  deleteDocumentLinks key
  deleteOms key
  deleteWhere [DocumentId ==. toSqlKey (fromSqlKey key)]
  deleteWhere [LocIdBaseId ==. key]

deleteDocumentLinks :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteDocumentLinks documentKey =
  deleteWhere (   [DocumentLinkSourceId ==. documentKey]
              ||. [DocumentLinkTargetId ==. documentKey]
              )

deleteOms :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteOms documentKey = do
  omsL <- selectList [OMSDocumentId ==. documentKey] []
  mapM_ (\ (Entity omsKey omsValue) -> do
          maybe (return ()) deleteOms $ oMSNormalFormId omsValue
          maybe (return ()) deleteOms $ oMSFreeNormalFormId omsValue
          deleteMappings $ toSqlKey $ fromSqlKey omsKey
          deleteSentences $ toSqlKey $ fromSqlKey omsKey
          deleteSymbols $ toSqlKey $ fromSqlKey omsKey
          deleteConsistencyCheckAttempts $ toSqlKey $ fromSqlKey omsKey
          deleteWhere [LocIdBaseId ==. toSqlKey (fromSqlKey omsKey)]
          delete omsKey
          deleteSignature $ oMSSignatureId omsValue
        ) omsL

deleteMappings :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteMappings omsKey = do
  mappings <- selectList (   [MappingSourceId ==. omsKey]
                         ||. [MappingTargetId ==. omsKey]
                         ||. [MappingFreenessParameterOMSId ==. Just omsKey]
                         ) []
  mapM_ (\ (Entity mappingKey _) -> do
          deleteWhere [LocIdBaseId ==. toSqlKey (fromSqlKey mappingKey)]
          delete mappingKey
        ) mappings

deleteSentences :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteSentences omsKey = do
  sentences <- selectList [SentenceOmsId ==. omsKey] []
  mapM_ (\ (Entity sentenceKey _) -> do
          deleteSentencesSymbols $ toSqlKey $ fromSqlKey sentenceKey
          deletePremiseSelectedSentences $ toSqlKey $ fromSqlKey sentenceKey
          deleteAxiom $ toSqlKey $ fromSqlKey sentenceKey
          deleteConjecture $ toSqlKey $ fromSqlKey sentenceKey
          deleteWhere [LocIdBaseId ==. toSqlKey (fromSqlKey sentenceKey)]
        ) sentences
  deleteWhere [SentenceOmsId ==. omsKey]

deleteSentencesSymbols :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteSentencesSymbols sentenceKey =
  deleteWhere [SentenceSymbolSentenceId ==. sentenceKey]

deletePremiseSelectedSentences :: MonadIO m => LocIdBaseId -> DBMonad m ()
deletePremiseSelectedSentences sentenceKey =
  deleteWhere [PremiseSelectedSentencePremiseId ==. sentenceKey]

deleteAxiom :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteAxiom = delete

deleteConjecture :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteConjecture conjectureKey = do
  deleteProofAttempts conjectureKey
  delete conjectureKey

deleteProofAttempts :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteProofAttempts conjectureKey = do
  proofAttempts <- selectList [ProofAttemptConjectureId ==. Just conjectureKey] []
  mapM_ (\ (Entity proofAttemptKey _) ->
          deleteReasoningAttempt $ fromSqlKey proofAttemptKey
        ) proofAttempts
  deleteWhere [ProofAttemptConjectureId ==. Just conjectureKey]

deleteReasoningAttempt :: MonadIO m => GHC.Int.Int64 -> DBMonad m ()
deleteReasoningAttempt keyInt = do
  let reasoningAttemptKey = toSqlKey keyInt
  reasoningAttemptValueM <- get reasoningAttemptKey
  deleteGeneratedAxioms reasoningAttemptKey
  deleteReasonerOutputs reasoningAttemptKey
  delete reasoningAttemptKey
  case reasoningAttemptValueM of
    Just reasoningAttemptValue -> deleteReasoningConfiguration $ reasoningAttemptReasonerConfigurationId reasoningAttemptValue
    Nothing -> return ()

deleteGeneratedAxioms :: MonadIO m => ReasoningAttemptId -> DBMonad m ()
deleteGeneratedAxioms reasoningAttemptKey =
  deleteWhere [GeneratedAxiomReasoningAttemptId ==. reasoningAttemptKey]

deleteReasonerOutputs :: MonadIO m => ReasoningAttemptId -> DBMonad m ()
deleteReasonerOutputs reasoningAttemptKey =
  deleteWhere [ReasonerOutputReasoningAttemptId ==. reasoningAttemptKey]

deleteReasoningConfiguration :: MonadIO m
                             => ReasonerConfigurationId -> DBMonad m ()
deleteReasoningConfiguration reasoningConfigurationKey = do
  reasoningAttempts <- selectList [ReasoningAttemptReasonerConfigurationId ==. reasoningConfigurationKey] []
  when (null reasoningAttempts) $ do
    deletePremiseSelections reasoningConfigurationKey
    delete reasoningConfigurationKey

deletePremiseSelections :: MonadIO m => ReasonerConfigurationId -> DBMonad m ()
deletePremiseSelections reasoningConfigurationKey = do
  premiseSelections <- selectList [PremiseSelectionReasonerConfigurationId ==. reasoningConfigurationKey] []
  mapM_ (\ (Entity premiseSelectionKey _) -> do
          deleteManualPremiseSelection $ toSqlKey $ fromSqlKey premiseSelectionKey
          deleteSinePremiseSelection $ toSqlKey $ fromSqlKey premiseSelectionKey
        ) premiseSelections
  deleteWhere [PremiseSelectionReasonerConfigurationId ==. reasoningConfigurationKey]

deleteManualPremiseSelection :: MonadIO m => ManualPremiseSelectionId -> DBMonad m ()
deleteManualPremiseSelection = delete

deleteSinePremiseSelection :: MonadIO m => SinePremiseSelectionId -> DBMonad m ()
deleteSinePremiseSelection sinePremiseSelectionKey = do
  deleteSineSymbolPremiseTriggers sinePremiseSelectionKey
  deleteSineSymbolCommonnesses sinePremiseSelectionKey
  delete sinePremiseSelectionKey

deleteSineSymbolPremiseTriggers :: MonadIO m => SinePremiseSelectionId -> DBMonad m ()
deleteSineSymbolPremiseTriggers sinePremiseSelectionKey =
  deleteWhere [SineSymbolPremiseTriggerSinePremiseSelectionId ==. sinePremiseSelectionKey]

deleteSineSymbolCommonnesses :: MonadIO m => SinePremiseSelectionId -> DBMonad m ()
deleteSineSymbolCommonnesses sinePremiseSelectionKey =
  deleteWhere [SineSymbolCommonnessSinePremiseSelectionId ==. sinePremiseSelectionKey]

deleteSymbols :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteSymbols omsKey = do
  symbols <- selectList [SymbolOmsId ==. omsKey] []
  mapM_ (\ (Entity symbolKey _) -> do
          deleteSymbolMappings $ toSqlKey $ fromSqlKey symbolKey
          deleteSignatureSymbols $ toSqlKey $ fromSqlKey symbolKey
          deleteWhere [LocIdBaseId ==. toSqlKey (fromSqlKey symbolKey)]
        ) symbols
  deleteWhere [SymbolOmsId ==. omsKey]

deleteSymbolMappings :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteSymbolMappings symbolKey =
  deleteWhere (   [SymbolMappingSourceId ==. symbolKey]
              ||. [SymbolMappingTargetId ==. symbolKey]
              )

deleteSignatureSymbols :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteSignatureSymbols symbolKey =
  deleteWhere [SignatureSymbolSymbolId ==. symbolKey]

deleteConsistencyCheckAttempts :: MonadIO m => LocIdBaseId -> DBMonad m ()
deleteConsistencyCheckAttempts omsKey = do
  consistencyCheckAttempts <-
    selectList [ConsistencyCheckAttemptOmsId ==. Just omsKey] []
  mapM_ (\ (Entity consistencyCheckAttemptKey _) ->
          deleteReasoningAttempt $ fromSqlKey consistencyCheckAttemptKey
        ) consistencyCheckAttempts
  deleteWhere [ConsistencyCheckAttemptOmsId ==. Just omsKey]

deleteSignature :: MonadIO m => SignatureId -> DBMonad m ()
deleteSignature signatureKey = do
  oms <- selectList [OMSSignatureId ==. signatureKey] []
  when (null oms) $ do
    deleteSignatureMorphisms signatureKey
    delete signatureKey

deleteSignatureMorphisms :: MonadIO m => SignatureId -> DBMonad m ()
deleteSignatureMorphisms signatureKey =
  deleteWhere (   [SignatureMorphismSourceId ==. signatureKey]
              ||. [SignatureMorphismTargetId ==. signatureKey]
              )