abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa{-# LANGUAGE ExistentialQuantification #-}
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa{-# LANGUAGE FlexibleInstances #-}
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa{-# LANGUAGE GADTs #-}
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa{-# LANGUAGE MultiParamTypeClasses #-}
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa{-# LANGUAGE OverloadedStrings #-}
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa{-# LANGUAGE TypeFamilies #-}
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa{-# LANGUAGE UndecidableInstances #-}
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksamodule Persistence.LogicGraph ( migrateLogicGraphKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , exportLogicGraph
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , findOrCreateLogic
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , findOrCreateLanguageMappingAndLogicMapping
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findReasoner
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findOrCreateProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findOrCreateConsistencyChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findLogicMappingByComorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findOrCreateLogicTranslation
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findReasonerByProverOrConsChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findReasonerByGConsChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , findReasonerByGProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksaimport Persistence.Schema as DatabaseSchema
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksaimport qualified Persistence.Schema.Enums as Enums
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksaimport qualified Comorphisms.LogicGraph as LogicGraph (logicGraph)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksaimport Common.Utils (splitByList)
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksaimport Logic.Logic as Logic
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksaimport Logic.Comorphism as Comorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksaimport Proofs.AbstractState (ProverOrConsChecker (..), G_prover (..), G_cons_checker (..), getProverName, getCcName)
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksaimport Control.Monad (unless)
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksaimport Control.Monad.IO.Class (MonadIO (..))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksaimport Data.List (isPrefixOf)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksaimport Database.Persist hiding ((==.))
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraphKey :: String
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraphKey = "migrateLogicGraph"
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLogicGraph :: HetcatsOpts -> IO ()
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLogicGraph opts =
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa onDatabase (databaseConfig opts) $
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa advisoryLocked opts migrateLogicGraphKey $ migrateLogicGraph opts
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraph :: MonadIO m => HetcatsOpts -> DBMonad m ()
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraph opts = do
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa let versionKeyName = "lastMigratedVersion"
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa lastMigratedVersionL <- select $ from $ \hets -> do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa where_ (hets ^. HetsKey ==. val versionKeyName)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa case lastMigratedVersionL of
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa insert (Hets versionKeyName hetsVersionNumeric) >> migrateLogicGraph' opts
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa Entity _ value : _ ->
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa unless (hetsValue value == hetsVersionNumeric) $ migrateLogicGraph' opts
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraph' :: MonadIO m => HetcatsOpts -> DBMonad m ()
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksamigrateLogicGraph' opts = do
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa exportLanguagesAndLogics opts LogicGraph.logicGraph
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa exportLanguageMappingsAndLogicMappings opts LogicGraph.logicGraph
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa exportReasoners opts LogicGraph.logicGraph
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa-- Export all Languages and Logics. Add those that have been added since a
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa-- previous version of Hets. This does not delete Languages or Logics.
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLanguagesAndLogics :: MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => HetcatsOpts -> LogicGraph -> DBMonad m ()
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLanguagesAndLogics opts logicGraph =
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa mapM_ (\ (Logic.Logic lid) -> do
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa languageKey <- findOrCreateLanguage lid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa mapM_ (findOrCreateLogic opts languageKey lid) $ all_sublogics lid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa ) $ logics logicGraph
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguage :: ( MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , Logic.Logic lid sublogics basic_spec sentence
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa symb_items symb_map_items sign morphism symbol
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa raw_symbol proof_tree
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => lid -> DBMonad m LanguageId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguage lid = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let languageSlugS = slugOfLanguageByName $ language_name lid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa languageM <- findLanguage languageSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case languageM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> insert Language
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa { languageSlug = languageSlugS
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , languageName = show lid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , languageDescription = description lid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , languageStandardizationStatus = "TODO" -- TODO: add to class Logic
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , languageDefinedBy = "registry" -- TODO: add to class Logic (URL)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLanguage :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => String -> DBMonad m (Maybe (Entity DatabaseSchema.Language))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLanguage languageSlugS = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa languageL <- select $ from $ \languages -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (languages ^. LanguageSlug ==. val languageSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return languages
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case languageL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa [] -> return Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa entity : _ -> return $ Just entity
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLogic :: ( MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , Logic.Logic lid sublogics basic_spec sentence
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa symb_items symb_map_items sign morphism symbol
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa raw_symbol proof_tree
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => HetcatsOpts -> LanguageId -> lid -> sublogics
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -> DBMonad m LogicId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLogic opts languageKey lid sublogic = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicNameS = logicNameForDB lid sublogic
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicSlugS = slugOfLogicByName logicNameS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicM <- findLogic logicSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case logicM of
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- This is a two-staged process to save some performance:
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- Case 1: If the logic existed beforehand, then we don't lock the
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- database and return the logic ID. This is expected to happen very
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- frequently.
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- Case 2: If the logic did not exist at this point, we need to create
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- it atomically. To do this, we do a find-or-create pattern inside a
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- mutex. This is expected to happen only a few times.
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa advisoryLocked opts migrateLogicGraphKey $ do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicM' <- findLogic logicSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case logicM' of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> insert DatabaseSchema.Logic
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa { logicLanguageId = languageKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicSlug = logicSlugS
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicName = logicNameS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogic :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => String -> DBMonad m (Maybe (Entity DatabaseSchema.Logic))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogic logicSlugS = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicL <- select $ from $ \logicsSql -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (logicsSql ^. LogicSlug ==. val logicSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return logicsSql
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case logicL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa [] -> return Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa entity : _ -> return $ Just entity
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa-- Export all LanguageMappings and LogicMappings. Add those that have been added
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa-- since a previous version of Hets. This does not delete any of the old
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLanguageMappingsAndLogicMappings :: MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => HetcatsOpts
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -> LogicGraph -> DBMonad m ()
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksaexportLanguageMappingsAndLogicMappings opts logicGraph =
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa mapM_ (findOrCreateLanguageMappingAndLogicMapping opts) $
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa comorphisms logicGraph
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguageMappingAndLogicMapping :: MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => HetcatsOpts -> AnyComorphism
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -> DBMonad m ( LanguageMappingId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , LogicMappingId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguageMappingAndLogicMapping opts (Comorphism.Comorphism cid) =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let sourceLanguageSlugS = slugOfLanguageByName $ language_name $ sourceLogic cid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa targetLanguageSlugS = slugOfLanguageByName $ language_name $ targetLogic cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -- Find the IDs in the databases:
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa Entity sourceLanguageKey _ : _ <- select $ from $ \languages -> do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa where_ (languages ^. LanguageSlug ==. val sourceLanguageSlugS)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa return languages
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa Entity targetLanguageKey _ : _ <- select $ from $ \languages -> do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa where_ (languages ^. LanguageSlug ==. val targetLanguageSlugS)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa return languages
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa sourceLogicKey <-
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa findOrCreateLogic opts sourceLanguageKey (sourceLogic cid) $ sourceSublogic cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa targetLogicKey <-
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa findOrCreateLogic opts targetLanguageKey (targetLogic cid) $ targetSublogic cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa languageMappingKey <-
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa findOrCreateLanguageMapping sourceLanguageKey targetLanguageKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa logicMappingKey <-
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa findOrCreateLogicMapping sourceLogicKey targetLogicKey languageMappingKey $ Comorphism.Comorphism cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa return (languageMappingKey, logicMappingKey)
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguageMapping :: MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => LanguageId -> LanguageId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -> DBMonad m LanguageMappingId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLanguageMapping sourceLanguageKey targetLanguageKey = do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa languageMappingL <- select $ from $ \language_mappings -> do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa where_ (language_mappings ^. LanguageMappingSourceId ==. val sourceLanguageKey
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa &&. language_mappings ^. LanguageMappingTargetId ==. val targetLanguageKey)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa return language_mappings
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa case languageMappingL of
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa [] -> insert LanguageMapping
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa { languageMappingSourceId = sourceLanguageKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , languageMappingTargetId = targetLanguageKey
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa Entity key _ : _ -> return key
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLogicMapping :: MonadIO m
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa => LogicId -> LogicId -> LanguageMappingId -> AnyComorphism
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa -> DBMonad m LogicMappingId
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen KuksafindOrCreateLogicMapping sourceLogicKey targetLogicKey languageMappingKey (Comorphism.Comorphism cid) = do
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa let name = language_name cid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicMappingSlugS = slugOfLogicMapping (Comorphism.Comorphism cid)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa logicMappingL <- select $ from $ \logic_mappings -> do
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa where_ (logic_mappings ^. LogicMappingLanguageMappingId ==. val languageMappingKey
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa &&. logic_mappings ^. LogicMappingSlug ==. val logicMappingSlugS)
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa return logic_mappings
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa case logicMappingL of
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa [] -> insert LogicMapping
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa { logicMappingLanguageMappingId = languageMappingKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingSourceId = sourceLogicKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingTargetId = targetLogicKey
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingSlug = logicMappingSlugS
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingName = name
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingIsInclusion = isInclusionComorphism cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingHasModelExpansion = has_model_expansion cid
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa , logicMappingIsWeaklyAmalgamable = is_weakly_amalgamable cid
9d63e3d6c1c65ab10d1459b9f59a134161acc1d7Eugen Kuksa Entity key _ : _ -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogicMappingByComorphism :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => AnyComorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Maybe (Entity LogicMapping))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogicMappingByComorphism comorphism =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa if isIdComorphism comorphism then return Nothing else do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicMappingSlugS = slugOfLogicMapping comorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa findLogicMappingBySlug logicMappingSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogicMappingBySlug :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Maybe (Entity LogicMapping))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindLogicMappingBySlug logicMappingSlugS = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicMappingL <- select $ from $ \ logic_mappings -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (logic_mappings ^. LogicMappingSlug ==. val logicMappingSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return logic_mappings
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case logicMappingL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa [] -> fail ("Persistence.LogicGraph.findLogicMappingBySlug: Could not find LogicMapping " ++ logicMappingSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicMappingEntity : _ -> return $ Just logicMappingEntity
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksaexportReasoners :: MonadIO m => HetcatsOpts -> LogicGraph -> DBMonad m ()
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksaexportReasoners _ logicGraph =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa mapM_ (\ (Logic.Logic lid) -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let proversL = provers lid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let consistencyCheckersL = cons_checkers lid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa mapM_ (findOrCreateProver . G_prover lid) proversL
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa mapM_ (findOrCreateConsistencyChecker . G_cons_checker lid) consistencyCheckersL
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ) $ logics logicGraph
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateProver :: MonadIO m => G_prover -> DBMonad m ReasonerId
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateProver gProver = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let reasonerSlugS = slugOfProver gProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let name = getProverName gProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa findOrCreateReasoner reasonerSlugS name Enums.Prover
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateConsistencyChecker :: MonadIO m => G_cons_checker -> DBMonad m ReasonerId
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateConsistencyChecker gConsistencyChecker = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let reasonerSlugS = slugOfConsistencyChecker gConsistencyChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let name = getCcName gConsistencyChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa findOrCreateReasoner reasonerSlugS name Enums.ConsistencyChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasoner :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Maybe (Entity Reasoner))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasoner reasonerSlugS reasonerKindValue = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa reasonerL <-
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa select $ from $ \ reasoners -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (reasoners ^. ReasonerSlug ==. val reasonerSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa &&. reasoners ^. ReasonerKind ==. val reasonerKindValue)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return reasoners
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case reasonerL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa reasoner : _ -> return $ Just reasoner
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa [] -> return Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateReasoner :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => String -> String -> Enums.ReasonerKindType
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m ReasonerId
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateReasoner reasonerSlugS name reasonerKindValue = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa reasonerM <- findReasoner reasonerSlugS reasonerKindValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case reasonerM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity reasonerKey _) -> return reasonerKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> insert Reasoner
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa { reasonerSlug = reasonerSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , reasonerDisplayName = name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , reasonerKind = reasonerKindValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByGConsChecker :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => G_cons_checker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Entity Reasoner)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByGConsChecker gConsChecker = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let reasonerSlugS = slugOfConsistencyChecker gConsChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa reasonerM <- findReasoner reasonerSlugS Enums.ConsistencyChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case reasonerM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> fail ("Persistence.LogicGraph.findReasonerByGConsChecker: Could not find Consistency Checker " ++ reasonerSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just reasonerEntity -> return reasonerEntity
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByGProver :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Entity Reasoner)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByGProver gProver = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let reasonerSlugS = slugOfProver gProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa reasonerM <- findReasoner reasonerSlugS Enums.Prover
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case reasonerM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> fail ("Persistence.LogicGraph.findReasonerByGProver: Could not find Prover " ++ reasonerSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just reasonerEntity -> return reasonerEntity
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByProverOrConsChecker :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => ProverOrConsChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Entity Reasoner)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindReasonerByProverOrConsChecker reasoner = case reasoner of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Prover gProver -> findReasonerByGProver gProver
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ConsChecker gConsChecker -> findReasonerByGConsChecker gConsChecker
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateLogicTranslation :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => HetcatsOpts
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> AnyComorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Maybe (Entity LogicTranslation))
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateLogicTranslation _ comorphism@(Comorphism.Comorphism cid) =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa if isIdComorphism comorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa then return Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicTranslationSlugS = slugOfTranslation comorphism
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicTranslationNameS = language_name cid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa translationL <- select $ from $ \ translations -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (translations ^. LogicTranslationSlug ==. val logicTranslationSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return translations
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case translationL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa translationEntity : _ -> return $ Just translationEntity
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicTranslationValue = LogicTranslation
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa { logicTranslationSlug = logicTranslationSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationName = logicTranslationNameS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicTranslationKey <- insert logicTranslationValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa mapM_ (\ (number, name) ->
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa createLogicTranslationStep logicTranslationKey (number, name)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ) $ zip [1..] $ constituents cid
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return $ Just $ Entity logicTranslationKey logicTranslationValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksacreateLogicTranslationStep :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa => LogicTranslationId
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> (Int, String)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Entity LogicTranslationStep)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksacreateLogicTranslationStep logicTranslationKey (number, name)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa | isInclusion_ name = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Entity logicInclusionKey _ <- findOrCreateLogicInclusion name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let translationStepValue = LogicTranslationStep
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa { logicTranslationStepLogicTranslationId = logicTranslationKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepNumber = number
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepLogicMappingId = Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepLogicInclusionId = Just logicInclusionKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa translationStepKey <- insert translationStepValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return $ Entity translationStepKey translationStepValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa | otherwise = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity logicMappingKey _) <-
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa findLogicMappingBySlug $ slugOfLogicMappingByName name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let translationStepValue = LogicTranslationStep
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa { logicTranslationStepLogicTranslationId = logicTranslationKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepNumber = number
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepLogicMappingId = Just logicMappingKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicTranslationStepLogicInclusionId = Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa translationStepKey <- insert translationStepValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return $ Entity translationStepKey translationStepValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa isInclusion_ :: String -> Bool
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa isInclusion_ name_ = "id_" `isPrefixOf` name_ || "incl_" `isPrefixOf` name_
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateLogicInclusion :: MonadIO m
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa -> DBMonad m (Entity LogicInclusion)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen KuksafindOrCreateLogicInclusion name = do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicInclusionSlugS = slugOfLogicInclusionByName name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicInclusionL <- select $ from $ \ logic_inclusions -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa where_ (logic_inclusions ^. LogicInclusionSlug ==. val logicInclusionSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return logic_inclusions
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case logicInclusionL of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicInclusionEntity : _ -> return logicInclusionEntity
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let (languageSlugS, sourceSlugS, targetSlugM) = slugsFromName
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa languageM <- findLanguage languageSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa languageKey <- case languageM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> fail ("Persistence.LogicGraph.findOrCreateLogicInclusion: "
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ++ "Could not find the language " ++ languageSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa sourceM <- findLogic sourceSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa sourceKey <- case sourceM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> fail ("Persistence.LogicGraph.findOrCreateLogicInclusion: "
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ++ "Could not find the source logic " ++ sourceSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa targetKeyM <- case targetSlugM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> return Nothing
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just targetSlugS -> do
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa targetM <- findLogic targetSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa case targetM of
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Nothing -> fail ("Persistence.LogicGraph.findOrCreateLogicInclusion: "
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ++ "Could not find the target logic " ++ targetSlugS)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa Just (Entity key _) -> return $ Just key
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let logicInclusionValue = LogicInclusion
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa { logicInclusionName = name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicInclusionSlug = logicInclusionSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicInclusionLanguageId = languageKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicInclusionSourceId = sourceKey
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicInclusionTargetId = targetKeyM
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicInclusionKey <- insert logicInclusionValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa return $ Entity logicInclusionKey logicInclusionValue
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa slugsFromName :: (String, String, Maybe String)
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa slugsFromName
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa | "id_" `isPrefixOf` name =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let languageName_ = takeWhile (/= '.') $ drop 3 name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicName_ = tail $ dropWhile (/= '.') name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicSlugS =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa slugOfLogicByName $ logicNameForDBByName languageName_ logicName_
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa in ( slugOfLanguageByName languageName_
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , logicSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa | "incl_" `isPrefixOf` name =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa let languageName_ = takeWhile (/= ':') $ drop 5 name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa logicNames = tail $ dropWhile (/= ':') name
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa [sourceName, targetName] = splitByList "->" logicNames
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa sourceSlugS =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa slugOfLogicByName $ logicNameForDBByName languageName_ sourceName
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa targetSlugS =
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa slugOfLogicByName $ logicNameForDBByName languageName_ targetName
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa in ( slugOfLanguageByName languageName_
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , sourceSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa , Just targetSlugS
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa | otherwise = error ("Persistence.LogicGraph.findOrCreateLogicInclusion.slugsFromName "
abdc8c3bcf5b761e9bebf51e6ba2bce659d29512Eugen Kuksa ++ "encountered a bad comorphism name: " ++ name)