module PGIP.GraphQL.Resolver.ToResult where

import PGIP.GraphQL.Result.Axiom as GraphQLResultAxiom
import PGIP.GraphQL.Result.Action as GraphQLResultAction
import PGIP.GraphQL.Result.Conjecture as GraphQLResultConjecture
import PGIP.GraphQL.Result.ConservativityStatus as GraphQLResultConservativityStatus
import PGIP.GraphQL.Result.DocumentLink as GraphQLResultDocumentLink
import PGIP.GraphQL.Result.FileRange as GraphQLResultFileRange
import PGIP.GraphQL.Result.IdReference (IdReference (..))
import PGIP.GraphQL.Result.Language as GraphQLResultLanguage
import PGIP.GraphQL.Result.LanguageMapping as GraphQLResultLanguageMapping
import PGIP.GraphQL.Result.Library as GraphQLResultLibrary
import PGIP.GraphQL.Result.LocIdReference (LocIdReference (..))
import PGIP.GraphQL.Result.Logic as GraphQLResultLogic
import PGIP.GraphQL.Result.LogicMapping as GraphQLResultLogicMapping
import PGIP.GraphQL.Result.Mapping as GraphQLResultMapping
import PGIP.GraphQL.Result.NativeDocument as GraphQLResultNativeDocument
import PGIP.GraphQL.Result.OMS as GraphQLResultOMS
import PGIP.GraphQL.Result.OMSSimple as GraphQLResultOMSSimple
import PGIP.GraphQL.Result.PremiseSelection as GraphQLResultPremiseSelection
import PGIP.GraphQL.Result.Reasoner as GraphQLResultReasoner
import PGIP.GraphQL.Result.ReasonerConfiguration as GraphQLResultReasonerConfiguration
import PGIP.GraphQL.Result.ReasonerOutput as GraphQLResultReasonerOutput
import PGIP.GraphQL.Result.ReasoningAttempt as GraphQLResultReasoningAttempt
import PGIP.GraphQL.Result.Sentence as GraphQLResultSentence
import PGIP.GraphQL.Result.Serialization as GraphQLResultSerialization
import PGIP.GraphQL.Result.Signature as GraphQLResultSignature
import PGIP.GraphQL.Result.SignatureMorphism as GraphQLResultSignatureMorphism
import PGIP.GraphQL.Result.StringReference (StringReference (..))
import PGIP.GraphQL.Result.Symbol as GraphQLResultSymbol
import PGIP.GraphQL.Result.SymbolMapping as GraphQLResultSymbolMapping

import Persistence.Schema as DatabaseSchema

import qualified Data.Text as Text
import Database.Esqueleto

actionToResult :: Entity DatabaseSchema.Action
               -> GraphQLResultAction.Action
actionToResult :: Entity Action -> Action
actionToResult (Entity _ actionValue :: Action
actionValue) =
  Action :: String -> Maybe String -> Action
