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