GraphQLResultAction.Action
    { evaluationState :: String
GraphQLResultAction.evaluationState =
        EvaluationStateType -> String
forall a. Show a => a -> String
show (EvaluationStateType -> String) -> EvaluationStateType -> String
forall a b. (a -> b) -> a -> b
$ Action -> EvaluationStateType
actionEvaluationState Action
actionValue
    , message :: Maybe String
GraphQLResultAction.message = (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
Text.unpack (Maybe Text -> Maybe String) -> Maybe Text -> Maybe String
forall a b. (a -> b) -> a -> b
$ Action -> Maybe Text
actionMessage Action
actionValue
    }

axiomToResult :: Entity DatabaseSchema.Sentence
              -> Entity DatabaseSchema.LocIdBase
              -> Maybe (Entity DatabaseSchema.FileRange)
              -> [GraphQLResultSymbol.Symbol]
              -> GraphQLResultSentence.Sentence
axiomToResult :: Entity Sentence
-> Entity LocIdBase
-> Maybe (Entity FileRange)
-> [Symbol]
-> Sentence
axiomToResult (Entity _ sentenceValue :: Sentence
sentenceValue) (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue) fileRangeM :: Maybe (Entity FileRange)
fileRangeM symbolResults :: [Symbol]
symbolResults =
  Axiom -> Sentence
GraphQLResultSentence.Axiom Axiom :: String
-> Maybe FileRange
-> String
-> String
-> [Symbol]
-> String
-> Axiom
GraphQLResultAxiom.Axiom
    { __typename :: String
GraphQLResultAxiom.__typename = "Axiom"
    , fileRange :: Maybe FileRange
GraphQLResultAxiom.fileRange = (Entity FileRange -> FileRange)
-> Maybe (Entity FileRange) -> Maybe FileRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity FileRange -> FileRange
fileRangeToResult Maybe (Entity FileRange)
fileRangeM
    , locId :: String
GraphQLResultAxiom.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
    , name :: String
GraphQLResultAxiom.name = Sentence -> String
sentenceName Sentence
sentenceValue
    , symbols :: [Symbol]
GraphQLResultAxiom.symbols = [Symbol]
symbolResults
    , text :: String
GraphQLResultAxiom.text = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Sentence -> Text
sentenceText Sentence
sentenceValue
    }

conjectureToResult :: Entity DatabaseSchema.Sentence
                   -> Entity DatabaseSchema.LocIdBase
                   -> Maybe (Entity DatabaseSchema.FileRange)
                   -> Entity DatabaseSchema.Conjecture
                   -> GraphQLResultAction.Action
                   -> [GraphQLResultSymbol.Symbol]
                   -> [GraphQLResultReasoningAttempt.ReasoningAttempt]
                   -> GraphQLResultSentence.Sentence
conjectureToResult :: Entity Sentence
-> Entity LocIdBase
-> Maybe (Entity FileRange)
-> Entity Conjecture
-> Action
-> [Symbol]
-> [ReasoningAttempt]
-> Sentence
conjectureToResult (Entity _ sentenceValue :: Sentence
sentenceValue) (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue) fileRangeM :: Maybe (Entity FileRange)
fileRangeM
  (Entity _ _) actionResult :: Action
actionResult symbolResults :: [Symbol]
symbolResults proofAttemptResults :: [ReasoningAttempt]
proofAttemptResults =
  Conjecture -> Sentence
GraphQLResultSentence.Conjecture Conjecture :: String
-> Maybe FileRange
-> String
-> String
-> [Symbol]
-> String
-> Action
-> [ReasoningAttempt]
-> Conjecture
GraphQLResultConjecture.Conjecture
    { __typename :: String
GraphQLResultConjecture.__typename = "Conjecture"
    , fileRange :: Maybe FileRange
GraphQLResultConjecture.fileRange = (Entity FileRange -> FileRange)
-> Maybe (Entity FileRange) -> Maybe FileRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity FileRange -> FileRange
fileRangeToResult Maybe (Entity FileRange)
fileRangeM
    , locId :: String
GraphQLResultConjecture.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
    , name :: String
GraphQLResultConjecture.name = Sentence -> String
sentenceName Sentence
sentenceValue
    , symbols :: [Symbol]
GraphQLResultConjecture.symbols = [Symbol]
symbolResults
    , text :: String
GraphQLResultConjecture.text = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Sentence -> Text
sentenceText Sentence
sentenceValue
    , action :: Action
GraphQLResultConjecture.action = Action
actionResult
    , proofAttempts :: [ReasoningAttempt]
GraphQLResultConjecture.proofAttempts = [ReasoningAttempt]
proofAttemptResults
    }

conservativityStatusToResult :: Entity DatabaseSchema.ConservativityStatus
                             -> GraphQLResultConservativityStatus.ConservativityStatus
conservativityStatusToResult :: Entity ConservativityStatus -> ConservativityStatus
conservativityStatusToResult (Entity _ conservativityStatusValue :: ConservativityStatus
conservativityStatusValue) =
  ConservativityStatus :: String -> String -> ConservativityStatus
GraphQLResultConservativityStatus.ConservativityStatus
    { required :: String
GraphQLResultConservativityStatus.required =
        ConservativityStatus -> String
conservativityStatusRequired ConservativityStatus
conservativityStatusValue
    , proved :: String
GraphQLResultConservativityStatus.proved =
        ConservativityStatus -> String
conservativityStatusProved ConservativityStatus
conservativityStatusValue
    }

documentLinkToResult :: Entity DatabaseSchema.LocIdBase
                     -> Entity DatabaseSchema.LocIdBase
                     -> GraphQLResultDocumentLink.DocumentLink
documentLinkToResult :: Entity LocIdBase -> Entity LocIdBase -> DocumentLink
documentLinkToResult sourceLocId :: Entity LocIdBase
sourceLocId targetLocId :: Entity LocIdBase
targetLocId =
  DocumentLink :: LocIdReference -> LocIdReference -> DocumentLink
GraphQLResultDocumentLink.DocumentLink
    { source :: LocIdReference
GraphQLResultDocumentLink.source =
        String -> LocIdReference
LocIdReference (String -> LocIdReference) -> String -> LocIdReference
forall a b. (a -> b) -> a -> b
$ LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
sourceLocId
    , target :: LocIdReference
GraphQLResultDocumentLink.target =
        String -> LocIdReference
LocIdReference (String -> LocIdReference) -> String -> LocIdReference
forall a b. (a -> b) -> a -> b
$ LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
targetLocId
    }

fileRangeToResult :: Entity DatabaseSchema.FileRange
                  -> GraphQLResultFileRange.FileRange
fileRangeToResult :: Entity FileRange -> FileRange
fileRangeToResult (Entity _ fileRangeValue :: FileRange
fileRangeValue) =
  FileRange :: Int -> Int -> Maybe Int -> Maybe Int -> String -> FileRange
GraphQLResultFileRange.FileRange
     { startLine :: Int
GraphQLResultFileRange.startLine = FileRange -> Int
fileRangeStartLine FileRange
fileRangeValue
     , startColumn :: Int
GraphQLResultFileRange.startColumn = FileRange -> Int
fileRangeStartColumn FileRange
fileRangeValue
     , endLine :: Maybe Int
GraphQLResultFileRange.endLine = FileRange -> Maybe Int
fileRangeEndLine FileRange
fileRangeValue
     , endColumn :: Maybe Int
GraphQLResultFileRange.endColumn = FileRange -> Maybe Int
fileRangeEndColumn FileRange
fileRangeValue
     , path :: String
GraphQLResultFileRange.path = FileRange -> String
fileRangePath FileRange
fileRangeValue
     }

languageToResult :: Entity DatabaseSchema.Language
                 -> GraphQLResultLanguage.Language
languageToResult :: Entity Language -> Language
languageToResult (Entity _ languageValue :: Language
languageValue) =
  Language :: String -> String -> String -> Language
GraphQLResultLanguage.Language
    { id :: String
GraphQLResultLanguage.id = Language -> String
languageSlug Language
languageValue
    , name :: String
GraphQLResultLanguage.name = Language -> String
languageName Language
languageValue
    , description :: String
GraphQLResultLanguage.description = Language -> String
languageDescription Language
languageValue
    }

languageMappingToResult :: Entity DatabaseSchema.LanguageMapping
                        -> Entity DatabaseSchema.Language
                        -> Entity DatabaseSchema.Language
                        -> GraphQLResultLanguageMapping.LanguageMapping
languageMappingToResult :: Entity LanguageMapping
-> Entity Language -> Entity Language -> LanguageMapping
languageMappingToResult languageMappingEntity :: Entity LanguageMapping
languageMappingEntity languageSource :: Entity Language
languageSource languageTarget :: Entity Language
languageTarget =
  LanguageMapping :: Int -> StringReference -> StringReference -> LanguageMapping
GraphQLResultLanguageMapping.LanguageMapping
    { id :: Int
GraphQLResultLanguageMapping.id =
        Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key LanguageMapping -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key LanguageMapping -> Int64) -> Key LanguageMapping -> Int64
forall a b. (a -> b) -> a -> b
$ Entity LanguageMapping -> Key LanguageMapping
forall record. Entity record -> Key record
entityKey Entity LanguageMapping
languageMappingEntity
    , source :: StringReference
GraphQLResultLanguageMapping.source =
        String -> StringReference
StringReference (String -> StringReference) -> String -> StringReference
forall a b. (a -> b) -> a -> b
$ Language -> String
DatabaseSchema.languageSlug (Language -> String) -> Language -> String
forall a b. (a -> b) -> a -> b
$ Entity Language -> Language
forall record. Entity record -> record
entityVal Entity Language
languageSource
    , target :: StringReference
GraphQLResultLanguageMapping.target =
        String -> StringReference
StringReference (String -> StringReference) -> String -> StringReference
forall a b. (a -> b) -> a -> b
$ Language -> String
DatabaseSchema.languageSlug (Language -> String) -> Language -> String
forall a b. (a -> b) -> a -> b
$ Entity Language -> Language
forall record. Entity record -> record
entityVal Entity Language
languageTarget
    }

libraryToResult :: Entity DatabaseSchema.Document
                -> Entity DatabaseSchema.LocIdBase
                -> [GraphQLResultDocumentLink.DocumentLink]
                -> [GraphQLResultDocumentLink.DocumentLink]
                -> [GraphQLResultOMSSimple.OMSSimple]
                -> GraphQLResultLibrary.Library
libraryToResult :: Entity Document
-> Entity LocIdBase
-> [DocumentLink]
-> [DocumentLink]
-> [OMSSimple]
-> Library
libraryToResult (Entity _ documentValue :: Document
documentValue) (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue)
  documentLinksSourceResults :: [DocumentLink]
documentLinksSourceResults documentLinksTargetResults :: [DocumentLink]
documentLinksTargetResults omsResults :: [OMSSimple]
omsResults =
  Library :: String
-> String
-> String
-> String
-> Maybe String
-> [DocumentLink]
-> [DocumentLink]
-> [OMSSimple]
-> Library
GraphQLResultLibrary.Library
    { __typename :: String
GraphQLResultLibrary.__typename = "Library"
    , displayName :: String
GraphQLResultLibrary.displayName = Document -> String
documentDisplayName Document
documentValue
    , locId :: String
GraphQLResultLibrary.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
    , name :: String
GraphQLResultLibrary.name = Document -> String
documentName Document
documentValue
    , version :: Maybe String
GraphQLResultLibrary.version = Document -> Maybe String
documentVersion Document
documentValue
    , documentLinksSource :: [DocumentLink]
GraphQLResultLibrary.documentLinksSource = [DocumentLink]
documentLinksSourceResults
    , documentLinksTarget :: [DocumentLink]
GraphQLResultLibrary.documentLinksTarget = [DocumentLink]
documentLinksTargetResults
    , omsList :: [OMSSimple]
GraphQLResultLibrary.omsList = [OMSSimple]
omsResults
    }

logicToResult :: Entity DatabaseSchema.Logic
              -> GraphQLResultLogic.Logic
logicToResult :: Entity Logic -> Logic
logicToResult (Entity _ logicValue :: Logic
logicValue) =
  Logic :: String -> String -> Logic
GraphQLResultLogic.Logic
    { id :: String
GraphQLResultLogic.id = Logic -> String
logicSlug Logic
logicValue
    , name :: String
GraphQLResultLogic.name = Logic -> String
logicName Logic
logicValue
    }

logicMappingToResult :: Entity DatabaseSchema.LogicMapping
                     -> Entity DatabaseSchema.Logic
                     -> Entity DatabaseSchema.Logic
                     -> GraphQLResultLanguageMapping.LanguageMapping
                     -> GraphQLResultLogicMapping.LogicMapping
logicMappingToResult :: Entity LogicMapping
-> Entity Logic -> Entity Logic -> LanguageMapping -> LogicMapping
logicMappingToResult (Entity _ logicMappingValue :: LogicMapping
logicMappingValue) logicSource :: Entity Logic
logicSource logicTarget :: Entity Logic
logicTarget languageMappingResult :: LanguageMapping
languageMappingResult =
  LogicMapping :: String
-> LanguageMapping
-> StringReference
-> StringReference
-> LogicMapping
GraphQLResultLogicMapping.LogicMapping
    { id :: String
GraphQLResultLogicMapping.id = LogicMapping -> String
DatabaseSchema.logicMappingSlug LogicMapping
logicMappingValue
    , languageMapping :: LanguageMapping
GraphQLResultLogicMapping.languageMapping = LanguageMapping
languageMappingResult
    , source :: StringReference
GraphQLResultLogicMapping.source =
        String -> StringReference
StringReference (String -> StringReference) -> String -> StringReference
forall a b. (a -> b) -> a -> b
$ Logic -> String
DatabaseSchema.logicSlug (Logic -> String) -> Logic -> String
forall a b. (a -> b) -> a -> b
$ Entity Logic -> Logic
forall record. Entity record -> record
entityVal Entity Logic
logicSource
    , target :: StringReference
GraphQLResultLogicMapping.target =
        String -> StringReference
StringReference (String -> StringReference) -> String -> StringReference
forall a b. (a -> b) -> a -> b
$ Logic -> String
DatabaseSchema.logicSlug (Logic -> String) -> Logic -> String
forall a b. (a -> b) -> a -> b
$ Entity Logic -> Logic
forall record. Entity record -> record
entityVal Entity Logic
logicTarget
    }

mappingToResult :: Entity DatabaseSchema.Mapping
                -> Entity DatabaseSchema.LocIdBase
                -> Entity DatabaseSchema.SignatureMorphism
                -> Maybe (Entity DatabaseSchema.ConservativityStatus)
                -> Entity DatabaseSchema.LocIdBase -- The source OMS
                -> Entity DatabaseSchema.LocIdBase -- The target OMS
                -> Maybe (Entity DatabaseSchema.LocIdBase)
                -> Maybe (Entity DatabaseSchema.Language)
                -> GraphQLResultMapping.Mapping
mappingToResult :: Entity Mapping
-> Entity LocIdBase
-> Entity SignatureMorphism
-> Maybe (Entity ConservativityStatus)
-> Entity LocIdBase
-> Entity LocIdBase
-> Maybe (Entity LocIdBase)
-> Maybe (Entity Language)
-> Mapping
mappingToResult (Entity _ mappingValue :: Mapping
mappingValue) mappingLocIdBase :: Entity LocIdBase
mappingLocIdBase (Entity signatureMorphismKey :: Key SignatureMorphism
signatureMorphismKey _)
  conservativityStatusM :: Maybe (Entity ConservativityStatus)
conservativityStatusM locIdBaseSource :: Entity LocIdBase
locIdBaseSource locIdBaseTarget :: Entity LocIdBase
locIdBaseTarget
  freenesParameterOMSLocIdM :: Maybe (Entity LocIdBase)
freenesParameterOMSLocIdM freenessParameterLanguageM :: Maybe (Entity Language)
freenessParameterLanguageM =
  let conservativityStatusResult :: Maybe ConservativityStatus
conservativityStatusResult = (Entity ConservativityStatus -> ConservativityStatus)
-> Maybe (Entity ConservativityStatus)
-> Maybe ConservativityStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity ConservativityStatus -> ConservativityStatus
conservativityStatusToResult Maybe (Entity ConservativityStatus)
conservativityStatusM
      freenessParameterLanguageResult :: Maybe Language
freenessParameterLanguageResult = (Entity Language -> Language)
-> Maybe (Entity Language) -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity Language -> Language
languageToResult Maybe (Entity Language)
freenessParameterLanguageM
  in  Mapping :: Maybe ConservativityStatus
-> String
-> Maybe LocIdReference
-> Maybe Language
-> String
-> String
-> String
-> Bool
-> IdReference
-> LocIdReference
-> LocIdReference
-> String
-> Mapping
GraphQLResultMapping.Mapping
        { conservativityStatus :: Maybe ConservativityStatus
GraphQLResultMapping.conservativityStatus = Maybe ConservativityStatus
conservativityStatusResult
        , displayName :: String
GraphQLResultMapping.displayName = Mapping -> String
mappingDisplayName Mapping
mappingValue
        , freenessParameterOMS :: Maybe LocIdReference
GraphQLResultMapping.freenessParameterOMS =
            (Entity LocIdBase -> LocIdReference)
-> Maybe (Entity LocIdBase) -> Maybe LocIdReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> LocIdReference
LocIdReference (String -> LocIdReference)
-> (Entity LocIdBase -> String)
-> Entity LocIdBase
-> LocIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocIdBase -> String
locIdBaseLocId (LocIdBase -> String)
-> (Entity LocIdBase -> LocIdBase) -> Entity LocIdBase -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal)
            Maybe (Entity LocIdBase)
freenesParameterOMSLocIdM
        , freenessParameterLanguage :: Maybe Language
GraphQLResultMapping.freenessParameterLanguage =
            Maybe Language
freenessParameterLanguageResult
        , locId :: String
GraphQLResultMapping.locId = LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
mappingLocIdBase
        , name :: String
GraphQLResultMapping.name = Mapping -> String
mappingName Mapping
mappingValue
        , origin :: String
GraphQLResultMapping.origin = MappingOrigin -> String
forall a. Show a => a -> String
show (MappingOrigin -> String) -> MappingOrigin -> String
forall a b. (a -> b) -> a -> b
$ Mapping -> MappingOrigin
mappingOrigin Mapping
mappingValue
        , pending :: Bool
GraphQLResultMapping.pending = Mapping -> Bool
mappingPending Mapping
mappingValue
        , signatureMorphism :: IdReference
GraphQLResultMapping.signatureMorphism =
            Int -> IdReference
IdReference (Int -> IdReference) -> Int -> IdReference
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key SignatureMorphism
signatureMorphismKey
        , source :: LocIdReference
GraphQLResultMapping.source =
            String -> LocIdReference
LocIdReference (String -> LocIdReference) -> String -> LocIdReference
forall a b. (a -> b) -> a -> b
$ LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
locIdBaseSource
        , target :: LocIdReference
GraphQLResultMapping.target =
            String -> LocIdReference
LocIdReference (String -> LocIdReference) -> String -> LocIdReference
forall a b. (a -> b) -> a -> b
$ LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
locIdBaseTarget
        , mappingType :: String
GraphQLResultMapping.mappingType =
            MappingType -> String
forall a. Show a => a -> String
show (MappingType -> String) -> MappingType -> String
forall a b. (a -> b) -> a -> b
$ Mapping -> MappingType
DatabaseSchema.mappingType Mapping
mappingValue
        }

nativeDocumentToResult :: Entity DatabaseSchema.Document
                       -> Entity DatabaseSchema.LocIdBase
                       -> [GraphQLResultDocumentLink.DocumentLink]
                       -> [GraphQLResultDocumentLink.DocumentLink]
                       -> GraphQLResultOMSSimple.OMSSimple
                       -> GraphQLResultNativeDocument.NativeDocument
nativeDocumentToResult :: Entity Document
-> Entity LocIdBase
-> [DocumentLink]
-> [DocumentLink]
-> OMSSimple
-> NativeDocument
nativeDocumentToResult (Entity _ documentValue :: Document
documentValue) (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue)
  documentLinksSourceResults :: [DocumentLink]
documentLinksSourceResults documentLinksTargetResults :: [DocumentLink]
documentLinksTargetResults omsResult :: OMSSimple
omsResult =
  NativeDocument :: String
-> String
-> String
-> String
-> Maybe String
-> [DocumentLink]
-> [DocumentLink]
-> OMSSimple
-> NativeDocument
GraphQLResultNativeDocument.NativeDocument
    { __typename :: String
GraphQLResultNativeDocument.__typename = "NativeDocument"
    , displayName :: String
GraphQLResultNativeDocument.displayName = Document -> String
documentDisplayName Document
documentValue
    , locId :: String
GraphQLResultNativeDocument.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
    , name :: String
GraphQLResultNativeDocument.name = Document -> String
documentName Document
documentValue
    , version :: Maybe String
GraphQLResultNativeDocument.version = Document -> Maybe String
documentVersion Document
documentValue
    , documentLinksSource :: [DocumentLink]
GraphQLResultNativeDocument.documentLinksSource = [DocumentLink]
documentLinksSourceResults
    , documentLinksTarget :: [DocumentLink]
GraphQLResultNativeDocument.documentLinksTarget = [DocumentLink]
documentLinksTargetResults
    , oms :: OMSSimple
GraphQLResultNativeDocument.oms = OMSSimple
omsResult
    }

omsToResult :: Entity DatabaseSchema.OMS
            -> Entity DatabaseSchema.LocIdBase
            -> Entity DatabaseSchema.ConservativityStatus
            -> Maybe (Entity DatabaseSchema.FileRange)
            -> Maybe (Entity DatabaseSchema.LocIdBase)
            -> Maybe (Entity DatabaseSchema.SignatureMorphism)
            -> Entity DatabaseSchema.Language
            -> Entity DatabaseSchema.Logic
            -> Maybe (Entity DatabaseSchema.LocIdBase)
            -> Maybe (Entity DatabaseSchema.SignatureMorphism)
            -> [GraphQLResultReasoningAttempt.ReasoningAttempt]
            -> [GraphQLResultMapping.Mapping]
            -> [GraphQLResultMapping.Mapping]
            -> [GraphQLResultSentence.Sentence]
            -> Maybe StringReference
            -> GraphQLResultOMS.OMS
omsToResult :: Entity OMS
-> Entity LocIdBase
-> Entity ConservativityStatus
-> Maybe (Entity FileRange)
-> Maybe (Entity LocIdBase)
-> Maybe (Entity SignatureMorphism)
-> Entity Language
-> Entity Logic
-> Maybe (Entity LocIdBase)
-> Maybe (Entity SignatureMorphism)
-> [ReasoningAttempt]
-> [Mapping]
-> [Mapping]
-> [Sentence]
-> Maybe StringReference
-> OMS
omsToResult (Entity _ omsValue :: OMS
omsValue) locIdBaseOMS :: Entity LocIdBase
locIdBaseOMS conservativityStatusEntity :: Entity ConservativityStatus
conservativityStatusEntity
  fileRangeM :: Maybe (Entity FileRange)
fileRangeM freeNormalFormLocIdBaseM :: Maybe (Entity LocIdBase)
freeNormalFormLocIdBaseM freeNormalFormSignatureMorphismM :: Maybe (Entity SignatureMorphism)
freeNormalFormSignatureMorphismM
  languageEntity :: Entity Language
languageEntity logicEntity :: Entity Logic
logicEntity
  normalFormLocIdBaseM :: Maybe (Entity LocIdBase)
normalFormLocIdBaseM normalFormSignatureMorphismM :: Maybe (Entity SignatureMorphism)
normalFormSignatureMorphismM
  consistencyCheckAttemptResults :: [ReasoningAttempt]
consistencyCheckAttemptResults mappingSourceResults :: [Mapping]
mappingSourceResults mappingTargetResults :: [Mapping]
mappingTargetResults sentenceResults :: [Sentence]
sentenceResults
  serializationResult :: Maybe StringReference
serializationResult =
  let conservativityStatusResult :: ConservativityStatus
conservativityStatusResult = Entity ConservativityStatus -> ConservativityStatus
conservativityStatusToResult Entity ConservativityStatus
conservativityStatusEntity
      fileRangeResult :: Maybe FileRange
fileRangeResult = (Entity FileRange -> FileRange)
-> Maybe (Entity FileRange) -> Maybe FileRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity FileRange -> FileRange
fileRangeToResult Maybe (Entity FileRange)
fileRangeM
  in  OMS :: ConservativityStatus
-> [ReasoningAttempt]
-> Maybe String
-> String
-> Maybe LocIdReference
-> Maybe IdReference
-> Bool
-> Bool
-> Language
-> String
-> Logic
-> [Mapping]
-> [Mapping]
-> String
-> String
-> Int
-> Maybe FileRange
-> Maybe LocIdReference
-> Maybe IdReference
-> String
-> [Sentence]
-> Maybe StringReference
-> IdReference
-> OMS
GraphQLResultOMS.OMS
        { conservativityStatus :: ConservativityStatus
GraphQLResultOMS.conservativityStatus = ConservativityStatus
conservativityStatusResult
        , consistencyCheckAttempts :: [ReasoningAttempt]
GraphQLResultOMS.consistencyCheckAttempts = [ReasoningAttempt]
consistencyCheckAttemptResults
        , description :: Maybe String
GraphQLResultOMS.description = Maybe String
forall a. Maybe a
Nothing
        , displayName :: String
GraphQLResultOMS.displayName = OMS -> String
oMSDisplayName OMS
omsValue
        , freeNormalForm :: Maybe LocIdReference
GraphQLResultOMS.freeNormalForm =
            (Entity LocIdBase -> LocIdReference)
-> Maybe (Entity LocIdBase) -> Maybe LocIdReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> LocIdReference
LocIdReference (String -> LocIdReference)
-> (Entity LocIdBase -> String)
-> Entity LocIdBase
-> LocIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocIdBase -> String
locIdBaseLocId (LocIdBase -> String)
-> (Entity LocIdBase -> LocIdBase) -> Entity LocIdBase -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal) Maybe (Entity LocIdBase)
freeNormalFormLocIdBaseM
        , freeNormalFormSignatureMorphism :: Maybe IdReference
GraphQLResultOMS.freeNormalFormSignatureMorphism =
            (Entity SignatureMorphism -> IdReference)
-> Maybe (Entity SignatureMorphism) -> Maybe IdReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> IdReference
IdReference (Int -> IdReference)
-> (Entity SignatureMorphism -> Int)
-> Entity SignatureMorphism
-> IdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (Entity SignatureMorphism -> Int64)
-> Entity SignatureMorphism
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key SignatureMorphism -> Int64)
-> (Entity SignatureMorphism -> Key SignatureMorphism)
-> Entity SignatureMorphism
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SignatureMorphism -> Key SignatureMorphism
forall record. Entity record -> Key record
entityKey)
            Maybe (Entity SignatureMorphism)
freeNormalFormSignatureMorphismM
        , labelHasFree :: Bool
GraphQLResultOMS.labelHasFree = OMS -> Bool
oMSLabelHasFree OMS
omsValue
        , labelHasHiding :: Bool
GraphQLResultOMS.labelHasHiding = OMS -> Bool
oMSLabelHasHiding OMS
omsValue
        , language :: Language
GraphQLResultOMS.language = Entity Language -> Language
languageToResult Entity Language
languageEntity
        , locId :: String
GraphQLResultOMS.locId = LocIdBase -> String
locIdBaseLocId (LocIdBase -> String) -> LocIdBase -> String
forall a b. (a -> b) -> a -> b
$ Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal Entity LocIdBase
locIdBaseOMS
        , logic :: Logic
GraphQLResultOMS.logic = Entity Logic -> Logic
logicToResult Entity Logic
logicEntity
        , mappingsSource :: [Mapping]
GraphQLResultOMS.mappingsSource = [Mapping]
mappingSourceResults
        , mappingsTarget :: [Mapping]
GraphQLResultOMS.mappingsTarget = [Mapping]
mappingTargetResults
        , name :: String
GraphQLResultOMS.name = OMS -> String
oMSName OMS
omsValue
        , nameExtension :: String
GraphQLResultOMS.nameExtension = OMS -> String
oMSNameExtension OMS
omsValue
        , nameExtensionIndex :: Int
GraphQLResultOMS.nameExtensionIndex = OMS -> Int
oMSNameExtensionIndex OMS
omsValue
        , nameFileRange :: Maybe FileRange
GraphQLResultOMS.nameFileRange = Maybe FileRange
fileRangeResult
        , normalForm :: Maybe LocIdReference
GraphQLResultOMS.normalForm =
            (Entity LocIdBase -> LocIdReference)
-> Maybe (Entity LocIdBase) -> Maybe LocIdReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> LocIdReference
LocIdReference (String -> LocIdReference)
-> (Entity LocIdBase -> String)
-> Entity LocIdBase
-> LocIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocIdBase -> String
locIdBaseLocId (LocIdBase -> String)
-> (Entity LocIdBase -> LocIdBase) -> Entity LocIdBase -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal) Maybe (Entity LocIdBase)
normalFormLocIdBaseM
        , normalFormSignatureMorphism :: Maybe IdReference
GraphQLResultOMS.normalFormSignatureMorphism =
            (Entity SignatureMorphism -> IdReference)
-> Maybe (Entity SignatureMorphism) -> Maybe IdReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> IdReference
IdReference (Int -> IdReference)
-> (Entity SignatureMorphism -> Int)
-> Entity SignatureMorphism
-> IdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (Entity SignatureMorphism -> Int64)
-> Entity SignatureMorphism
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key SignatureMorphism -> Int64)
-> (Entity SignatureMorphism -> Key SignatureMorphism)
-> Entity SignatureMorphism
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SignatureMorphism -> Key SignatureMorphism
forall record. Entity record -> Key record
entityKey)
            Maybe (Entity SignatureMorphism)
normalFormSignatureMorphismM
        , origin :: String
GraphQLResultOMS.origin = OMSOrigin -> String
forall a. Show a => a -> String
show (OMSOrigin -> String) -> OMSOrigin -> String
forall a b. (a -> b) -> a -> b
$ OMS -> OMSOrigin
oMSOrigin OMS
omsValue
        , sentences :: [Sentence]
GraphQLResultOMS.sentences = [Sentence]
sentenceResults
        , serialization :: Maybe StringReference
GraphQLResultOMS.serialization = Maybe StringReference
serializationResult
        , omsSignature :: IdReference
GraphQLResultOMS.omsSignature =
            Int -> IdReference
IdReference (Int -> IdReference) -> Int -> IdReference
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key Signature -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key Signature -> Int64) -> Key Signature -> Int64
forall a b. (a -> b) -> a -> b
$ OMS -> Key Signature
oMSSignatureId OMS
omsValue
        }

omsToResultSimple :: Entity DatabaseSchema.OMS
                  -> Entity DatabaseSchema.LocIdBase
                  -> GraphQLResultOMSSimple.OMSSimple
omsToResultSimple :: Entity OMS -> Entity LocIdBase -> OMSSimple
omsToResultSimple (Entity _ omsValue :: OMS
omsValue) (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue) =
  OMSSimple :: Maybe String
-> String
-> Bool
-> Bool
-> String
-> String
-> String
-> Int
-> String
-> OMSSimple
GraphQLResultOMSSimple.OMSSimple
    { description :: Maybe String
GraphQLResultOMSSimple.description = Maybe String
forall a. Maybe a
Nothing
    , displayName :: String
GraphQLResultOMSSimple.displayName = OMS -> String
oMSDisplayName OMS
omsValue
    , labelHasFree :: Bool
GraphQLResultOMSSimple.labelHasFree = OMS -> Bool
oMSLabelHasFree OMS
omsValue
    , labelHasHiding :: Bool
GraphQLResultOMSSimple.labelHasHiding = OMS -> Bool
oMSLabelHasHiding OMS
omsValue
    , locId :: String
GraphQLResultOMSSimple.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
    , name :: String
GraphQLResultOMSSimple.name = OMS -> String
oMSName OMS
omsValue
    , nameExtension :: String
GraphQLResultOMSSimple.nameExtension = OMS -> String
oMSNameExtension OMS
omsValue
    , nameExtensionIndex :: Int
GraphQLResultOMSSimple.nameExtensionIndex = OMS -> Int
oMSNameExtensionIndex OMS
omsValue
    , origin :: String
GraphQLResultOMSSimple.origin = OMSOrigin -> String
forall a. Show a => a -> String
show (OMSOrigin -> String) -> OMSOrigin -> String
forall a b. (a -> b) -> a -> b
$ OMS -> OMSOrigin
oMSOrigin OMS
omsValue
    }

premiseSelectionToResult :: [Entity DatabaseSchema.LocIdBase] -- Of Sentence
                         -> GraphQLResultPremiseSelection.PremiseSelection
premiseSelectionToResult :: [Entity LocIdBase] -> PremiseSelection
premiseSelectionToResult premises :: [Entity LocIdBase]
premises =
  PremiseSelection :: [LocIdReference] -> PremiseSelection
GraphQLResultPremiseSelection.PremiseSelection
    { selectedPremises :: [LocIdReference]
GraphQLResultPremiseSelection.selectedPremises =
        (Entity LocIdBase -> LocIdReference)
-> [Entity LocIdBase] -> [LocIdReference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> LocIdReference
LocIdReference (String -> LocIdReference)
-> (Entity LocIdBase -> String)
-> Entity LocIdBase
-> LocIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocIdBase -> String
locIdBaseLocId (LocIdBase -> String)
-> (Entity LocIdBase -> LocIdBase) -> Entity LocIdBase -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal) [Entity LocIdBase]
premises
    }

reasonerToResult :: Entity DatabaseSchema.Reasoner
                 -> GraphQLResultReasoner.Reasoner
reasonerToResult :: Entity Reasoner -> Reasoner
reasonerToResult (Entity _ reasonerValue :: Reasoner
reasonerValue) =
  Reasoner :: String -> String -> Reasoner
GraphQLResultReasoner.Reasoner
    { id :: String
GraphQLResultReasoner.id = Reasoner -> String
reasonerSlug Reasoner
reasonerValue
    , displayName :: String
GraphQLResultReasoner.displayName = Reasoner -> String
reasonerDisplayName Reasoner
reasonerValue
    }

reasonerConfigurationToResult :: Entity DatabaseSchema.ReasonerConfiguration
                              -> Maybe (Entity DatabaseSchema.Reasoner)
                              -> [GraphQLResultPremiseSelection.PremiseSelection]
                              -> GraphQLResultReasonerConfiguration.ReasonerConfiguration
reasonerConfigurationToResult :: Entity ReasonerConfiguration
-> Maybe (Entity Reasoner)
-> [PremiseSelection]
-> ReasonerConfiguration
reasonerConfigurationToResult (Entity reasonerConfigurationKey :: Key ReasonerConfiguration
reasonerConfigurationKey
  reasonerConfigurationValue :: ReasonerConfiguration
reasonerConfigurationValue) reasonerM :: Maybe (Entity Reasoner)
reasonerM premiseSelectionResults :: [PremiseSelection]
premiseSelectionResults =
  ReasonerConfiguration :: Maybe Reasoner
-> Int -> [PremiseSelection] -> Maybe Int -> ReasonerConfiguration
GraphQLResultReasonerConfiguration.ReasonerConfiguration
    { configuredReasoner :: Maybe Reasoner
GraphQLResultReasonerConfiguration.configuredReasoner =
        (Entity Reasoner -> Reasoner)
-> Maybe (Entity Reasoner) -> Maybe Reasoner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity Reasoner -> Reasoner
reasonerToResult Maybe (Entity Reasoner)
reasonerM
    , id :: Int
GraphQLResultReasonerConfiguration.id =
        Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key ReasonerConfiguration -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key ReasonerConfiguration
reasonerConfigurationKey
    , premiseSelections :: [PremiseSelection]
GraphQLResultReasonerConfiguration.premiseSelections =
        [PremiseSelection]
premiseSelectionResults
    , timeLimit :: Maybe Int
GraphQLResultReasonerConfiguration.timeLimit =
        ReasonerConfiguration -> Maybe Int
reasonerConfigurationTimeLimit ReasonerConfiguration
reasonerConfigurationValue
    }

reasonerOutputToResult :: Entity DatabaseSchema.ReasonerOutput
                       -> GraphQLResultReasonerOutput.ReasonerOutput
reasonerOutputToResult :: Entity ReasonerOutput -> ReasonerOutput
reasonerOutputToResult (Entity _ reasonerOutputValue :: ReasonerOutput
reasonerOutputValue) =
  ReasonerOutput :: String -> ReasonerOutput
GraphQLResultReasonerOutput.ReasonerOutput
    { text :: String
GraphQLResultReasonerOutput.text =
        Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ReasonerOutput -> Text
reasonerOutputText ReasonerOutput
reasonerOutputValue
    }

reasoningAttemptToResult :: Entity DatabaseSchema.ReasoningAttempt
                         -> Maybe (Entity DatabaseSchema.ReasonerOutput)
                         -> Maybe (Entity DatabaseSchema.Reasoner)
                         -> GraphQLResultAction.Action
                         -> GraphQLResultReasonerConfiguration.ReasonerConfiguration
                         -> GraphQLResultReasoningAttempt.ReasoningAttempt
reasoningAttemptToResult :: Entity ReasoningAttempt
-> Maybe (Entity ReasonerOutput)
-> Maybe (Entity Reasoner)
-> Action
-> ReasonerConfiguration
-> ReasoningAttempt
reasoningAttemptToResult (Entity _ reasoningAttemptValue :: ReasoningAttempt
reasoningAttemptValue) reasonerOutputEntity :: Maybe (Entity ReasonerOutput)
reasonerOutputEntity
  reasonerEntityM :: Maybe (Entity Reasoner)
reasonerEntityM actionResult :: Action
actionResult reasonerConfigurationResult :: ReasonerConfiguration
reasonerConfigurationResult =
  ReasoningAttempt :: Action
-> ReasonerConfiguration
-> Maybe ReasonerOutput
-> Maybe Int
-> Maybe Reasoner
-> ReasoningAttempt
GraphQLResultReasoningAttempt.ReasoningAttempt
    { action :: Action
GraphQLResultReasoningAttempt.action = Action
actionResult
    , reasonerOutput :: Maybe ReasonerOutput
GraphQLResultReasoningAttempt.reasonerOutput =
        (Entity ReasonerOutput -> ReasonerOutput)
-> Maybe (Entity ReasonerOutput) -> Maybe ReasonerOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity ReasonerOutput -> ReasonerOutput
reasonerOutputToResult Maybe (Entity ReasonerOutput)
reasonerOutputEntity
    , reasonerConfiguration :: ReasonerConfiguration
GraphQLResultReasoningAttempt.reasonerConfiguration =
        ReasonerConfiguration
reasonerConfigurationResult
    , timeTaken :: Maybe Int
GraphQLResultReasoningAttempt.timeTaken =
        ReasoningAttempt -> Maybe Int
reasoningAttemptTimeTaken ReasoningAttempt
reasoningAttemptValue
    , usedReasoner :: Maybe Reasoner
GraphQLResultReasoningAttempt.usedReasoner =
        (Entity Reasoner -> Reasoner)
-> Maybe (Entity Reasoner) -> Maybe Reasoner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity Reasoner -> Reasoner
reasonerToResult Maybe (Entity Reasoner)
reasonerEntityM
    }

serializationToResult :: Entity DatabaseSchema.Serialization
                      -> Entity DatabaseSchema.Language
                      -> GraphQLResultSerialization.Serialization
serializationToResult :: Entity Serialization -> Entity Language -> Serialization
serializationToResult (Entity _ serializationValue :: Serialization
serializationValue) languageEntity :: Entity Language
languageEntity =
  let languageResult :: Language
languageResult = Entity Language -> Language
languageToResult Entity Language
languageEntity
  in Serialization :: String -> Language -> String -> Serialization
GraphQLResultSerialization.Serialization
        { id :: String
GraphQLResultSerialization.id = Serialization -> String
serializationSlug Serialization
serializationValue
        , language :: Language
GraphQLResultSerialization.language = Language
languageResult
        , name :: String
GraphQLResultSerialization.name = Serialization -> String
serializationName Serialization
serializationValue
        }

signatureToResult :: Entity DatabaseSchema.Signature
                  -> [Entity DatabaseSchema.LocIdBase] -- Of the OMS with this signature
                  -> [Entity DatabaseSchema.SignatureMorphism]
                  -> [Entity DatabaseSchema.SignatureMorphism]
                  -> [( Entity DatabaseSchema.LocIdBase
                      , Entity DatabaseSchema.Symbol
                      , Maybe (Entity DatabaseSchema.FileRange)
                      )]
                  -> GraphQLResultSignature.Signature
signatureToResult :: Entity Signature
-> [Entity LocIdBase]
-> [Entity SignatureMorphism]
-> [Entity SignatureMorphism]
-> [(Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))]
-> Signature
signatureToResult (Entity signatureKey :: Key Signature
signatureKey _) omsL :: [Entity LocIdBase]
omsL signatureMorphismsAsSourceL :: [Entity SignatureMorphism]
signatureMorphismsAsSourceL
  signatureMorphismsAsTargetL :: [Entity SignatureMorphism]
signatureMorphismsAsTargetL symbolsWithFileRanges :: [(Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))]
symbolsWithFileRanges =
  Signature :: Int
-> [LocIdReference]
-> [IdReference]
-> [IdReference]
-> [Symbol]
-> Signature
GraphQLResultSignature.Signature
    { id :: Int
GraphQLResultSignature.id = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key Signature -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key Signature
signatureKey
    , oms :: [LocIdReference]
GraphQLResultSignature.oms =
        (Entity LocIdBase -> LocIdReference)
-> [Entity LocIdBase] -> [LocIdReference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> LocIdReference
LocIdReference (String -> LocIdReference)
-> (Entity LocIdBase -> String)
-> Entity LocIdBase
-> LocIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocIdBase -> String
locIdBaseLocId (LocIdBase -> String)
-> (Entity LocIdBase -> LocIdBase) -> Entity LocIdBase -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LocIdBase -> LocIdBase
forall record. Entity record -> record
entityVal) [Entity LocIdBase]
omsL
    , signatureMorphismsSource :: [IdReference]
GraphQLResultSignature.signatureMorphismsSource =
        (Entity SignatureMorphism -> IdReference)
-> [Entity SignatureMorphism] -> [IdReference]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> IdReference
IdReference (Int -> IdReference)
-> (Entity SignatureMorphism -> Int)
-> Entity SignatureMorphism
-> IdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (Entity SignatureMorphism -> Int64)
-> Entity SignatureMorphism
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key SignatureMorphism -> Int64)
-> (Entity SignatureMorphism -> Key SignatureMorphism)
-> Entity SignatureMorphism
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SignatureMorphism -> Key SignatureMorphism
forall record. Entity record -> Key record
entityKey)
        [Entity SignatureMorphism]
signatureMorphismsAsSourceL
    , signatureMorphismsTarget :: [IdReference]
GraphQLResultSignature.signatureMorphismsTarget =
        (Entity SignatureMorphism -> IdReference)
-> [Entity SignatureMorphism] -> [IdReference]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> IdReference
IdReference (Int -> IdReference)
-> (Entity SignatureMorphism -> Int)
-> Entity SignatureMorphism
-> IdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (Entity SignatureMorphism -> Int64)
-> Entity SignatureMorphism
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key SignatureMorphism -> Int64)
-> (Entity SignatureMorphism -> Key SignatureMorphism)
-> Entity SignatureMorphism
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SignatureMorphism -> Key SignatureMorphism
forall record. Entity record -> Key record
entityKey)
        [Entity SignatureMorphism]
signatureMorphismsAsTargetL
    , symbols :: [Symbol]
GraphQLResultSignature.symbols =
        ((Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
 -> Symbol)
-> [(Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))]
-> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> Symbol
symbolToResultUncurried [(Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))]
symbolsWithFileRanges
    }

signatureMorphismToResult :: Entity DatabaseSchema.SignatureMorphism
                          -> Entity DatabaseSchema.Signature
                          -> Entity DatabaseSchema.Signature
                          -> GraphQLResultLogicMapping.LogicMapping
                          -> [GraphQLResultMapping.Mapping]
                          -> [GraphQLResultSymbolMapping.SymbolMapping]
                          -> GraphQLResultSignatureMorphism.SignatureMorphism
signatureMorphismToResult :: Entity SignatureMorphism
-> Entity Signature
-> Entity Signature
-> LogicMapping
-> [Mapping]
-> [SymbolMapping]
-> SignatureMorphism
signatureMorphismToResult (Entity signatureMorphismKey :: Key SignatureMorphism
signatureMorphismKey _) signatureSource :: Entity Signature
signatureSource
  signatureTarget :: Entity Signature
signatureTarget logicMappingResult :: LogicMapping
logicMappingResult mappingResults :: [Mapping]
mappingResults symbolMappingResults :: [SymbolMapping]
symbolMappingResults =
  SignatureMorphism :: Int
-> LogicMapping
-> [Mapping]
-> IdReference
-> [SymbolMapping]
-> IdReference
-> SignatureMorphism
GraphQLResultSignatureMorphism.SignatureMorphism
    { id :: Int
GraphQLResultSignatureMorphism.id =
        Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key SignatureMorphism -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key SignatureMorphism
signatureMorphismKey
    , logicMapping :: LogicMapping
GraphQLResultSignatureMorphism.logicMapping = LogicMapping
logicMappingResult
    , mappings :: [Mapping]
GraphQLResultSignatureMorphism.mappings = [Mapping]
mappingResults
    , source :: IdReference
GraphQLResultSignatureMorphism.source =
        Int -> IdReference
IdReference (Int -> IdReference) -> Int -> IdReference
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key Signature -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key Signature -> Int64) -> Key Signature -> Int64
forall a b. (a -> b) -> a -> b
$ Entity Signature -> Key Signature
forall record. Entity record -> Key record
entityKey Entity Signature
signatureSource
    , symbolMappings :: [SymbolMapping]
GraphQLResultSignatureMorphism.symbolMappings = [SymbolMapping]
symbolMappingResults
    , target :: IdReference
GraphQLResultSignatureMorphism.target =
        Int -> IdReference
IdReference (Int -> IdReference) -> Int -> IdReference
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Key Signature -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey (Key Signature -> Int64) -> Key Signature -> Int64
forall a b. (a -> b) -> a -> b
$ Entity Signature -> Key Signature
forall record. Entity record -> Key record
entityKey Entity Signature
signatureTarget
    }

symbolToResult :: Entity DatabaseSchema.LocIdBase
               -> Entity DatabaseSchema.Symbol
               -> Maybe (Entity DatabaseSchema.FileRange)
               -> GraphQLResultSymbol.Symbol
symbolToResult :: Entity LocIdBase
-> Entity Symbol -> Maybe (Entity FileRange) -> Symbol
symbolToResult (Entity _ locIdBaseValue :: LocIdBase
locIdBaseValue) (Entity _ symbolValue :: Symbol
symbolValue) fileRangeM :: Maybe (Entity FileRange)
fileRangeM =
  let fileRangeResult :: Maybe FileRange
fileRangeResult = (Entity FileRange -> FileRange)
-> Maybe (Entity FileRange) -> Maybe FileRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity FileRange -> FileRange
fileRangeToResult Maybe (Entity FileRange)
fileRangeM
  in  Symbol :: String
-> Maybe FileRange
-> String
-> String
-> String
-> String
-> Symbol
GraphQLResultSymbol.Symbol
        { __typename :: String
GraphQLResultSymbol.__typename = "Symbol"
        , fileRange :: Maybe FileRange
GraphQLResultSymbol.fileRange = Maybe FileRange
fileRangeResult
        , fullName :: String
GraphQLResultSymbol.fullName = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Symbol -> Text
symbolFullName Symbol
symbolValue
        , kind :: String
GraphQLResultSymbol.kind = Symbol -> String
symbolSymbolKind Symbol
symbolValue
        , locId :: String
GraphQLResultSymbol.locId = LocIdBase -> String
locIdBaseLocId LocIdBase
locIdBaseValue
        , name :: String
GraphQLResultSymbol.name = Symbol -> String
symbolName Symbol
symbolValue
        }

symbolToResultUncurried :: ( Entity DatabaseSchema.LocIdBase
                           , Entity DatabaseSchema.Symbol
                           , Maybe (Entity DatabaseSchema.FileRange)
                           ) -> GraphQLResultSymbol.Symbol
symbolToResultUncurried :: (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> Symbol
symbolToResultUncurried = (Entity LocIdBase
 -> Entity Symbol -> Maybe (Entity FileRange) -> Symbol)
-> (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> Symbol
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Entity LocIdBase
-> Entity Symbol -> Maybe (Entity FileRange) -> Symbol
symbolToResult

symbolMappingToResult :: ( Entity DatabaseSchema.LocIdBase
                         , Entity DatabaseSchema.Symbol
                         , Maybe (Entity DatabaseSchema.FileRange)
                         )
                      -> ( Entity DatabaseSchema.LocIdBase
                         , Entity DatabaseSchema.Symbol
                         , Maybe (Entity DatabaseSchema.FileRange)
                         )
                      -> GraphQLResultSymbolMapping.SymbolMapping
symbolMappingToResult :: (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> SymbolMapping
symbolMappingToResult sourceSymbolData :: (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
sourceSymbolData targetSymbolData :: (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
targetSymbolData =
  SymbolMapping :: Symbol -> Symbol -> SymbolMapping
GraphQLResultSymbolMapping.SymbolMapping
    { source :: Symbol
GraphQLResultSymbolMapping.source =
        (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> Symbol
symbolToResultUncurried (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
sourceSymbolData
    , target :: Symbol
GraphQLResultSymbolMapping.target =
        (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
-> Symbol
symbolToResultUncurried (Entity LocIdBase, Entity Symbol, Maybe (Entity FileRange))
targetSymbolData
    }

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f :: a -> b -> c -> d
f (a :: a
a, b :: b
b, c :: c
c) = a -> b -> c -> d
f a
a b
b c
c