concrete-haskell 0.1.0.8 → 0.1.0.9
raw patch · 91 files changed
+13907/−626 lines, 91 filesdep +bzlibdep +networkdep +optparse-genericdep −attoparsecdep −optparse-applicative
Dependencies added: bzlib, network, optparse-generic, path-io, zip
Dependencies removed: attoparsec, optparse-applicative
Files
- concrete-haskell.cabal +273/−119
- src/Access_Consts.hs +44/−0
- src/ActiveLearnerClientService.hs +136/−0
- src/ActiveLearnerClientService_Client.hs +65/−0
- src/ActiveLearnerClientService_Iface.hs +49/−0
- src/ActiveLearnerServerService.hs +302/−0
- src/ActiveLearnerServerService_Client.hs +97/−0
- src/ActiveLearnerServerService_Iface.hs +51/−0
- src/Annotate_Consts.hs +52/−0
- src/Audio_Consts.hs +41/−0
- src/Cluster_Consts.hs +44/−0
- src/Communication_Consts.hs +50/−0
- src/Concrete_Consts.hs +64/−0
- src/Data/Concrete.hs +68/−46
- src/Data/Concrete/Parsers.hs +72/−12
- src/Data/Concrete/Parsers/CONLL.hs +31/−57
- src/Data/Concrete/Parsers/CSV.hs +35/−59
- src/Data/Concrete/Parsers/Email.hs +6/−62
- src/Data/Concrete/Parsers/HTML.hs +5/−60
- src/Data/Concrete/Parsers/JSON.hs +40/−23
- src/Data/Concrete/Parsers/PTB.hs +80/−0
- src/Data/Concrete/Parsers/RFC2822.lhs +2889/−0
- src/Data/Concrete/Parsers/Types.hs +42/−2
- src/Data/Concrete/Parsers/Utils.hs +92/−10
- src/Data/Concrete/Parsers/XML.hs +129/−61
- src/Data/Concrete/Services/ActiveLearnerClientService.hs +136/−0
- src/Data/Concrete/Services/ActiveLearnerClientService_Client.hs +65/−0
- src/Data/Concrete/Services/ActiveLearnerClientService_Iface.hs +49/−0
- src/Data/Concrete/Services/ActiveLearnerServerService.hs +302/−0
- src/Data/Concrete/Services/ActiveLearnerServerService_Client.hs +97/−0
- src/Data/Concrete/Services/ActiveLearnerServerService_Iface.hs +51/−0
- src/Data/Concrete/Services/AnnotateCommunicationService.hs +372/−0
- src/Data/Concrete/Services/AnnotateCommunicationService_Client.hs +113/−0
- src/Data/Concrete/Services/AnnotateCommunicationService_Iface.hs +58/−0
- src/Data/Concrete/Services/FeedbackService.hs +359/−0
- src/Data/Concrete/Services/FeedbackService_Client.hs +103/−0
- src/Data/Concrete/Services/FeedbackService_Iface.hs +54/−0
- src/Data/Concrete/Services/FetchCommunicationService.hs +343/−0
- src/Data/Concrete/Services/FetchCommunicationService_Client.hs +99/−0
- src/Data/Concrete/Services/FetchCommunicationService_Iface.hs +50/−0
- src/Data/Concrete/Services/ResultsServerService.hs +945/−0
- src/Data/Concrete/Services/ResultsServerService_Client.hs +203/−0
- src/Data/Concrete/Services/ResultsServerService_Iface.hs +58/−0
- src/Data/Concrete/Services/SearchProxyService.hs +443/−0
- src/Data/Concrete/Services/SearchProxyService_Client.hs +120/−0
- src/Data/Concrete/Services/SearchProxyService_Iface.hs +55/−0
- src/Data/Concrete/Services/SearchService.hs +335/−0
- src/Data/Concrete/Services/SearchService_Client.hs +103/−0
- src/Data/Concrete/Services/SearchService_Iface.hs +54/−0
- src/Data/Concrete/Services/Service.hs +206/−0
- src/Data/Concrete/Services/Service_Client.hs +78/−0
- src/Data/Concrete/Services/Service_Iface.hs +47/−0
- src/Data/Concrete/Services/StoreCommunicationService.hs +145/−0
- src/Data/Concrete/Services/StoreCommunicationService_Client.hs +65/−0
- src/Data/Concrete/Services/StoreCommunicationService_Iface.hs +48/−0
- src/Data/Concrete/Services/SummarizationService.hs +243/−0
- src/Data/Concrete/Services/SummarizationService_Client.hs +84/−0
- src/Data/Concrete/Services/SummarizationService_Iface.hs +51/−0
- src/Data/Concrete/Utils.hs +59/−13
- src/Email_Consts.hs +41/−0
- src/Entities_Consts.hs +46/−0
- src/Ex_Consts.hs +41/−0
- src/FeedbackService.hs +359/−0
- src/FeedbackService_Client.hs +103/−0
- src/FeedbackService_Iface.hs +54/−0
- src/Language_Consts.hs +44/−0
- src/Learn_Consts.hs +45/−0
- src/Linking_Consts.hs +44/−0
- src/Metadata_Consts.hs +46/−0
- src/Nitf_Consts.hs +41/−0
- src/ResultsServerService.hs +945/−0
- src/ResultsServerService_Client.hs +203/−0
- src/ResultsServerService_Iface.hs +58/−0
- src/Results_Consts.hs +46/−0
- src/SearchProxyService.hs +443/−0
- src/SearchProxyService_Client.hs +120/−0
- src/SearchProxyService_Iface.hs +55/−0
- src/Search_Consts.hs +48/−0
- src/Services_Consts.hs +43/−0
- src/Situations_Consts.hs +46/−0
- src/Spans_Consts.hs +41/−0
- src/Structure_Consts.hs +46/−0
- src/SummarizationService.hs +243/−0
- src/SummarizationService_Client.hs +84/−0
- src/SummarizationService_Iface.hs +51/−0
- src/Summarization_Consts.hs +46/−0
- src/Twitter_Consts.hs +41/−0
- src/Uuid_Consts.hs +41/−0
- tests/UnitTests.hs +30/−0
- utils/IngestCommunications.hs +40/−74
- utils/InspectCommunication.hs +23/−28
concrete-haskell.cabal view
@@ -1,123 +1,277 @@-name: concrete-haskell-version: 0.1.0.8-synopsis: Library for the Concrete data format.-description: Library for the Concrete data format.-homepage: https://github.com/hltcoe-license: GPL-license-file: LICENSE-author: Thomas Lippincott-maintainer: tom@cs.jhu.edu-copyright: 2017-category: Data-build-type: Simple-cabal-version: >=1.10- +-- This file has been generated from package.yaml by hpack version 0.14.1.+--+-- see: https://github.com/sol/hpack++name: concrete-haskell+version: 0.1.0.9+synopsis: Library for the Concrete data format.+description: Concrete is a Thrift-based data specification designed for Natural Language Processing (NLP) applications. This library provides a Haskell interface to code generated from the latest release of Concrete. It also has a number of utilities for converting various formats (JSON, CSV, XML, etc) to Concrete Communication objects.+category: Data+homepage: https://github.com/hltcoe+author: Thomas Lippincott+maintainer: tom@cs.jhu.edu+copyright: 2017+license: GPL+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+ library- hs-source-dirs: src- exposed-modules: Data.Concrete- , Data.Concrete.Types- , Data.Concrete.Utils- , Data.Concrete.Parsers- , Data.Concrete.Parsers.Types- , Data.Concrete.Parsers.Utils- , Data.Concrete.Parsers.JSON- , Data.Concrete.Parsers.CONLL- , Data.Concrete.Parsers.Email- , Data.Concrete.Parsers.XML- , Data.Concrete.Parsers.CSV- , Data.Concrete.Parsers.HTML- other-modules: Communication_Types- , Access_Types- , Annotate_Types- , Audio_Types- , Cluster_Types- , Communication_Types- , Concrete_Types- , Email_Types- , Entities_Types- , Ex_Types- , Language_Types- , Learn_Types- , Linking_Types- , Metadata_Types- , Nitf_Types- , Results_Types- , Search_Types- , Services_Types- , Situations_Types- , Spans_Types- , Structure_Types- , Summarization_Types- , Twitter_Types- , Uuid_Types- , SearchService- , SearchService_Client- , SearchService_Iface- , Service- , Service_Client- , Service_Iface- , AnnotateCommunicationService- , AnnotateCommunicationService_Client- , AnnotateCommunicationService_Iface- , FetchCommunicationService- , FetchCommunicationService_Client- , FetchCommunicationService_Iface- , StoreCommunicationService- , StoreCommunicationService_Client- , StoreCommunicationService_Iface- build-depends: base >= 4.6 && < 5- , thrift == 0.10.0- , text- , unordered-containers- , QuickCheck- , vector- , hashable- , bytestring- , containers- , uuid- , tar- , zlib- , time- , filepath- , process- , directory- , attoparsec- , megaparsec >= 5.3.0- , scientific- , mtl- default-language: Haskell2010- default-extensions: DuplicateRecordFields, RecordWildCards- + hs-source-dirs:+ src+ default-extensions: RecordWildCards+ build-depends:+ base >=4.6 && <5+ , bytestring+ , bzlib+ , containers+ , directory+ , filepath+ , hashable+ , megaparsec >=5.3.0+ , mtl+ , network ==2.6.3.2+ , optparse-generic ==1.2.2+ , path-io ==1.2.2+ , process+ , QuickCheck+ , scientific+ , tar+ , text+ , thrift ==0.10.0+ , time+ , unordered-containers+ , uuid+ , vector+ , zip+ , zlib+ exposed-modules:+ Data.Concrete+ Data.Concrete.Services.ActiveLearnerClientService+ Data.Concrete.Services.ActiveLearnerClientService_Client+ Data.Concrete.Services.ActiveLearnerClientService_Iface+ Data.Concrete.Services.ActiveLearnerServerService+ Data.Concrete.Services.ActiveLearnerServerService_Client+ Data.Concrete.Services.ActiveLearnerServerService_Iface+ Data.Concrete.Services.AnnotateCommunicationService+ Data.Concrete.Services.AnnotateCommunicationService_Client+ Data.Concrete.Services.AnnotateCommunicationService_Iface+ Data.Concrete.Services.FeedbackService+ Data.Concrete.Services.FeedbackService_Client+ Data.Concrete.Services.FeedbackService_Iface+ Data.Concrete.Services.FetchCommunicationService+ Data.Concrete.Services.FetchCommunicationService_Client+ Data.Concrete.Services.FetchCommunicationService_Iface+ Data.Concrete.Services.ResultsServerService+ Data.Concrete.Services.ResultsServerService_Client+ Data.Concrete.Services.ResultsServerService_Iface+ Data.Concrete.Services.SearchProxyService+ Data.Concrete.Services.SearchProxyService_Client+ Data.Concrete.Services.SearchProxyService_Iface+ Data.Concrete.Services.SearchService+ Data.Concrete.Services.SearchService_Client+ Data.Concrete.Services.SearchService_Iface+ Data.Concrete.Services.Service+ Data.Concrete.Services.Service_Client+ Data.Concrete.Services.Service_Iface+ Data.Concrete.Services.StoreCommunicationService+ Data.Concrete.Services.StoreCommunicationService_Client+ Data.Concrete.Services.StoreCommunicationService_Iface+ Data.Concrete.Services.SummarizationService+ Data.Concrete.Services.SummarizationService_Client+ Data.Concrete.Services.SummarizationService_Iface+ Data.Concrete.Types+ Data.Concrete.Utils+ Data.Concrete.Parsers+ Data.Concrete.Parsers.Types+ Data.Concrete.Parsers.Utils+ Data.Concrete.Parsers.JSON+ Data.Concrete.Parsers.CONLL+ Data.Concrete.Parsers.Email+ Data.Concrete.Parsers.XML+ Data.Concrete.Parsers.CSV+ Data.Concrete.Parsers.HTML+ Data.Concrete.Parsers.PTB+ Data.Concrete.Parsers.RFC2822+ other-modules:+ Access_Consts+ Access_Types+ ActiveLearnerClientService+ ActiveLearnerClientService_Client+ ActiveLearnerClientService_Iface+ ActiveLearnerServerService+ ActiveLearnerServerService_Client+ ActiveLearnerServerService_Iface+ Annotate_Consts+ Annotate_Types+ AnnotateCommunicationService+ AnnotateCommunicationService_Client+ AnnotateCommunicationService_Iface+ Audio_Consts+ Audio_Types+ Cluster_Consts+ Cluster_Types+ Communication_Consts+ Communication_Types+ Concrete_Consts+ Concrete_Types+ Email_Consts+ Email_Types+ Entities_Consts+ Entities_Types+ Ex_Consts+ Ex_Types+ FeedbackService+ FeedbackService_Client+ FeedbackService_Iface+ FetchCommunicationService+ FetchCommunicationService_Client+ FetchCommunicationService_Iface+ Language_Consts+ Language_Types+ Learn_Consts+ Learn_Types+ Linking_Consts+ Linking_Types+ Metadata_Consts+ Metadata_Types+ Nitf_Consts+ Nitf_Types+ Results_Consts+ Results_Types+ ResultsServerService+ ResultsServerService_Client+ ResultsServerService_Iface+ Search_Consts+ Search_Types+ SearchProxyService+ SearchProxyService_Client+ SearchProxyService_Iface+ SearchService+ SearchService_Client+ SearchService_Iface+ Service+ Service_Client+ Service_Iface+ Services_Consts+ Services_Types+ Situations_Consts+ Situations_Types+ Spans_Consts+ Spans_Types+ StoreCommunicationService+ StoreCommunicationService_Client+ StoreCommunicationService_Iface+ Structure_Consts+ Structure_Types+ Summarization_Consts+ Summarization_Types+ SummarizationService+ SummarizationService_Client+ SummarizationService_Iface+ Twitter_Consts+ Twitter_Types+ Uuid_Consts+ Uuid_Types+ Paths_concrete_haskell+ default-language: Haskell2010+ executable ingest_communications- main-is: IngestCommunications.hs- hs-source-dirs: utils- build-depends: base >= 4.6 && < 5- , bytestring- , text- , concrete-haskell- , optparse-applicative- , containers- , filepath- , process- , directory- , vector- , zlib- default-language: Haskell2010- default-extensions: DuplicateRecordFields+ main-is: IngestCommunications.hs+ hs-source-dirs:+ utils+ build-depends:+ base >=4.6 && <5+ , bytestring+ , bzlib+ , containers+ , directory+ , filepath+ , hashable+ , megaparsec >=5.3.0+ , mtl+ , network ==2.6.3.2+ , optparse-generic ==1.2.2+ , path-io ==1.2.2+ , process+ , QuickCheck+ , scientific+ , tar+ , text+ , thrift ==0.10.0+ , time+ , unordered-containers+ , uuid+ , vector+ , zip+ , zlib+ , concrete-haskell+ other-modules:+ InspectCommunication+ default-language: Haskell2010 executable inspect_communications- main-is: InspectCommunication.hs- hs-source-dirs: utils- build-depends: base >= 4.6 && < 5- , bytestring- , text- , concrete-haskell- , optparse-applicative- , containers- , filepath- , process- , directory- , vector- , zlib - default-language: Haskell2010- default-extensions: DuplicateRecordFields+ main-is: InspectCommunication.hs+ hs-source-dirs:+ utils+ default-extensions: RecordWildCards+ build-depends:+ base >=4.6 && <5+ , bytestring+ , bzlib+ , containers+ , directory+ , filepath+ , hashable+ , megaparsec >=5.3.0+ , mtl+ , network ==2.6.3.2+ , optparse-generic ==1.2.2+ , path-io ==1.2.2+ , process+ , QuickCheck+ , scientific+ , tar+ , text+ , thrift ==0.10.0+ , time+ , unordered-containers+ , uuid+ , vector+ , zip+ , zlib+ , concrete-haskell+ other-modules:+ IngestCommunications+ default-language: Haskell2010++test-suite unit_tests+ type: exitcode-stdio-1.0+ main-is: tests/UnitTests.hs+ build-depends:+ base >=4.6 && <5+ , bytestring+ , bzlib+ , containers+ , directory+ , filepath+ , hashable+ , megaparsec >=5.3.0+ , mtl+ , network ==2.6.3.2+ , optparse-generic ==1.2.2+ , path-io ==1.2.2+ , process+ , QuickCheck+ , scientific+ , tar+ , text+ , thrift ==0.10.0+ , time+ , unordered-containers+ , uuid+ , vector+ , zip+ , zlib+ , concrete-haskell+ default-language: Haskell2010
+ src/Access_Consts.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Access_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import Access_Types
+ src/ActiveLearnerClientService.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerClientService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import qualified Service+import Learn_Types+import qualified ActiveLearnerClientService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data SubmitSort_args = SubmitSort_args { submitSort_args_sessionId :: Uuid_Types.UUID+ , submitSort_args_unitIds :: (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitSort_args where+ hashWithSalt salt record = salt `H.hashWithSalt` submitSort_args_sessionId record `H.hashWithSalt` submitSort_args_unitIds record +instance QC.Arbitrary SubmitSort_args where + arbitrary = M.liftM SubmitSort_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SubmitSort_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitSort_args{submitSort_args_sessionId = submitSort_args_sessionId obj} then P.Nothing else P.Just $ default_SubmitSort_args{submitSort_args_sessionId = submitSort_args_sessionId obj}+ , if obj == default_SubmitSort_args{submitSort_args_unitIds = submitSort_args_unitIds obj} then P.Nothing else P.Just $ default_SubmitSort_args{submitSort_args_unitIds = submitSort_args_unitIds obj}+ ]+from_SubmitSort_args :: SubmitSort_args -> T.ThriftVal+from_SubmitSort_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v63 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v63))) $ submitSort_args_sessionId record+ , (\_v63 -> P.Just (2, ("unitIds",T.TList (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier) $ P.map (\_v65 -> Services_Types.from_AnnotationUnitIdentifier _v65) $ Vector.toList _v63))) $ submitSort_args_unitIds record+ ]+write_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_args -> P.IO ()+write_SubmitSort_args oprot record = T.writeVal oprot $ from_SubmitSort_args record+encode_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_args -> LBS.ByteString+encode_SubmitSort_args oprot record = T.serializeVal oprot $ from_SubmitSort_args record+to_SubmitSort_args :: T.ThriftVal -> SubmitSort_args+to_SubmitSort_args (T.TStruct fields) = SubmitSort_args{+ submitSort_args_sessionId = P.maybe (submitSort_args_sessionId default_SubmitSort_args) (\(_,_val67) -> (case _val67 of {T.TStruct _val68 -> (Uuid_Types.to_UUID (T.TStruct _val68)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ submitSort_args_unitIds = P.maybe (submitSort_args_unitIds default_SubmitSort_args) (\(_,_val67) -> (case _val67 of {T.TList _ _val69 -> (Vector.fromList $ P.map (\_v70 -> (case _v70 of {T.TStruct _val71 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val71)); _ -> P.error "wrong type"})) _val69); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_SubmitSort_args _ = P.error "not a struct"+read_SubmitSort_args :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitSort_args+read_SubmitSort_args iprot = to_SubmitSort_args <$> T.readVal iprot (T.T_STRUCT typemap_SubmitSort_args)+decode_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitSort_args+decode_SubmitSort_args iprot bs = to_SubmitSort_args $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitSort_args) bs+typemap_SubmitSort_args :: T.TypeMap+typemap_SubmitSort_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("unitIds",(T.T_LIST (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier))))]+default_SubmitSort_args :: SubmitSort_args+default_SubmitSort_args = SubmitSort_args{+ submitSort_args_sessionId = Uuid_Types.default_UUID,+ submitSort_args_unitIds = Vector.empty}+data SubmitSort_result = SubmitSort_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitSort_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary SubmitSort_result where + arbitrary = QC.elements [SubmitSort_result]+from_SubmitSort_result :: SubmitSort_result -> T.ThriftVal+from_SubmitSort_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_result -> P.IO ()+write_SubmitSort_result oprot record = T.writeVal oprot $ from_SubmitSort_result record+encode_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_result -> LBS.ByteString+encode_SubmitSort_result oprot record = T.serializeVal oprot $ from_SubmitSort_result record+to_SubmitSort_result :: T.ThriftVal -> SubmitSort_result+to_SubmitSort_result (T.TStruct fields) = SubmitSort_result{++ }+to_SubmitSort_result _ = P.error "not a struct"+read_SubmitSort_result :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitSort_result+read_SubmitSort_result iprot = to_SubmitSort_result <$> T.readVal iprot (T.T_STRUCT typemap_SubmitSort_result)+decode_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitSort_result+decode_SubmitSort_result iprot bs = to_SubmitSort_result $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitSort_result) bs+typemap_SubmitSort_result :: T.TypeMap+typemap_SubmitSort_result = Map.fromList []+default_SubmitSort_result :: SubmitSort_result+default_SubmitSort_result = SubmitSort_result{+}+process_submitSort (seqid, iprot, oprot, handler) = do+ args <- read_SubmitSort_args iprot+ (X.catch+ (do+ Iface.submitSort handler (submitSort_args_sessionId args) (submitSort_args_unitIds args)+ let res = default_SubmitSort_result+ T.writeMessageBegin oprot ("submitSort", T.M_REPLY, seqid)+ write_SubmitSort_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("submitSort", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "submitSort" -> process_submitSort (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/ActiveLearnerClientService_Client.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerClientService_Client(submitSort) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types+import ActiveLearnerClientService+seqid = R.newIORef 0+submitSort (ip,op) arg_sessionId arg_unitIds = do+ send_submitSort op arg_sessionId arg_unitIds+ recv_submitSort ip+send_submitSort op arg_sessionId arg_unitIds = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("submitSort", T.M_CALL, seqn)+ write_SubmitSort_args op (SubmitSort_args{submitSort_args_sessionId=arg_sessionId,submitSort_args_unitIds=arg_unitIds})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_submitSort ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_SubmitSort_result ip+ T.readMessageEnd ip+ P.return ()
+ src/ActiveLearnerClientService_Iface.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerClientService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types++import Service_Iface+class Service_Iface a => ActiveLearnerClientService_Iface a where+ submitSort :: a -> Uuid_Types.UUID -> (Vector.Vector Services_Types.AnnotationUnitIdentifier) -> P.IO ()
+ src/ActiveLearnerServerService.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerServerService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import qualified Service+import Learn_Types+import qualified ActiveLearnerServerService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Start_args = Start_args { start_args_sessionId :: Uuid_Types.UUID+ , start_args_task :: AnnotationTask+ , start_args_contact :: Services_Types.AsyncContactInfo+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Start_args where+ hashWithSalt salt record = salt `H.hashWithSalt` start_args_sessionId record `H.hashWithSalt` start_args_task record `H.hashWithSalt` start_args_contact record +instance QC.Arbitrary Start_args where + arbitrary = M.liftM Start_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Start_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Start_args{start_args_sessionId = start_args_sessionId obj} then P.Nothing else P.Just $ default_Start_args{start_args_sessionId = start_args_sessionId obj}+ , if obj == default_Start_args{start_args_task = start_args_task obj} then P.Nothing else P.Just $ default_Start_args{start_args_task = start_args_task obj}+ , if obj == default_Start_args{start_args_contact = start_args_contact obj} then P.Nothing else P.Just $ default_Start_args{start_args_contact = start_args_contact obj}+ ]+from_Start_args :: Start_args -> T.ThriftVal+from_Start_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v22 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v22))) $ start_args_sessionId record+ , (\_v22 -> P.Just (2, ("task",from_AnnotationTask _v22))) $ start_args_task record+ , (\_v22 -> P.Just (3, ("contact",Services_Types.from_AsyncContactInfo _v22))) $ start_args_contact record+ ]+write_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> P.IO ()+write_Start_args oprot record = T.writeVal oprot $ from_Start_args record+encode_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> LBS.ByteString+encode_Start_args oprot record = T.serializeVal oprot $ from_Start_args record+to_Start_args :: T.ThriftVal -> Start_args+to_Start_args (T.TStruct fields) = Start_args{+ start_args_sessionId = P.maybe (start_args_sessionId default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val25 -> (Uuid_Types.to_UUID (T.TStruct _val25)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ start_args_task = P.maybe (start_args_task default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val26 -> (to_AnnotationTask (T.TStruct _val26)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ start_args_contact = P.maybe (start_args_contact default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val27 -> (Services_Types.to_AsyncContactInfo (T.TStruct _val27)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_Start_args _ = P.error "not a struct"+read_Start_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_args+read_Start_args iprot = to_Start_args <$> T.readVal iprot (T.T_STRUCT typemap_Start_args)+decode_Start_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_args+decode_Start_args iprot bs = to_Start_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_args) bs+typemap_Start_args :: T.TypeMap+typemap_Start_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("task",(T.T_STRUCT typemap_AnnotationTask))),(3,("contact",(T.T_STRUCT Services_Types.typemap_AsyncContactInfo)))]+default_Start_args :: Start_args+default_Start_args = Start_args{+ start_args_sessionId = Uuid_Types.default_UUID,+ start_args_task = default_AnnotationTask,+ start_args_contact = Services_Types.default_AsyncContactInfo}+data Start_result = Start_result { start_result_success :: P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Start_result where+ hashWithSalt salt record = salt `H.hashWithSalt` start_result_success record +instance QC.Arbitrary Start_result where + arbitrary = M.liftM Start_result (QC.arbitrary)+ shrink obj | obj == default_Start_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Start_result{start_result_success = start_result_success obj} then P.Nothing else P.Just $ default_Start_result{start_result_success = start_result_success obj}+ ]+from_Start_result :: Start_result -> T.ThriftVal+from_Start_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v30 -> P.Just (0, ("success",T.TBool _v30))) $ start_result_success record+ ]+write_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> P.IO ()+write_Start_result oprot record = T.writeVal oprot $ from_Start_result record+encode_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> LBS.ByteString+encode_Start_result oprot record = T.serializeVal oprot $ from_Start_result record+to_Start_result :: T.ThriftVal -> Start_result+to_Start_result (T.TStruct fields) = Start_result{+ start_result_success = P.maybe (start_result_success default_Start_result) (\(_,_val32) -> (case _val32 of {T.TBool _val33 -> _val33; _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_Start_result _ = P.error "not a struct"+read_Start_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_result+read_Start_result iprot = to_Start_result <$> T.readVal iprot (T.T_STRUCT typemap_Start_result)+decode_Start_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_result+decode_Start_result iprot bs = to_Start_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_result) bs+typemap_Start_result :: T.TypeMap+typemap_Start_result = Map.fromList [(0,("success",T.T_BOOL))]+default_Start_result :: Start_result+default_Start_result = Start_result{+ start_result_success = P.False}+data Stop_args = Stop_args { stop_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Stop_args where+ hashWithSalt salt record = salt `H.hashWithSalt` stop_args_sessionId record +instance QC.Arbitrary Stop_args where + arbitrary = M.liftM Stop_args (QC.arbitrary)+ shrink obj | obj == default_Stop_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Stop_args{stop_args_sessionId = stop_args_sessionId obj} then P.Nothing else P.Just $ default_Stop_args{stop_args_sessionId = stop_args_sessionId obj}+ ]+from_Stop_args :: Stop_args -> T.ThriftVal+from_Stop_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v36 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v36))) $ stop_args_sessionId record+ ]+write_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> P.IO ()+write_Stop_args oprot record = T.writeVal oprot $ from_Stop_args record+encode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> LBS.ByteString+encode_Stop_args oprot record = T.serializeVal oprot $ from_Stop_args record+to_Stop_args :: T.ThriftVal -> Stop_args+to_Stop_args (T.TStruct fields) = Stop_args{+ stop_args_sessionId = P.maybe (stop_args_sessionId default_Stop_args) (\(_,_val38) -> (case _val38 of {T.TStruct _val39 -> (Uuid_Types.to_UUID (T.TStruct _val39)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Stop_args _ = P.error "not a struct"+read_Stop_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_args+read_Stop_args iprot = to_Stop_args <$> T.readVal iprot (T.T_STRUCT typemap_Stop_args)+decode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_args+decode_Stop_args iprot bs = to_Stop_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_args) bs+typemap_Stop_args :: T.TypeMap+typemap_Stop_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_Stop_args :: Stop_args+default_Stop_args = Stop_args{+ stop_args_sessionId = Uuid_Types.default_UUID}+data Stop_result = Stop_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Stop_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary Stop_result where + arbitrary = QC.elements [Stop_result]+from_Stop_result :: Stop_result -> T.ThriftVal+from_Stop_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> P.IO ()+write_Stop_result oprot record = T.writeVal oprot $ from_Stop_result record+encode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> LBS.ByteString+encode_Stop_result oprot record = T.serializeVal oprot $ from_Stop_result record+to_Stop_result :: T.ThriftVal -> Stop_result+to_Stop_result (T.TStruct fields) = Stop_result{++ }+to_Stop_result _ = P.error "not a struct"+read_Stop_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_result+read_Stop_result iprot = to_Stop_result <$> T.readVal iprot (T.T_STRUCT typemap_Stop_result)+decode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_result+decode_Stop_result iprot bs = to_Stop_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_result) bs+typemap_Stop_result :: T.TypeMap+typemap_Stop_result = Map.fromList []+default_Stop_result :: Stop_result+default_Stop_result = Stop_result{+}+data AddAnnotations_args = AddAnnotations_args { addAnnotations_args_sessionId :: Uuid_Types.UUID+ , addAnnotations_args_annotations :: (Vector.Vector Annotation)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddAnnotations_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addAnnotations_args_sessionId record `H.hashWithSalt` addAnnotations_args_annotations record +instance QC.Arbitrary AddAnnotations_args where + arbitrary = M.liftM AddAnnotations_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddAnnotations_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj}+ , if obj == default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj}+ ]+from_AddAnnotations_args :: AddAnnotations_args -> T.ThriftVal+from_AddAnnotations_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v47 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v47))) $ addAnnotations_args_sessionId record+ , (\_v47 -> P.Just (2, ("annotations",T.TList (T.T_STRUCT typemap_Annotation) $ P.map (\_v49 -> from_Annotation _v49) $ Vector.toList _v47))) $ addAnnotations_args_annotations record+ ]+write_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> P.IO ()+write_AddAnnotations_args oprot record = T.writeVal oprot $ from_AddAnnotations_args record+encode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> LBS.ByteString+encode_AddAnnotations_args oprot record = T.serializeVal oprot $ from_AddAnnotations_args record+to_AddAnnotations_args :: T.ThriftVal -> AddAnnotations_args+to_AddAnnotations_args (T.TStruct fields) = AddAnnotations_args{+ addAnnotations_args_sessionId = P.maybe (addAnnotations_args_sessionId default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TStruct _val52 -> (Uuid_Types.to_UUID (T.TStruct _val52)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addAnnotations_args_annotations = P.maybe (addAnnotations_args_annotations default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TList _ _val53 -> (Vector.fromList $ P.map (\_v54 -> (case _v54 of {T.TStruct _val55 -> (to_Annotation (T.TStruct _val55)); _ -> P.error "wrong type"})) _val53); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_AddAnnotations_args _ = P.error "not a struct"+read_AddAnnotations_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_args+read_AddAnnotations_args iprot = to_AddAnnotations_args <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_args)+decode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_args+decode_AddAnnotations_args iprot bs = to_AddAnnotations_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_args) bs+typemap_AddAnnotations_args :: T.TypeMap+typemap_AddAnnotations_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("annotations",(T.T_LIST (T.T_STRUCT typemap_Annotation))))]+default_AddAnnotations_args :: AddAnnotations_args+default_AddAnnotations_args = AddAnnotations_args{+ addAnnotations_args_sessionId = Uuid_Types.default_UUID,+ addAnnotations_args_annotations = Vector.empty}+data AddAnnotations_result = AddAnnotations_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddAnnotations_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary AddAnnotations_result where + arbitrary = QC.elements [AddAnnotations_result]+from_AddAnnotations_result :: AddAnnotations_result -> T.ThriftVal+from_AddAnnotations_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> P.IO ()+write_AddAnnotations_result oprot record = T.writeVal oprot $ from_AddAnnotations_result record+encode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> LBS.ByteString+encode_AddAnnotations_result oprot record = T.serializeVal oprot $ from_AddAnnotations_result record+to_AddAnnotations_result :: T.ThriftVal -> AddAnnotations_result+to_AddAnnotations_result (T.TStruct fields) = AddAnnotations_result{++ }+to_AddAnnotations_result _ = P.error "not a struct"+read_AddAnnotations_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_result+read_AddAnnotations_result iprot = to_AddAnnotations_result <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_result)+decode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_result+decode_AddAnnotations_result iprot bs = to_AddAnnotations_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_result) bs+typemap_AddAnnotations_result :: T.TypeMap+typemap_AddAnnotations_result = Map.fromList []+default_AddAnnotations_result :: AddAnnotations_result+default_AddAnnotations_result = AddAnnotations_result{+}+process_start (seqid, iprot, oprot, handler) = do+ args <- read_Start_args iprot+ (X.catch+ (do+ val <- Iface.start handler (start_args_sessionId args) (start_args_task args) (start_args_contact args)+ let res = default_Start_result{start_result_success = val}+ T.writeMessageBegin oprot ("start", T.M_REPLY, seqid)+ write_Start_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("start", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_stop (seqid, iprot, oprot, handler) = do+ args <- read_Stop_args iprot+ (X.catch+ (do+ Iface.stop handler (stop_args_sessionId args)+ let res = default_Stop_result+ T.writeMessageBegin oprot ("stop", T.M_REPLY, seqid)+ write_Stop_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("stop", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addAnnotations (seqid, iprot, oprot, handler) = do+ args <- read_AddAnnotations_args iprot+ (X.catch+ (do+ Iface.addAnnotations handler (addAnnotations_args_sessionId args) (addAnnotations_args_annotations args)+ let res = default_AddAnnotations_result+ T.writeMessageBegin oprot ("addAnnotations", T.M_REPLY, seqid)+ write_AddAnnotations_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("addAnnotations", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "start" -> process_start (seqid,iprot,oprot,handler)+ "stop" -> process_stop (seqid,iprot,oprot,handler)+ "addAnnotations" -> process_addAnnotations (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/ActiveLearnerServerService_Client.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerServerService_Client(start,stop,addAnnotations) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types+import ActiveLearnerServerService+seqid = R.newIORef 0+start (ip,op) arg_sessionId arg_task arg_contact = do+ send_start op arg_sessionId arg_task arg_contact+ recv_start ip+send_start op arg_sessionId arg_task arg_contact = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("start", T.M_CALL, seqn)+ write_Start_args op (Start_args{start_args_sessionId=arg_sessionId,start_args_task=arg_task,start_args_contact=arg_contact})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_start ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Start_result ip+ T.readMessageEnd ip+ P.return $ start_result_success res+stop (ip,op) arg_sessionId = do+ send_stop op arg_sessionId+ recv_stop ip+send_stop op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("stop", T.M_CALL, seqn)+ write_Stop_args op (Stop_args{stop_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_stop ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Stop_result ip+ T.readMessageEnd ip+ P.return ()+addAnnotations (ip,op) arg_sessionId arg_annotations = do+ send_addAnnotations op arg_sessionId arg_annotations+ recv_addAnnotations ip+send_addAnnotations op arg_sessionId arg_annotations = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addAnnotations", T.M_CALL, seqn)+ write_AddAnnotations_args op (AddAnnotations_args{addAnnotations_args_sessionId=arg_sessionId,addAnnotations_args_annotations=arg_annotations})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addAnnotations ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddAnnotations_result ip+ T.readMessageEnd ip+ P.return ()
+ src/ActiveLearnerServerService_Iface.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ActiveLearnerServerService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types++import Service_Iface+class Service_Iface a => ActiveLearnerServerService_Iface a where+ start :: a -> Uuid_Types.UUID -> AnnotationTask -> Services_Types.AsyncContactInfo -> P.IO P.Bool+ stop :: a -> Uuid_Types.UUID -> P.IO ()+ addAnnotations :: a -> Uuid_Types.UUID -> (Vector.Vector Annotation) -> P.IO ()
+ src/Annotate_Consts.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Annotate_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Language_Types+import qualified Structure_Types+import qualified Entities_Types+import qualified Situations_Types+import qualified Ex_Types+import qualified Email_Types+import qualified Twitter_Types+import qualified Audio_Types+import qualified Communication_Types+++import Annotate_Types
+ src/Audio_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Audio_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Audio_Types
+ src/Cluster_Consts.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Cluster_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+import qualified Metadata_Types+++import Cluster_Types
+ src/Communication_Consts.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Communication_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+import qualified Language_Types+import qualified Structure_Types+import qualified Entities_Types+import qualified Situations_Types+import qualified Audio_Types+import qualified Metadata_Types+import qualified Cluster_Types+++import Communication_Types
+ src/Concrete_Consts.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Concrete_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Access_Types+import qualified Annotate_Types+import qualified Audio_Types+import qualified Cluster_Types+import qualified Communication_Types+import qualified Email_Types+import qualified Entities_Types+import qualified Ex_Types+import qualified Language_Types+import qualified Learn_Types+import qualified Linking_Types+import qualified Metadata_Types+import qualified Nitf_Types+import qualified Results_Types+import qualified Search_Types+import qualified Services_Types+import qualified Situations_Types+import qualified Spans_Types+import qualified Structure_Types+import qualified Summarization_Types+import qualified Twitter_Types+import qualified Uuid_Types+++import Concrete_Types
src/Data/Concrete.hs view
@@ -1,49 +1,71 @@ module Data.Concrete ( module Data.Concrete- , module Access_Types- , module Annotate_Types- , module Audio_Types- , module Cluster_Types- , module Communication_Types- , module Concrete_Types- , module Email_Types- , module Entities_Types- , module Ex_Types- , module Language_Types- , module Learn_Types- , module Linking_Types- , module Metadata_Types- , module Nitf_Types- , module Results_Types- , module Search_Types- , module Services_Types- , module Situations_Types- , module Spans_Types- , module Structure_Types- , module Summarization_Types- , module Twitter_Types- , module Uuid_Types+ , module Data.Concrete.Access_Types+ , module Data.Concrete.Annotate_Types+ , module Data.Concrete.Audio_Types+ , module Data.Concrete.Cluster_Types+ , module Data.Concrete.Communication_Types+ , module Data.Concrete.Concrete_Types+ , module Data.Concrete.Email_Types+ , module Data.Concrete.Entities_Types+ , module Data.Concrete.Ex_Types+ , module Data.Concrete.Language_Types+ , module Data.Concrete.Learn_Types+ , module Data.Concrete.Linking_Types+ , module Data.Concrete.Metadata_Types+ , module Data.Concrete.Nitf_Types+ , module Data.Concrete.Results_Types+ , module Data.Concrete.Search_Types+ , module Data.Concrete.Services_Types+ , module Data.Concrete.Situations_Types+ , module Data.Concrete.Spans_Types+ , module Data.Concrete.Structure_Types+ , module Data.Concrete.Summarization_Types+ , module Data.Concrete.Twitter_Types+ , module Data.Concrete.Uuid_Types ) where-import Access_Types-import Annotate_Types-import Audio_Types-import Cluster_Types-import Communication_Types-import Concrete_Types-import Email_Types-import Entities_Types-import Ex_Types-import Language_Types-import Learn_Types-import Linking_Types-import Metadata_Types-import Nitf_Types-import Results_Types-import Search_Types-import Services_Types-import Situations_Types-import Spans_Types-import Structure_Types-import Summarization_Types-import Twitter_Types-import Uuid_Types+import Access_Types as Data.Concrete.Access_Types+import Annotate_Types as Data.Concrete.Annotate_Types+import Audio_Types as Data.Concrete.Audio_Types+import Cluster_Types as Data.Concrete.Cluster_Types+import Communication_Types as Data.Concrete.Communication_Types+import Concrete_Types as Data.Concrete.Concrete_Types+import Email_Types as Data.Concrete.Email_Types+import Entities_Types as Data.Concrete.Entities_Types+import Ex_Types as Data.Concrete.Ex_Types+import Language_Types as Data.Concrete.Language_Types+import Learn_Types as Data.Concrete.Learn_Types+import Linking_Types as Data.Concrete.Linking_Types+import Metadata_Types as Data.Concrete.Metadata_Types+import Nitf_Types as Data.Concrete.Nitf_Types+import Results_Types as Data.Concrete.Results_Types+import Search_Types as Data.Concrete.Search_Types+import Services_Types as Data.Concrete.Services_Types+import Situations_Types as Data.Concrete.Situations_Types+import Spans_Types as Data.Concrete.Spans_Types+import Structure_Types as Data.Concrete.Structure_Types+import Summarization_Types as Data.Concrete.Summarization_Types+import Twitter_Types as Data.Concrete.Twitter_Types+import Uuid_Types as Data.Concrete.Uuid_Types+import qualified ActiveLearnerClientService_Client as Data.Concrete.ActiveLearnerClientService_Client+import qualified ActiveLearnerServerService_Client as Data.Concrete.ActiveLearnerServerService_Client+import qualified AnnotateCommunicationService_Client as Data.Concrete.AnnotateCommunicationService_Client+import qualified FeedbackService_Client as Data.Concrete.FeedbackService_Client+import qualified FetchCommunicationService_Client as Data.Concrete.FetchCommunicationService_Client+import qualified ResultsServerService_Client as Data.Concrete.ResultsServerService_Client+import qualified SearchProxyService_Client as Data.Concrete.SearchProxyService_Client+import qualified SearchService_Client as Data.Concrete.SearchService_Client+import qualified Service_Client as Data.Concrete.Service_Client+import qualified StoreCommunicationService_Client as Data.Concrete.StoreCommunicationService_Client+import qualified SummarizationService_Client as Data.Concrete.SummarizationService_Client+import qualified ActiveLearnerClientService_Iface as Data.Concrete.ActiveLearnerClientService_Iface+import qualified ActiveLearnerServerService_Iface as Data.Concrete.ActiveLearnerServerService_Iface+import qualified AnnotateCommunicationService_Iface as Data.Concrete.AnnotateCommunicationService_Iface+import qualified FeedbackService_Iface as Data.Concrete.FeedbackService_Iface+import qualified FetchCommunicationService_Iface as Data.Concrete.FetchCommunicationService_Iface+import qualified ResultsServerService_Iface as Data.Concrete.ResultsServerService_Iface+import qualified SearchProxyService_Iface as Data.Concrete.SearchProxyService_Iface+import qualified SearchService_Iface as Data.Concrete.SearchService_Iface+import qualified Service_Iface as Data.Concrete.Service_Iface+import qualified StoreCommunicationService_Iface as Data.Concrete.StoreCommunicationService_Iface+import qualified SummarizationService_Iface as Data.Concrete.SummarizationService_Iface
src/Data/Concrete/Parsers.hs view
@@ -37,7 +37,7 @@ import Data.Concrete.Types import Data.Concrete.Parsers.Types import Control.Monad.IO.Class (liftIO)-import Text.Megaparsec (runParserT', initialPos, State(..), unsafePos)+import Text.Megaparsec (runParserT', initialPos, State(..), unsafePos, parseErrorPretty, eof, space) import qualified Data.List.NonEmpty as NE import Data.Vector (Vector, fromList, snoc, empty) import qualified Data.Concrete.Parsers.JSON as JSON@@ -46,22 +46,82 @@ import qualified Data.Concrete.Parsers.XML as XML import qualified Data.Concrete.Parsers.CSV as CSV import qualified Data.Concrete.Parsers.Email as Email+import qualified Data.Concrete.Parsers.PTB as PTB -communicationParsers = Map.fromList [ ("JSON", ("JSON array of arbitrary objects", JSON.arrayOfObjectsP))- -- , ("CONLL", ("CONLL format", CONLL.arrayOfObjectsP))- -- , ("HTML", ("HTML format", HTML.arrayOfObjectsP))- -- , ("XML", ("XML format", XML.arrayOfObjectsP))- -- , ("CSV", ("CSV format", CSV.arrayOfObjectsP))- -- , ("Email", ("Email format", Email.arrayOfObjectsP)) - ]+communicationParsers = [( "JSON"+ , ( "JSON array of arbitrary objects"+ , JSON.parser+ , [ "catchphrase"+ , "relatives.0.name"+ ]+ , "id_${name}"+ )+ )+ , ( "JSON-LINES"+ , ( "One JSON object per line"+ , JSON.lineParser+ , [ "catchphrase"+ , "relatives.0.name"+ ]+ , "id_${name}"+ )+ )+ , ( "CSV"+ , ( "CSV format (with header, commas)"+ , CSV.parser True ','+ , [ "technology"+ , "Bush"+ , "Gore"+ ]+ , "id_${county}"+ )+ )+ , ( "PTB"+ , ( "PENN Treebank format"+ , PTB.parser+ , []+ , "id_${}"+ )+ )+ , ("CONLL-U"+ , ( "CONLL-U format"+ , CONLL.parser CONLL.ufields+ , []+ , "id_${}"+ )+ )+ , ("HTML"+ , ("HTML format"+ , HTML.parser+ , []+ , "id_${}"+ )+ )+ , ("XML"+ , ("XML format"+ , XML.parser+ , []+ , "id_${}"+ )+ )+ , ("Email"+ , ("Email format"+ , Email.parser+ , []+ , "id_${}"+ )+ )+ ] ingest :: CommunicationAction -> CommunicationParser a -> Text -> [String] -> String -> String -> IO ()-ingest a p t cs i ct= do+ingest a p t cs i ct = do let s = State { stateInput=t- , statePos=NE.fromList $ [initialPos "JSON"]+ , statePos=NE.fromList $ [initialPos "Text File"] , stateTokensProcessed=0 , stateTabWidth=unsafePos 8 }- runStateT (runParserT' p s) (Bookkeeper (default_Communication { communication_sectionList=Just empty }) Map.empty [] [] a cs (pack i) ct)- return ()+ ((_, e), _) <- runStateT (runParserT' (space >> p >> space >> eof) s) (Bookkeeper (default_Communication { communication_sectionList=Just empty }) Map.empty [] [] a cs (pack i) ct 0)+ case e of+ Left x -> putStrLn $ parseErrorPretty x+ _ -> return ()
src/Data/Concrete/Parsers/CONLL.hs view
@@ -1,13 +1,15 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-} module Data.Concrete.Parsers.CONLL- ( arrayOfObjectsP+ ( parser+ , xfields+ , ufields ) where import Data.List (intercalate) import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser) import Data.Concrete.Parsers.Utils (communicationRule) import Data.Scientific (scientific, Scientific(..))-import Data.Text.Lazy (pack, Text)+import Data.Text.Lazy (pack, unpack, Text) import Data.Functor (($>)) import qualified Data.Map as Map import Data.Map (Map)@@ -33,6 +35,15 @@ , runParserT' , State(..) , getParserState+ , eol+ , tab+ , newline+ , sepBy1+ , many+ , noneOf+ , eof+ , separatorChar+ , someTill ) import Text.Megaparsec.Text.Lazy (Parser)@@ -40,67 +51,30 @@ import qualified Control.Monad.State as S import qualified Control.Monad.Identity as I import Data.Concrete.Types-import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)- -arrayOfObjectsP :: ParsecT Dec Text (S.StateT Bookkeeper IO) ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()--jsonP = sectionRule id jsonP'+import Data.Concrete.Parsers.Utils (communicationRule, sectionRule, pushPathComponent, popPathComponent) -jsonP' = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- -nullP = symbol' "null" >> return ()- -boolP = (symbol' "true" <|> symbol' "false") >> return ()- -numberP = signed space number >> return ()+ufields = ["ID", "FORM", "LEMMA", "UPOSTAG", "XPOSTAG", "FEATS", "HEAD", "DEPREL", "DEPS", "MISC"] :: [Text]+xfields = ["ID", "FORM", "LEMMA", "PLEMMA", "POS", "PPOS", "FEAT", "PFEAT", "HEAD", "PHEAD", "DEPREL", "PDEPREL"] :: [Text] -stringP = pack <$> stringLiteral >> return ()+parser :: [Text] -> CommunicationParser ()+parser fs = (communicationRule id (sentence fs)) `sepBy1` sentenceBreak >> return () -objectP = Map.fromList <$> braces (pairP `sepBy` comma) >> return ()+sentence fs = (some (commentLine <|> wordLine fs)) >> return () -arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.put $ bs { path=(show (p + 1)):(tail path) } - jsonP- return ()+commentLine = (char '#') >> (manyTill anyChar newline) -escapedChar = do- char '\\'- choice [ char '\"' $> '\"'- , char '\\' $> '\\'- , char '/' $> '/'- , char 'n' $> '\n'- , char 'r' $> '\r'- , char 'f' $> '\f'- , char 't' $> '\t'- , char 'b' $> '\b'- , unicodeEscape- ]--unicodeEscape = char 'u' >> count 4 hexDigitChar >>= (\code -> return $ toEnum (read ("0x" ++ code)))--stringLiteral = lexeme' $ do - char '\"'- (escapedChar <|> anyChar) `manyTill` char '\"'+wordLine fs = (row fs) >> return [] -arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })- c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})+row fs = do+ ls <- mapM (\n -> namedEntry n >> char '\t') (init fs)+ s <- namedEntry (last fs)+ newline return () -pairP = do- key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })- symbol' ":"- value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return (key, value)+namedEntry f = do+ pushPathComponent (unpack f)+ t <- sectionRule id $ pack <$> (some (noneOf ['\t', '\n']))+ popPathComponent+ return t -lexeme' = lexeme space-symbol' = symbol space-brackets = between (symbol' "[") (symbol' "]")-braces = between (symbol' "{") (symbol' "}")-comma = symbol' ","+sentenceBreak = newline
src/Data/Concrete/Parsers/CSV.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-} module Data.Concrete.Parsers.CSV- ( arrayOfObjectsP+ ( parser ) where import Data.List (intercalate) import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser) import Data.Concrete.Parsers.Utils (communicationRule) import Data.Scientific (scientific, Scientific(..))-import Data.Text.Lazy (pack, Text)+import Data.Text.Lazy (pack, unpack, Text)+import qualified Data.Text.Lazy as T import Data.Functor (($>)) import qualified Data.Map as Map import Data.Map (Map)@@ -27,12 +28,19 @@ , char , choice , sepBy+ , sepBy1+ , sepEndBy , between , match+ , newline , ParsecT , runParserT' , State(..) , getParserState+ , eol+ , noneOf+ , eof+ , many ) import Text.Megaparsec.Text.Lazy (Parser)@@ -40,67 +48,35 @@ import qualified Control.Monad.State as S import qualified Control.Monad.Identity as I import Data.Concrete.Types-import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)- -arrayOfObjectsP :: ParsecT Dec Text (S.StateT Bookkeeper IO) ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()--jsonP = sectionRule id jsonP'--jsonP' = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- -nullP = symbol' "null" >> return ()- -boolP = (symbol' "true" <|> symbol' "false") >> return ()- -numberP = signed space number >> return ()--stringP = pack <$> stringLiteral >> return ()--objectP = Map.fromList <$> braces (pairP `sepBy` comma) >> return ()+import Data.Concrete.Parsers.Utils (communicationRule, sectionRule, pushPathComponent, popPathComponent) -arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.put $ bs { path=(show (p + 1)):(tail path) } - jsonP+parser :: Bool -> Char -> CommunicationParser ()+parser h d = do+ fs <- if h == True then header d else return []+ space+ withFields fs d+ space+ eof return ()++withFields :: [Text] -> Char -> CommunicationParser ()+withFields fs d = (communicationRule id (row d fs)) `sepEndBy` (newline) >> return () -escapedChar = do- char '\\'- choice [ char '\"' $> '\"'- , char '\\' $> '\\'- , char '/' $> '/'- , char 'n' $> '\n'- , char 'r' $> '\r'- , char 'f' $> '\f'- , char 't' $> '\t'- , char 'b' $> '\b'- , unicodeEscape- ]+header :: Char -> CommunicationParser [Text]+header d = (entry d) `sepBy1` (char d) -unicodeEscape = char 'u' >> count 4 hexDigitChar >>= (\code -> return $ toEnum (read ("0x" ++ code)))+entry :: Char -> CommunicationParser Text+entry d = pack <$> (many (noneOf [d, '\n'])) -stringLiteral = lexeme' $ do - char '\"'- (escapedChar <|> anyChar) `manyTill` char '\"'+namedEntry :: Text -> Char -> CommunicationParser Text+namedEntry f d = do+ pushPathComponent (unpack f)+ t <- sectionRule id $ pack <$> (many (noneOf [d, '\n']))+ popPathComponent+ return t -arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })- c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})+row :: Char -> [Text] -> CommunicationParser ()+row d fs = do+ ls <- mapM (\n -> namedEntry n d >> char d) (init fs)+ s <- namedEntry (last fs) d return ()--pairP = do- key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })- symbol' ":"- value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return (key, value)--lexeme' = lexeme space-symbol' = symbol space-brackets = between (symbol' "[") (symbol' "]")-braces = between (symbol' "{") (symbol' "}")-comma = symbol' ","
src/Data/Concrete/Parsers/Email.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-} module Data.Concrete.Parsers.Email- ( arrayOfObjectsP+ ( parser ) where import Data.List (intercalate)@@ -33,6 +33,7 @@ , runParserT' , State(..) , getParserState+ , many ) import Text.Megaparsec.Text.Lazy (Parser)@@ -41,66 +42,9 @@ import qualified Control.Monad.Identity as I import Data.Concrete.Types import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)- -arrayOfObjectsP :: ParsecT Dec Text (S.StateT Bookkeeper IO) ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()--jsonP = sectionRule id jsonP'--jsonP' = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- -nullP = symbol' "null" >> return ()- -boolP = (symbol' "true" <|> symbol' "false") >> return ()- -numberP = signed space number >> return ()--stringP = pack <$> stringLiteral >> return ()--objectP = Map.fromList <$> braces (pairP `sepBy` comma) >> return ()--arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.put $ bs { path=(show (p + 1)):(tail path) } - jsonP- return ()- -escapedChar = do- char '\\'- choice [ char '\"' $> '\"'- , char '\\' $> '\\'- , char '/' $> '/'- , char 'n' $> '\n'- , char 'r' $> '\r'- , char 'f' $> '\f'- , char 't' $> '\t'- , char 'b' $> '\b'- , unicodeEscape- ]--unicodeEscape = char 'u' >> count 4 hexDigitChar >>= (\code -> return $ toEnum (read ("0x" ++ code)))--stringLiteral = lexeme' $ do - char '\"'- (escapedChar <|> anyChar) `manyTill` char '\"'--arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })- c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return ()+import qualified Data.Concrete.Parsers.RFC2822 as R -pairP = do- key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })- symbol' ":"- value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return (key, value)+parser :: CommunicationParser ()+parser = email >> return () -lexeme' = lexeme space-symbol' = symbol space-brackets = between (symbol' "[") (symbol' "]")-braces = between (symbol' "{") (symbol' "}")-comma = symbol' ","+email = many anyChar
src/Data/Concrete/Parsers/HTML.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Data.Concrete.Parsers.HTML- ( arrayOfObjectsP+ ( parser ) where import Data.Maybe (fromJust)@@ -34,6 +34,7 @@ , runParserT' , State(..) , getParserState+ , many ) import Text.Megaparsec.Text.Lazy (Parser)@@ -43,63 +44,7 @@ import Data.Concrete.Types import Data.Concrete.Parsers.Utils (communicationRule, sectionRule) -arrayOfObjectsP :: CommunicationParser ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()--jsonP = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- -nullP = sectionRule id $ symbol' "null" >> return ()- -boolP = sectionRule id $ (symbol' "true" <|> symbol' "false") >> return ()- -numberP = sectionRule id $ signed space number >> return ()--stringP = sectionRule (adjustTextSpan 1 (-1)) $ pack <$> stringLiteral >> return ()--escapedChar = do- char '\\'- choice [ char '\"' $> '\"'- , char '\\' $> '\\'- , char '/' $> '/'- , char 'n' $> '\n'- , char 'r' $> '\r'- , char 'f' $> '\f'- , char 't' $> '\t'- , char 'b' $> '\b'- , unicodeEscape- ]--unicodeEscape = char 'u' >> count 4 hexDigitChar >>= (\code -> return $ toEnum (read ("0x" ++ code)))--stringLiteral = lexeme' $ do - char '\"'- (escapedChar <|> anyChar) `manyTill` char '\"'--arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.modify' (\ bs -> bs { path=(show (p + 1)):(tail path) } )- jsonP- return ()--arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })- c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return ()--pairP = do- key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })- symbol' ":"- value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return (key, value)--objectP = sectionRule id $ Map.fromList <$> braces (pairP `sepBy` comma) >> return ()+parser :: CommunicationParser ()+parser = html >> return () -lexeme' = lexeme space-symbol' = symbol space-brackets = between (symbol' "[") (symbol' "]")-braces = between (symbol' "{") (symbol' "}")-comma = symbol' ","+html = many anyChar
src/Data/Concrete/Parsers/JSON.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Data.Concrete.Parsers.JSON- ( arrayOfObjectsP+ ( parser+ , lineParser ) where +import Control.Monad.State (State, get, put, modify, modify') import Data.Maybe (fromJust) import Data.List (intercalate)-import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)-import Data.Concrete.Parsers.Utils (communicationRule, Located(..)) import Data.Scientific (scientific, Scientific(..)) import Data.Text.Lazy (pack, Text) import Data.Functor (($>))@@ -18,6 +18,7 @@ import Text.Megaparsec.Error (Dec) import Text.Megaparsec ( parseErrorPretty , (<|>)+ , eol , space , hexDigitChar , count@@ -34,28 +35,49 @@ , runParserT' , State(..) , getParserState+ , eof+ , many )-+import Control.Monad.IO.Class (liftIO) import Text.Megaparsec.Text.Lazy (Parser)-import Data.Concrete (default_Communication, Communication(..), Section(..), TextSpan(..)) import qualified Control.Monad.State as S import qualified Control.Monad.Identity as I-import Data.Concrete.Types-import Data.Concrete.Parsers.Utils (communicationRule, sectionRule) -arrayOfObjectsP :: CommunicationParser ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()+import Data.Concrete (default_Communication, Communication(..), Section(..), TextSpan(..))+import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)+import Data.Concrete.Parsers.Utils ( communicationRule+ , sectionRule+ , pathArrayRule+ , pathArrayEntryRule+ , pathDictionaryRule+ , pathDictionaryKeyRule+ , Located(..)+ , pushPathComponent+ , popPathComponent+ , modifyPathComponent+ , incrementPathComponent+ ) +parser :: CommunicationParser ()+parser = brackets ((communicationRule id objectP) `sepBy` comma) >> return ()++lineParser :: CommunicationParser ()+lineParser = (many (communicationRule id objectP)) >> return ()+ jsonP = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- + nullP = sectionRule id $ symbol' "null" >> return ()- + boolP = sectionRule id $ (symbol' "true" <|> symbol' "false") >> return ()- + numberP = sectionRule id $ signed space number >> return () -stringP = sectionRule (adjustTextSpan 1 (-1)) $ pack <$> stringLiteral >> return ()+stringP = stringPLiteral >> return () +stringPLiteral = lexeme' $ do + char '\"'+ sectionRule (adjustTextSpan 0 (-1)) ((escapedChar <|> anyChar) `manyTill` char '\"')+ escapedChar = do char '\\' choice [ char '\"' $> '\"'@@ -75,25 +97,20 @@ char '\"' (escapedChar <|> anyChar) `manyTill` char '\"' -arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.modify' (\ bs -> bs { path=(show (p + 1)):(tail path) } )+arrayEntryP = pathArrayEntryRule $ do jsonP return () -arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })+arrayP = pathArrayRule $ do c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path}) return () pairP = do key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })+ pushPathComponent key symbol' ":" value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})+ c <- popPathComponent return (key, value) objectP = sectionRule id $ Map.fromList <$> braces (pairP `sepBy` comma) >> return ()
+ src/Data/Concrete/Parsers/PTB.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-}+module Data.Concrete.Parsers.PTB+ ( parser+ ) where++import Data.Char (isSpace)+import Data.List (intercalate)+import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)+import Data.Concrete.Parsers.Utils (communicationRule)+import Data.Scientific (scientific, Scientific(..))+import Data.Text.Lazy (pack, Text)+import Data.Functor (($>))+import qualified Data.Map as Map+import Data.Map (Map)+import Data.List.NonEmpty (fromList)+import Text.Megaparsec.Lexer (symbol, lexeme, signed, number)+import Text.Megaparsec.Pos (initialPos, defaultTabWidth)+import Text.Megaparsec.Error (Dec)+import Text.Megaparsec.Lexer (symbol, lexeme, signed, number)+import Text.Megaparsec ( parseErrorPretty+ , (<|>)+ , satisfy+ , space+ , hexDigitChar+ , count+ , manyTill+ , anyChar+ , runParser+ , some+ , char+ , choice+ , sepBy+ , between+ , match+ , ParsecT+ , runParserT'+ , State(..)+ , getParserState+ , spaceChar+ , eof+ , noneOf+ , try+ )++import Control.Monad.IO.Class (liftIO) +import Text.Megaparsec.Text.Lazy (Parser)+import Data.Concrete (default_Communication, Communication(..))+import qualified Control.Monad.State as S+import qualified Control.Monad.Identity as I+import Data.Concrete.Types+import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)++parser :: CommunicationParser ()+parser = do+ space+ some document+ space+ eof+ return ()++type CS = CommunicationParser String+type CSS = CommunicationParser [String]+type CC = CommunicationParser Char++document :: CommunicationParser ()+document = lexeme' $ communicationRule id (parens (some sentence)) >> return ()++sentence = lexeme' $ between (symbol' "(S") (symbol' ")") (some phrase)++phrase = lexeme' $ parens (tag >> some (tag <|> phrase)) >> return []++tag = lexicalItem++lexicalItem = lexeme' $ some notSpaceOrParen++notSpaceOrParen = satisfy (\c -> and [(not . isSpace) c, ('(' /= c), (')' /= c)])++lexeme' = lexeme space+symbol' = symbol space+parens = between (symbol' "(") (symbol' ")")
+ src/Data/Concrete/Parsers/RFC2822.lhs view
@@ -0,0 +1,2889 @@+{-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-}++> module Data.Concrete.Parsers.RFC2822+> (+> ) where++import Data.List (intercalate)+import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)+import Data.Concrete.Parsers.Utils (communicationRule)+import Data.Scientific (scientific, Scientific(..))+import Data.Text.Lazy (pack, Text)+import Data.Functor (($>))+import qualified Data.Map as Map+import Data.Map (Map)+import Data.List.NonEmpty (fromList)+import Text.Megaparsec.Lexer (symbol, lexeme, signed, number)+import Text.Megaparsec.Pos (initialPos, defaultTabWidth)+import Text.Megaparsec.Error (Dec)+import Text.Megaparsec ( parseErrorPretty+ , (<|>)+ , space+ , hexDigitChar+ , count+ , manyTill+ , anyChar+ , runParser+ , some+ , char+ , choice+ , sepBy+ , between+ , match+ , ParsecT+ , runParserT'+ , State(..)+ , getParserState+ , many+ )++import Text.Megaparsec.Text.Lazy (Parser)+import Data.Concrete (default_Communication, Communication(..))+import qualified Control.Monad.State as S+import qualified Control.Monad.Identity as I+import Data.Concrete.Types+import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)++parser :: CommunicationParser ()+parser = email >> return ()++email = many anyChar+++++Network Working Group P. Resnick, Editor+Request for Comments: 2822 QUALCOMM Incorporated+Obsoletes: 822 April 2001+Category: Standards Track+++ Internet Message Format++Status of this Memo++ This document specifies an Internet standards track protocol for the+ Internet community, and requests discussion and suggestions for+ improvements. Please refer to the current edition of the "Internet+ Official Protocol Standards" (STD 1) for the standardization state+ and status of this protocol. Distribution of this memo is unlimited.++Copyright Notice++ Copyright (C) The Internet Society (2001). All Rights Reserved.++Abstract++ This standard specifies a syntax for text messages that are sent+ between computer users, within the framework of "electronic mail"+ messages. This standard supersedes the one specified in Request For+ Comments (RFC) 822, "Standard for the Format of ARPA Internet Text+ Messages", updating it to reflect current practice and incorporating+ incremental changes that were specified in other RFCs.++Table of Contents++ 1. Introduction ............................................... 3+ 1.1. Scope .................................................... 3+ 1.2. Notational conventions ................................... 4+ 1.2.1. Requirements notation .................................. 4+ 1.2.2. Syntactic notation ..................................... 4+ 1.3. Structure of this document ............................... 4+ 2. Lexical Analysis of Messages ............................... 5+ 2.1. General Description ...................................... 5+ 2.1.1. Line Length Limits ..................................... 6+ 2.2. Header Fields ............................................ 7+ 2.2.1. Unstructured Header Field Bodies ....................... 7+ 2.2.2. Structured Header Field Bodies ......................... 7+ 2.2.3. Long Header Fields ..................................... 7+ 2.3. Body ..................................................... 8+ 3. Syntax ..................................................... 9+ 3.1. Introduction ............................................. 9+ 3.2. Lexical Tokens ........................................... 9++++Resnick Standards Track [Page 1]++RFC 2822 Internet Message Format April 2001+++ 3.2.1. Primitive Tokens ....................................... 9+ 3.2.2. Quoted characters ......................................10+ 3.2.3. Folding white space and comments .......................11+ 3.2.4. Atom ...................................................12+ 3.2.5. Quoted strings .........................................13+ 3.2.6. Miscellaneous tokens ...................................13+ 3.3. Date and Time Specification ..............................14+ 3.4. Address Specification ....................................15+ 3.4.1. Addr-spec specification ................................16+ 3.5 Overall message syntax ....................................17+ 3.6. Field definitions ........................................18+ 3.6.1. The origination date field .............................20+ 3.6.2. Originator fields ......................................21+ 3.6.3. Destination address fields .............................22+ 3.6.4. Identification fields ..................................23+ 3.6.5. Informational fields ...................................26+ 3.6.6. Resent fields ..........................................26+ 3.6.7. Trace fields ...........................................28+ 3.6.8. Optional fields ........................................29+ 4. Obsolete Syntax ............................................29+ 4.1. Miscellaneous obsolete tokens ............................30+ 4.2. Obsolete folding white space .............................31+ 4.3. Obsolete Date and Time ...................................31+ 4.4. Obsolete Addressing ......................................33+ 4.5. Obsolete header fields ...................................33+ 4.5.1. Obsolete origination date field ........................34+ 4.5.2. Obsolete originator fields .............................34+ 4.5.3. Obsolete destination address fields ....................34+ 4.5.4. Obsolete identification fields .........................35+ 4.5.5. Obsolete informational fields ..........................35+ 4.5.6. Obsolete resent fields .................................35+ 4.5.7. Obsolete trace fields ..................................36+ 4.5.8. Obsolete optional fields ...............................36+ 5. Security Considerations ....................................36+ 6. Bibliography ...............................................37+ 7. Editor's Address ...........................................38+ 8. Acknowledgements ...........................................39+ Appendix A. Example messages ..................................41+ A.1. Addressing examples ......................................41+ A.1.1. A message from one person to another with simple+ addressing .............................................41+ A.1.2. Different types of mailboxes ...........................42+ A.1.3. Group addresses ........................................43+ A.2. Reply messages ...........................................43+ A.3. Resent messages ..........................................44+ A.4. Messages with trace fields ...............................46+ A.5. White space, comments, and other oddities ................47+ A.6. Obsoleted forms ..........................................47++++Resnick Standards Track [Page 2]++RFC 2822 Internet Message Format April 2001+++ A.6.1. Obsolete addressing ....................................48+ A.6.2. Obsolete dates .........................................48+ A.6.3. Obsolete white space and comments ......................48+ Appendix B. Differences from earlier standards ................49+ Appendix C. Notices ...........................................50+ Full Copyright Statement ......................................51++1. Introduction++1.1. Scope++ This standard specifies a syntax for text messages that are sent+ between computer users, within the framework of "electronic mail"+ messages. This standard supersedes the one specified in Request For+ Comments (RFC) 822, "Standard for the Format of ARPA Internet Text+ Messages" [RFC822], updating it to reflect current practice and+ incorporating incremental changes that were specified in other RFCs+ [STD3].++ This standard specifies a syntax only for text messages. In+ particular, it makes no provision for the transmission of images,+ audio, or other sorts of structured data in electronic mail messages.+ There are several extensions published, such as the MIME document+ series [RFC2045, RFC2046, RFC2049], which describe mechanisms for the+ transmission of such data through electronic mail, either by+ extending the syntax provided here or by structuring such messages to+ conform to this syntax. Those mechanisms are outside of the scope of+ this standard.++ In the context of electronic mail, messages are viewed as having an+ envelope and contents. The envelope contains whatever information is+ needed to accomplish transmission and delivery. (See [RFC2821] for a+ discussion of the envelope.) The contents comprise the object to be+ delivered to the recipient. This standard applies only to the format+ and some of the semantics of message contents. It contains no+ specification of the information in the envelope.++ However, some message systems may use information from the contents+ to create the envelope. It is intended that this standard facilitate+ the acquisition of such information by programs.++ This specification is intended as a definition of what message+ content format is to be passed between systems. Though some message+ systems locally store messages in this format (which eliminates the+ need for translation between formats) and others use formats that+ differ from the one specified in this standard, local storage is+ outside of the scope of this standard.+++++Resnick Standards Track [Page 3]++RFC 2822 Internet Message Format April 2001+++ Note: This standard is not intended to dictate the internal formats+ used by sites, the specific message system features that they are+ expected to support, or any of the characteristics of user interface+ programs that create or read messages. In addition, this standard+ does not specify an encoding of the characters for either transport+ or storage; that is, it does not specify the number of bits used or+ how those bits are specifically transferred over the wire or stored+ on disk.++1.2. Notational conventions++1.2.1. Requirements notation++ This document occasionally uses terms that appear in capital letters.+ When the terms "MUST", "SHOULD", "RECOMMENDED", "MUST NOT", "SHOULD+ NOT", and "MAY" appear capitalized, they are being used to indicate+ particular requirements of this specification. A discussion of the+ meanings of these terms appears in [RFC2119].++1.2.2. Syntactic notation++ This standard uses the Augmented Backus-Naur Form (ABNF) notation+ specified in [RFC2234] for the formal definitions of the syntax of+ messages. Characters will be specified either by a decimal value+ (e.g., the value %d65 for uppercase A and %d97 for lowercase A) or by+ a case-insensitive literal value enclosed in quotation marks (e.g.,+ "A" for either uppercase or lowercase A). See [RFC2234] for the full+ description of the notation.++1.3. Structure of this document++ This document is divided into several sections.++ This section, section 1, is a short introduction to the document.++ Section 2 lays out the general description of a message and its+ constituent parts. This is an overview to help the reader understand+ some of the general principles used in the later portions of this+ document. Any examples in this section MUST NOT be taken as+ specification of the formal syntax of any part of a message.++ Section 3 specifies formal ABNF rules for the structure of each part+ of a message (the syntax) and describes the relationship between+ those parts and their meaning in the context of a message (the+ semantics). That is, it describes the actual rules for the structure+ of each part of a message (the syntax) as well as a description of+ the parts and instructions on how they ought to be interpreted (the+ semantics). This includes analysis of the syntax and semantics of++++Resnick Standards Track [Page 4]++RFC 2822 Internet Message Format April 2001+++ subparts of messages that have specific structure. The syntax+ included in section 3 represents messages as they MUST be created.+ There are also notes in section 3 to indicate if any of the options+ specified in the syntax SHOULD be used over any of the others.++ Both sections 2 and 3 describe messages that are legal to generate+ for purposes of this standard.++ Section 4 of this document specifies an "obsolete" syntax. There are+ references in section 3 to these obsolete syntactic elements. The+ rules of the obsolete syntax are elements that have appeared in+ earlier revisions of this standard or have previously been widely+ used in Internet messages. As such, these elements MUST be+ interpreted by parsers of messages in order to be conformant to this+ standard. However, since items in this syntax have been determined+ to be non-interoperable or to cause significant problems for+ recipients of messages, they MUST NOT be generated by creators of+ conformant messages.++ Section 5 details security considerations to take into account when+ implementing this standard.++ Section 6 is a bibliography of references in this document.++ Section 7 contains the editor's address.++ Section 8 contains acknowledgements.++ Appendix A lists examples of different sorts of messages. These+ examples are not exhaustive of the types of messages that appear on+ the Internet, but give a broad overview of certain syntactic forms.++ Appendix B lists the differences between this standard and earlier+ standards for Internet messages.++ Appendix C has copyright and intellectual property notices.++2. Lexical Analysis of Messages++2.1. General Description++ At the most basic level, a message is a series of characters. A+ message that is conformant with this standard is comprised of+ characters with values in the range 1 through 127 and interpreted as+ US-ASCII characters [ASCII]. For brevity, this document sometimes+ refers to this range of characters as simply "US-ASCII characters".++++++Resnick Standards Track [Page 5]++RFC 2822 Internet Message Format April 2001+++ Note: This standard specifies that messages are made up of characters+ in the US-ASCII range of 1 through 127. There are other documents,+ specifically the MIME document series [RFC2045, RFC2046, RFC2047,+ RFC2048, RFC2049], that extend this standard to allow for values+ outside of that range. Discussion of those mechanisms is not within+ the scope of this standard.++ Messages are divided into lines of characters. A line is a series of+ characters that is delimited with the two characters carriage-return+ and line-feed; that is, the carriage return (CR) character (ASCII+ value 13) followed immediately by the line feed (LF) character (ASCII+ value 10). (The carriage-return/line-feed pair is usually written in+ this document as "CRLF".)++ A message consists of header fields (collectively called "the header+ of the message") followed, optionally, by a body. The header is a+ sequence of lines of characters with special syntax as defined in+ this standard. The body is simply a sequence of characters that+ follows the header and is separated from the header by an empty line+ (i.e., a line with nothing preceding the CRLF).++2.1.1. Line Length Limits++ There are two limits that this standard places on the number of+ characters in a line. Each line of characters MUST be no more than+ 998 characters, and SHOULD be no more than 78 characters, excluding+ the CRLF.++ The 998 character limit is due to limitations in many implementations+ which send, receive, or store Internet Message Format messages that+ simply cannot handle more than 998 characters on a line. Receiving+ implementations would do well to handle an arbitrarily large number+ of characters in a line for robustness sake. However, there are so+ many implementations which (in compliance with the transport+ requirements of [RFC2821]) do not accept messages containing more+ than 1000 character including the CR and LF per line, it is important+ for implementations not to create such messages.++ The more conservative 78 character recommendation is to accommodate+ the many implementations of user interfaces that display these+ messages which may truncate, or disastrously wrap, the display of+ more than 78 characters per line, in spite of the fact that such+ implementations are non-conformant to the intent of this+ specification (and that of [RFC2821] if they actually cause+ information to be lost). Again, even though this limitation is put on+ messages, it is encumbant upon implementations which display messages++++++Resnick Standards Track [Page 6]++RFC 2822 Internet Message Format April 2001+++ to handle an arbitrarily large number of characters in a line+ (certainly at least up to the 998 character limit) for the sake of+ robustness.++2.2. Header Fields++ Header fields are lines composed of a field name, followed by a colon+ (":"), followed by a field body, and terminated by CRLF. A field+ name MUST be composed of printable US-ASCII characters (i.e.,+ characters that have values between 33 and 126, inclusive), except+ colon. A field body may be composed of any US-ASCII characters,+ except for CR and LF. However, a field body may contain CRLF when+ used in header "folding" and "unfolding" as described in section+ 2.2.3. All field bodies MUST conform to the syntax described in+ sections 3 and 4 of this standard.++2.2.1. Unstructured Header Field Bodies++ Some field bodies in this standard are defined simply as+ "unstructured" (which is specified below as any US-ASCII characters,+ except for CR and LF) with no further restrictions. These are+ referred to as unstructured field bodies. Semantically, unstructured+ field bodies are simply to be treated as a single line of characters+ with no further processing (except for header "folding" and+ "unfolding" as described in section 2.2.3).++2.2.2. Structured Header Field Bodies++ Some field bodies in this standard have specific syntactical+ structure more restrictive than the unstructured field bodies+ described above. These are referred to as "structured" field bodies.+ Structured field bodies are sequences of specific lexical tokens as+ described in sections 3 and 4 of this standard. Many of these tokens+ are allowed (according to their syntax) to be introduced or end with+ comments (as described in section 3.2.3) as well as the space (SP,+ ASCII value 32) and horizontal tab (HTAB, ASCII value 9) characters+ (together known as the white space characters, WSP), and those WSP+ characters are subject to header "folding" and "unfolding" as+ described in section 2.2.3. Semantic analysis of structured field+ bodies is given along with their syntax.++2.2.3. Long Header Fields++ Each header field is logically a single line of characters comprising+ the field name, the colon, and the field body. For convenience+ however, and to deal with the 998/78 character limitations per line,+ the field body portion of a header field can be split into a multiple+ line representation; this is called "folding". The general rule is++++Resnick Standards Track [Page 7]++RFC 2822 Internet Message Format April 2001+++ that wherever this standard allows for folding white space (not+ simply WSP characters), a CRLF may be inserted before any WSP. For+ example, the header field:++ Subject: This is a test++ can be represented as:++ Subject: This+ is a test++ Note: Though structured field bodies are defined in such a way that+ folding can take place between many of the lexical tokens (and even+ within some of the lexical tokens), folding SHOULD be limited to+ placing the CRLF at higher-level syntactic breaks. For instance, if+ a field body is defined as comma-separated values, it is recommended+ that folding occur after the comma separating the structured items in+ preference to other places where the field could be folded, even if+ it is allowed elsewhere.++ The process of moving from this folded multiple-line representation+ of a header field to its single line representation is called+ "unfolding". Unfolding is accomplished by simply removing any CRLF+ that is immediately followed by WSP. Each header field should be+ treated in its unfolded form for further syntactic and semantic+ evaluation.++2.3. Body++ The body of a message is simply lines of US-ASCII characters. The+ only two limitations on the body are as follows:++ - CR and LF MUST only occur together as CRLF; they MUST NOT appear+ independently in the body.++ - Lines of characters in the body MUST be limited to 998 characters,+ and SHOULD be limited to 78 characters, excluding the CRLF.++ Note: As was stated earlier, there are other standards documents,+ specifically the MIME documents [RFC2045, RFC2046, RFC2048, RFC2049]+ that extend this standard to allow for different sorts of message+ bodies. Again, these mechanisms are beyond the scope of this+ document.+++++++++Resnick Standards Track [Page 8]++RFC 2822 Internet Message Format April 2001+++3. Syntax++3.1. Introduction++ The syntax as given in this section defines the legal syntax of+ Internet messages. Messages that are conformant to this standard+ MUST conform to the syntax in this section. If there are options in+ this section where one option SHOULD be generated, that is indicated+ either in the prose or in a comment next to the syntax.++ For the defined expressions, a short description of the syntax and+ use is given, followed by the syntax in ABNF, followed by a semantic+ analysis. Primitive tokens that are used but otherwise unspecified+ come from [RFC2234].++ In some of the definitions, there will be nonterminals whose names+ start with "obs-". These "obs-" elements refer to tokens defined in+ the obsolete syntax in section 4. In all cases, these productions+ are to be ignored for the purposes of generating legal Internet+ messages and MUST NOT be used as part of such a message. However,+ when interpreting messages, these tokens MUST be honored as part of+ the legal syntax. In this sense, section 3 defines a grammar for+ generation of messages, with "obs-" elements that are to be ignored,+ while section 4 adds grammar for interpretation of messages.++3.2. Lexical Tokens++ The following rules are used to define an underlying lexical+ analyzer, which feeds tokens to the higher-level parsers. This+ section defines the tokens used in structured header field bodies.++ Note: Readers of this standard need to pay special attention to how+ these lexical tokens are used in both the lower-level and+ higher-level syntax later in the document. Particularly, the white+ space tokens and the comment tokens defined in section 3.2.3 get used+ in the lower-level tokens defined here, and those lower-level tokens+ are in turn used as parts of the higher-level tokens defined later.+ Therefore, the white space and comments may be allowed in the+ higher-level tokens even though they may not explicitly appear in a+ particular definition.++3.2.1. Primitive Tokens++ The following are primitive tokens referred to elsewhere in this+ standard, but not otherwise defined in [RFC2234]. Some of them will+ not appear anywhere else in the syntax, but they are convenient to+ refer to in other parts of this document.+++++Resnick Standards Track [Page 9]++RFC 2822 Internet Message Format April 2001+++ Note: The "specials" below are just such an example. Though the+ specials token does not appear anywhere else in this standard, it is+ useful for implementers who use tools that lexically analyze+ messages. Each of the characters in specials can be used to indicate+ a tokenization point in lexical analysis.++NO-WS-CTL = %d1-8 / ; US-ASCII control characters+ %d11 / ; that do not include the+ %d12 / ; carriage return, line feed,+ %d14-31 / ; and white space characters+ %d127++text = %d1-9 / ; Characters excluding CR and LF+ %d11 /+ %d12 /+ %d14-127 /+ obs-text++specials = "(" / ")" / ; Special characters used in+ "<" / ">" / ; other parts of the syntax+ "[" / "]" /+ ":" / ";" /+ "@" / "\" /+ "," / "." /+ DQUOTE++ No special semantics are attached to these tokens. They are simply+ single characters.++3.2.2. Quoted characters++ Some characters are reserved for special interpretation, such as+ delimiting lexical tokens. To permit use of these characters as+ uninterpreted data, a quoting mechanism is provided.++quoted-pair = ("\" text) / obs-qp++ Where any quoted-pair appears, it is to be interpreted as the text+ character alone. That is to say, the "\" character that appears as+ part of a quoted-pair is semantically "invisible".++ Note: The "\" character may appear in a message where it is not part+ of a quoted-pair. A "\" character that does not appear in a+ quoted-pair is not semantically invisible. The only places in this+ standard where quoted-pair currently appears are ccontent, qcontent,+ dcontent, no-fold-quote, and no-fold-literal.++++++Resnick Standards Track [Page 10]++RFC 2822 Internet Message Format April 2001+++3.2.3. Folding white space and comments++ White space characters, including white space used in folding+ (described in section 2.2.3), may appear between many elements in+ header field bodies. Also, strings of characters that are treated as+ comments may be included in structured field bodies as characters+ enclosed in parentheses. The following defines the folding white+ space (FWS) and comment constructs.++ Strings of characters enclosed in parentheses are considered comments+ so long as they do not appear within a "quoted-string", as defined in+ section 3.2.5. Comments may nest.++ There are several places in this standard where comments and FWS may+ be freely inserted. To accommodate that syntax, an additional token+ for "CFWS" is defined for places where comments and/or FWS can occur.+ However, where CFWS occurs in this standard, it MUST NOT be inserted+ in such a way that any line of a folded header field is made up+ entirely of WSP characters and nothing else.++FWS = ([*WSP CRLF] 1*WSP) / ; Folding white space+ obs-FWS++ctext = NO-WS-CTL / ; Non white space controls++ %d33-39 / ; The rest of the US-ASCII+ %d42-91 / ; characters not including "(",+ %d93-126 ; ")", or "\"++ccontent = ctext / quoted-pair / comment++comment = "(" *([FWS] ccontent) [FWS] ")"++CFWS = *([FWS] comment) (([FWS] comment) / FWS)++ Throughout this standard, where FWS (the folding white space token)+ appears, it indicates a place where header folding, as discussed in+ section 2.2.3, may take place. Wherever header folding appears in a+ message (that is, a header field body containing a CRLF followed by+ any WSP), header unfolding (removal of the CRLF) is performed before+ any further lexical analysis is performed on that header field+ according to this standard. That is to say, any CRLF that appears in+ FWS is semantically "invisible."++ A comment is normally used in a structured field body to provide some+ human readable informational text. Since a comment is allowed to+ contain FWS, folding is permitted within the comment. Also note that+ since quoted-pair is allowed in a comment, the parentheses and++++Resnick Standards Track [Page 11]++RFC 2822 Internet Message Format April 2001+++ backslash characters may appear in a comment so long as they appear+ as a quoted-pair. Semantically, the enclosing parentheses are not+ part of the comment; the comment is what is contained between the two+ parentheses. As stated earlier, the "\" in any quoted-pair and the+ CRLF in any FWS that appears within the comment are semantically+ "invisible" and therefore not part of the comment either.++ Runs of FWS, comment or CFWS that occur between lexical tokens in a+ structured field header are semantically interpreted as a single+ space character.++3.2.4. Atom++ Several productions in structured header field bodies are simply+ strings of certain basic characters. Such productions are called+ atoms.++ Some of the structured header field bodies also allow the period+ character (".", ASCII value 46) within runs of atext. An additional+ "dot-atom" token is defined for those purposes.++atext = ALPHA / DIGIT / ; Any character except controls,+ "!" / "#" / ; SP, and specials.+ "$" / "%" / ; Used for atoms+ "&" / "'" /+ "*" / "+" /+ "-" / "/" /+ "=" / "?" /+ "^" / "_" /+ "`" / "{" /+ "|" / "}" /+ "~"++atom = [CFWS] 1*atext [CFWS]++dot-atom = [CFWS] dot-atom-text [CFWS]++dot-atom-text = 1*atext *("." 1*atext)++ Both atom and dot-atom are interpreted as a single unit, comprised of+ the string of characters that make it up. Semantically, the optional+ comments and FWS surrounding the rest of the characters are not part+ of the atom; the atom is only the run of atext characters in an atom,+ or the atext and "." characters in a dot-atom.++++++++Resnick Standards Track [Page 12]++RFC 2822 Internet Message Format April 2001+++3.2.5. Quoted strings++ Strings of characters that include characters other than those+ allowed in atoms may be represented in a quoted string format, where+ the characters are surrounded by quote (DQUOTE, ASCII value 34)+ characters.++qtext = NO-WS-CTL / ; Non white space controls++ %d33 / ; The rest of the US-ASCII+ %d35-91 / ; characters not including "\"+ %d93-126 ; or the quote character++qcontent = qtext / quoted-pair++quoted-string = [CFWS]+ DQUOTE *([FWS] qcontent) [FWS] DQUOTE+ [CFWS]++ A quoted-string is treated as a unit. That is, quoted-string is+ identical to atom, semantically. Since a quoted-string is allowed to+ contain FWS, folding is permitted. Also note that since quoted-pair+ is allowed in a quoted-string, the quote and backslash characters may+ appear in a quoted-string so long as they appear as a quoted-pair.++ Semantically, neither the optional CFWS outside of the quote+ characters nor the quote characters themselves are part of the+ quoted-string; the quoted-string is what is contained between the two+ quote characters. As stated earlier, the "\" in any quoted-pair and+ the CRLF in any FWS/CFWS that appears within the quoted-string are+ semantically "invisible" and therefore not part of the quoted-string+ either.++3.2.6. Miscellaneous tokens++ Three additional tokens are defined, word and phrase for combinations+ of atoms and/or quoted-strings, and unstructured for use in+ unstructured header fields and in some places within structured+ header fields.++word = atom / quoted-string++phrase = 1*word / obs-phrase+++++++++Resnick Standards Track [Page 13]++RFC 2822 Internet Message Format April 2001+++utext = NO-WS-CTL / ; Non white space controls+ %d33-126 / ; The rest of US-ASCII+ obs-utext++unstructured = *([FWS] utext) [FWS]++3.3. Date and Time Specification++ Date and time occur in several header fields. This section specifies+ the syntax for a full date and time specification. Though folding+ white space is permitted throughout the date-time specification, it+ is RECOMMENDED that a single space be used in each place that FWS+ appears (whether it is required or optional); some older+ implementations may not interpret other occurrences of folding white+ space correctly.++date-time = [ day-of-week "," ] date FWS time [CFWS]++day-of-week = ([FWS] day-name) / obs-day-of-week++day-name = "Mon" / "Tue" / "Wed" / "Thu" /+ "Fri" / "Sat" / "Sun"++date = day month year++year = 4*DIGIT / obs-year++month = (FWS month-name FWS) / obs-month++month-name = "Jan" / "Feb" / "Mar" / "Apr" /+ "May" / "Jun" / "Jul" / "Aug" /+ "Sep" / "Oct" / "Nov" / "Dec"++day = ([FWS] 1*2DIGIT) / obs-day++time = time-of-day FWS zone++time-of-day = hour ":" minute [ ":" second ]++hour = 2DIGIT / obs-hour++minute = 2DIGIT / obs-minute++second = 2DIGIT / obs-second++zone = (( "+" / "-" ) 4DIGIT) / obs-zone++++++Resnick Standards Track [Page 14]++RFC 2822 Internet Message Format April 2001+++ The day is the numeric day of the month. The year is any numeric+ year 1900 or later.++ The time-of-day specifies the number of hours, minutes, and+ optionally seconds since midnight of the date indicated.++ The date and time-of-day SHOULD express local time.++ The zone specifies the offset from Coordinated Universal Time (UTC,+ formerly referred to as "Greenwich Mean Time") that the date and+ time-of-day represent. The "+" or "-" indicates whether the+ time-of-day is ahead of (i.e., east of) or behind (i.e., west of)+ Universal Time. The first two digits indicate the number of hours+ difference from Universal Time, and the last two digits indicate the+ number of minutes difference from Universal Time. (Hence, +hhmm+ means +(hh * 60 + mm) minutes, and -hhmm means -(hh * 60 + mm)+ minutes). The form "+0000" SHOULD be used to indicate a time zone at+ Universal Time. Though "-0000" also indicates Universal Time, it is+ used to indicate that the time was generated on a system that may be+ in a local time zone other than Universal Time and therefore+ indicates that the date-time contains no information about the local+ time zone.++ A date-time specification MUST be semantically valid. That is, the+ day-of-the-week (if included) MUST be the day implied by the date,+ the numeric day-of-month MUST be between 1 and the number of days+ allowed for the specified month (in the specified year), the+ time-of-day MUST be in the range 00:00:00 through 23:59:60 (the+ number of seconds allowing for a leap second; see [STD12]), and the+ zone MUST be within the range -9959 through +9959.++3.4. Address Specification++ Addresses occur in several message header fields to indicate senders+ and recipients of messages. An address may either be an individual+ mailbox, or a group of mailboxes.++address = mailbox / group++mailbox = name-addr / addr-spec++name-addr = [display-name] angle-addr++angle-addr = [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr++group = display-name ":" [mailbox-list / CFWS] ";"+ [CFWS]+++++Resnick Standards Track [Page 15]++RFC 2822 Internet Message Format April 2001+++display-name = phrase++mailbox-list = (mailbox *("," mailbox)) / obs-mbox-list++address-list = (address *("," address)) / obs-addr-list++ A mailbox receives mail. It is a conceptual entity which does not+ necessarily pertain to file storage. For example, some sites may+ choose to print mail on a printer and deliver the output to the+ addressee's desk. Normally, a mailbox is comprised of two parts: (1)+ an optional display name that indicates the name of the recipient+ (which could be a person or a system) that could be displayed to the+ user of a mail application, and (2) an addr-spec address enclosed in+ angle brackets ("<" and ">"). There is also an alternate simple form+ of a mailbox where the addr-spec address appears alone, without the+ recipient's name or the angle brackets. The Internet addr-spec+ address is described in section 3.4.1.++ Note: Some legacy implementations used the simple form where the+ addr-spec appears without the angle brackets, but included the name+ of the recipient in parentheses as a comment following the addr-spec.+ Since the meaning of the information in a comment is unspecified,+ implementations SHOULD use the full name-addr form of the mailbox,+ instead of the legacy form, to specify the display name associated+ with a mailbox. Also, because some legacy implementations interpret+ the comment, comments generally SHOULD NOT be used in address fields+ to avoid confusing such implementations.++ When it is desirable to treat several mailboxes as a single unit+ (i.e., in a distribution list), the group construct can be used. The+ group construct allows the sender to indicate a named group of+ recipients. This is done by giving a display name for the group,+ followed by a colon, followed by a comma separated list of any number+ of mailboxes (including zero and one), and ending with a semicolon.+ Because the list of mailboxes can be empty, using the group construct+ is also a simple way to communicate to recipients that the message+ was sent to one or more named sets of recipients, without actually+ providing the individual mailbox address for each of those+ recipients.++3.4.1. Addr-spec specification++ An addr-spec is a specific Internet identifier that contains a+ locally interpreted string followed by the at-sign character ("@",+ ASCII value 64) followed by an Internet domain. The locally+ interpreted string is either a quoted-string or a dot-atom. If the+ string can be represented as a dot-atom (that is, it contains no+ characters other than atext characters or "." surrounded by atext++++Resnick Standards Track [Page 16]++RFC 2822 Internet Message Format April 2001+++ characters), then the dot-atom form SHOULD be used and the+ quoted-string form SHOULD NOT be used. Comments and folding white+ space SHOULD NOT be used around the "@" in the addr-spec.++addr-spec = local-part "@" domain++local-part = dot-atom / quoted-string / obs-local-part++domain = dot-atom / domain-literal / obs-domain++domain-literal = [CFWS] "[" *([FWS] dcontent) [FWS] "]" [CFWS]++dcontent = dtext / quoted-pair++dtext = NO-WS-CTL / ; Non white space controls++ %d33-90 / ; The rest of the US-ASCII+ %d94-126 ; characters not including "[",+ ; "]", or "\"++ The domain portion identifies the point to which the mail is+ delivered. In the dot-atom form, this is interpreted as an Internet+ domain name (either a host name or a mail exchanger name) as+ described in [STD3, STD13, STD14]. In the domain-literal form, the+ domain is interpreted as the literal Internet address of the+ particular host. In both cases, how addressing is used and how+ messages are transported to a particular host is covered in the mail+ transport document [RFC2821]. These mechanisms are outside of the+ scope of this document.++ The local-part portion is a domain dependent string. In addresses,+ it is simply interpreted on the particular host as a name of a+ particular mailbox.++3.5 Overall message syntax++ A message consists of header fields, optionally followed by a message+ body. Lines in a message MUST be a maximum of 998 characters+ excluding the CRLF, but it is RECOMMENDED that lines be limited to 78+ characters excluding the CRLF. (See section 2.1.1 for explanation.)+ In a message body, though all of the characters listed in the text+ rule MAY be used, the use of US-ASCII control characters (values 1+ through 8, 11, 12, and 14 through 31) is discouraged since their+ interpretation by receivers for display is not guaranteed.++++++++Resnick Standards Track [Page 17]++RFC 2822 Internet Message Format April 2001+++message = (fields / obs-fields)+ [CRLF body]++body = *(*998text CRLF) *998text++ The header fields carry most of the semantic information and are+ defined in section 3.6. The body is simply a series of lines of text+ which are uninterpreted for the purposes of this standard.++3.6. Field definitions++ The header fields of a message are defined here. All header fields+ have the same general syntactic structure: A field name, followed by+ a colon, followed by the field body. The specific syntax for each+ header field is defined in the subsequent sections.++ Note: In the ABNF syntax for each field in subsequent sections, each+ field name is followed by the required colon. However, for brevity+ sometimes the colon is not referred to in the textual description of+ the syntax. It is, nonetheless, required.++ It is important to note that the header fields are not guaranteed to+ be in a particular order. They may appear in any order, and they+ have been known to be reordered occasionally when transported over+ the Internet. However, for the purposes of this standard, header+ fields SHOULD NOT be reordered when a message is transported or+ transformed. More importantly, the trace header fields and resent+ header fields MUST NOT be reordered, and SHOULD be kept in blocks+ prepended to the message. See sections 3.6.6 and 3.6.7 for more+ information.++ The only required header fields are the origination date field and+ the originator address field(s). All other header fields are+ syntactically optional. More information is contained in the table+ following this definition.++fields = *(trace+ *(resent-date /+ resent-from /+ resent-sender /+ resent-to /+ resent-cc /+ resent-bcc /+ resent-msg-id))+ *(orig-date /+ from /+ sender /+ reply-to /++++Resnick Standards Track [Page 18]++RFC 2822 Internet Message Format April 2001+++ to /+ cc /+ bcc /+ message-id /+ in-reply-to /+ references /+ subject /+ comments /+ keywords /+ optional-field)++ The following table indicates limits on the number of times each+ field may occur in a message header as well as any special+ limitations on the use of those fields. An asterisk next to a value+ in the minimum or maximum column indicates that a special restriction+ appears in the Notes column.++Field Min number Max number Notes++trace 0 unlimited Block prepended - see+ 3.6.7++resent-date 0* unlimited* One per block, required+ if other resent fields+ present - see 3.6.6++resent-from 0 unlimited* One per block - see+ 3.6.6++resent-sender 0* unlimited* One per block, MUST+ occur with multi-address+ resent-from - see 3.6.6++resent-to 0 unlimited* One per block - see+ 3.6.6++resent-cc 0 unlimited* One per block - see+ 3.6.6++resent-bcc 0 unlimited* One per block - see+ 3.6.6++resent-msg-id 0 unlimited* One per block - see+ 3.6.6++orig-date 1 1++from 1 1 See sender and 3.6.2++++Resnick Standards Track [Page 19]++RFC 2822 Internet Message Format April 2001+++sender 0* 1 MUST occur with multi-+ address from - see 3.6.2++reply-to 0 1++to 0 1++cc 0 1++bcc 0 1++message-id 0* 1 SHOULD be present - see+ 3.6.4++in-reply-to 0* 1 SHOULD occur in some+ replies - see 3.6.4++references 0* 1 SHOULD occur in some+ replies - see 3.6.4++subject 0 1++comments 0 unlimited++keywords 0 unlimited++optional-field 0 unlimited++ The exact interpretation of each field is described in subsequent+ sections.++3.6.1. The origination date field++ The origination date field consists of the field name "Date" followed+ by a date-time specification.++orig-date = "Date:" date-time CRLF++ The origination date specifies the date and time at which the creator+ of the message indicated that the message was complete and ready to+ enter the mail delivery system. For instance, this might be the time+ that a user pushes the "send" or "submit" button in an application+ program. In any case, it is specifically not intended to convey the+ time that the message is actually transported, but rather the time at+ which the human or other creator of the message has put the message+ into its final form, ready for transport. (For example, a portable+ computer user who is not connected to a network might queue a message+++++Resnick Standards Track [Page 20]++RFC 2822 Internet Message Format April 2001+++ for delivery. The origination date is intended to contain the date+ and time that the user queued the message, not the time when the user+ connected to the network to send the message.)++3.6.2. Originator fields++ The originator fields of a message consist of the from field, the+ sender field (when applicable), and optionally the reply-to field.+ The from field consists of the field name "From" and a+ comma-separated list of one or more mailbox specifications. If the+ from field contains more than one mailbox specification in the+ mailbox-list, then the sender field, containing the field name+ "Sender" and a single mailbox specification, MUST appear in the+ message. In either case, an optional reply-to field MAY also be+ included, which contains the field name "Reply-To" and a+ comma-separated list of one or more addresses.++from = "From:" mailbox-list CRLF++sender = "Sender:" mailbox CRLF++reply-to = "Reply-To:" address-list CRLF++ The originator fields indicate the mailbox(es) of the source of the+ message. The "From:" field specifies the author(s) of the message,+ that is, the mailbox(es) of the person(s) or system(s) responsible+ for the writing of the message. The "Sender:" field specifies the+ mailbox of the agent responsible for the actual transmission of the+ message. For example, if a secretary were to send a message for+ another person, the mailbox of the secretary would appear in the+ "Sender:" field and the mailbox of the actual author would appear in+ the "From:" field. If the originator of the message can be indicated+ by a single mailbox and the author and transmitter are identical, the+ "Sender:" field SHOULD NOT be used. Otherwise, both fields SHOULD+ appear.++ The originator fields also provide the information required when+ replying to a message. When the "Reply-To:" field is present, it+ indicates the mailbox(es) to which the author of the message suggests+ that replies be sent. In the absence of the "Reply-To:" field,+ replies SHOULD by default be sent to the mailbox(es) specified in the+ "From:" field unless otherwise specified by the person composing the+ reply.++ In all cases, the "From:" field SHOULD NOT contain any mailbox that+ does not belong to the author(s) of the message. See also section+ 3.6.3 for more information on forming the destination addresses for a+ reply.++++Resnick Standards Track [Page 21]++RFC 2822 Internet Message Format April 2001+++3.6.3. Destination address fields++ The destination fields of a message consist of three possible fields,+ each of the same form: The field name, which is either "To", "Cc", or+ "Bcc", followed by a comma-separated list of one or more addresses+ (either mailbox or group syntax).++to = "To:" address-list CRLF++cc = "Cc:" address-list CRLF++bcc = "Bcc:" (address-list / [CFWS]) CRLF++ The destination fields specify the recipients of the message. Each+ destination field may have one or more addresses, and each of the+ addresses indicate the intended recipients of the message. The only+ difference between the three fields is how each is used.++ The "To:" field contains the address(es) of the primary recipient(s)+ of the message.++ The "Cc:" field (where the "Cc" means "Carbon Copy" in the sense of+ making a copy on a typewriter using carbon paper) contains the+ addresses of others who are to receive the message, though the+ content of the message may not be directed at them.++ The "Bcc:" field (where the "Bcc" means "Blind Carbon Copy") contains+ addresses of recipients of the message whose addresses are not to be+ revealed to other recipients of the message. There are three ways in+ which the "Bcc:" field is used. In the first case, when a message+ containing a "Bcc:" field is prepared to be sent, the "Bcc:" line is+ removed even though all of the recipients (including those specified+ in the "Bcc:" field) are sent a copy of the message. In the second+ case, recipients specified in the "To:" and "Cc:" lines each are sent+ a copy of the message with the "Bcc:" line removed as above, but the+ recipients on the "Bcc:" line get a separate copy of the message+ containing a "Bcc:" line. (When there are multiple recipient+ addresses in the "Bcc:" field, some implementations actually send a+ separate copy of the message to each recipient with a "Bcc:"+ containing only the address of that particular recipient.) Finally,+ since a "Bcc:" field may contain no addresses, a "Bcc:" field can be+ sent without any addresses indicating to the recipients that blind+ copies were sent to someone. Which method to use with "Bcc:" fields+ is implementation dependent, but refer to the "Security+ Considerations" section of this document for a discussion of each.+++++++Resnick Standards Track [Page 22]++RFC 2822 Internet Message Format April 2001+++ When a message is a reply to another message, the mailboxes of the+ authors of the original message (the mailboxes in the "From:" field)+ or mailboxes specified in the "Reply-To:" field (if it exists) MAY+ appear in the "To:" field of the reply since these would normally be+ the primary recipients of the reply. If a reply is sent to a message+ that has destination fields, it is often desirable to send a copy of+ the reply to all of the recipients of the message, in addition to the+ author. When such a reply is formed, addresses in the "To:" and+ "Cc:" fields of the original message MAY appear in the "Cc:" field of+ the reply, since these are normally secondary recipients of the+ reply. If a "Bcc:" field is present in the original message,+ addresses in that field MAY appear in the "Bcc:" field of the reply,+ but SHOULD NOT appear in the "To:" or "Cc:" fields.++ Note: Some mail applications have automatic reply commands that+ include the destination addresses of the original message in the+ destination addresses of the reply. How those reply commands behave+ is implementation dependent and is beyond the scope of this document.+ In particular, whether or not to include the original destination+ addresses when the original message had a "Reply-To:" field is not+ addressed here.++3.6.4. Identification fields++ Though optional, every message SHOULD have a "Message-ID:" field.+ Furthermore, reply messages SHOULD have "In-Reply-To:" and+ "References:" fields as appropriate, as described below.++ The "Message-ID:" field contains a single unique message identifier.+ The "References:" and "In-Reply-To:" field each contain one or more+ unique message identifiers, optionally separated by CFWS.++ The message identifier (msg-id) is similar in syntax to an angle-addr+ construct without the internal CFWS.++message-id = "Message-ID:" msg-id CRLF++in-reply-to = "In-Reply-To:" 1*msg-id CRLF++references = "References:" 1*msg-id CRLF++msg-id = [CFWS] "<" id-left "@" id-right ">" [CFWS]++id-left = dot-atom-text / no-fold-quote / obs-id-left++id-right = dot-atom-text / no-fold-literal / obs-id-right++no-fold-quote = DQUOTE *(qtext / quoted-pair) DQUOTE++++Resnick Standards Track [Page 23]++RFC 2822 Internet Message Format April 2001+++no-fold-literal = "[" *(dtext / quoted-pair) "]"++ The "Message-ID:" field provides a unique message identifier that+ refers to a particular version of a particular message. The+ uniqueness of the message identifier is guaranteed by the host that+ generates it (see below). This message identifier is intended to be+ machine readable and not necessarily meaningful to humans. A message+ identifier pertains to exactly one instantiation of a particular+ message; subsequent revisions to the message each receive new message+ identifiers.++ Note: There are many instances when messages are "changed", but those+ changes do not constitute a new instantiation of that message, and+ therefore the message would not get a new message identifier. For+ example, when messages are introduced into the transport system, they+ are often prepended with additional header fields such as trace+ fields (described in section 3.6.7) and resent fields (described in+ section 3.6.6). The addition of such header fields does not change+ the identity of the message and therefore the original "Message-ID:"+ field is retained. In all cases, it is the meaning that the sender+ of the message wishes to convey (i.e., whether this is the same+ message or a different message) that determines whether or not the+ "Message-ID:" field changes, not any particular syntactic difference+ that appears (or does not appear) in the message.++ The "In-Reply-To:" and "References:" fields are used when creating a+ reply to a message. They hold the message identifier of the original+ message and the message identifiers of other messages (for example,+ in the case of a reply to a message which was itself a reply). The+ "In-Reply-To:" field may be used to identify the message (or+ messages) to which the new message is a reply, while the+ "References:" field may be used to identify a "thread" of+ conversation.++ When creating a reply to a message, the "In-Reply-To:" and+ "References:" fields of the resultant message are constructed as+ follows:++ The "In-Reply-To:" field will contain the contents of the "Message-+ ID:" field of the message to which this one is a reply (the "parent+ message"). If there is more than one parent message, then the "In-+ Reply-To:" field will contain the contents of all of the parents'+ "Message-ID:" fields. If there is no "Message-ID:" field in any of+ the parent messages, then the new message will have no "In-Reply-To:"+ field.+++++++Resnick Standards Track [Page 24]++RFC 2822 Internet Message Format April 2001+++ The "References:" field will contain the contents of the parent's+ "References:" field (if any) followed by the contents of the parent's+ "Message-ID:" field (if any). If the parent message does not contain+ a "References:" field but does have an "In-Reply-To:" field+ containing a single message identifier, then the "References:" field+ will contain the contents of the parent's "In-Reply-To:" field+ followed by the contents of the parent's "Message-ID:" field (if+ any). If the parent has none of the "References:", "In-Reply-To:",+ or "Message-ID:" fields, then the new message will have no+ "References:" field.++ Note: Some implementations parse the "References:" field to display+ the "thread of the discussion". These implementations assume that+ each new message is a reply to a single parent and hence that they+ can walk backwards through the "References:" field to find the parent+ of each message listed there. Therefore, trying to form a+ "References:" field for a reply that has multiple parents is+ discouraged and how to do so is not defined in this document.++ The message identifier (msg-id) itself MUST be a globally unique+ identifier for a message. The generator of the message identifier+ MUST guarantee that the msg-id is unique. There are several+ algorithms that can be used to accomplish this. Since the msg-id has+ a similar syntax to angle-addr (identical except that comments and+ folding white space are not allowed), a good method is to put the+ domain name (or a domain literal IP address) of the host on which the+ message identifier was created on the right hand side of the "@", and+ put a combination of the current absolute date and time along with+ some other currently unique (perhaps sequential) identifier available+ on the system (for example, a process id number) on the left hand+ side. Using a date on the left hand side and a domain name or domain+ literal on the right hand side makes it possible to guarantee+ uniqueness since no two hosts use the same domain name or IP address+ at the same time. Though other algorithms will work, it is+ RECOMMENDED that the right hand side contain some domain identifier+ (either of the host itself or otherwise) such that the generator of+ the message identifier can guarantee the uniqueness of the left hand+ side within the scope of that domain.++ Semantically, the angle bracket characters are not part of the+ msg-id; the msg-id is what is contained between the two angle bracket+ characters.++++++++++Resnick Standards Track [Page 25]++RFC 2822 Internet Message Format April 2001+++3.6.5. Informational fields++ The informational fields are all optional. The "Keywords:" field+ contains a comma-separated list of one or more words or+ quoted-strings. The "Subject:" and "Comments:" fields are+ unstructured fields as defined in section 2.2.1, and therefore may+ contain text or folding white space.++subject = "Subject:" unstructured CRLF++comments = "Comments:" unstructured CRLF++keywords = "Keywords:" phrase *("," phrase) CRLF++ These three fields are intended to have only human-readable content+ with information about the message. The "Subject:" field is the most+ common and contains a short string identifying the topic of the+ message. When used in a reply, the field body MAY start with the+ string "Re: " (from the Latin "res", in the matter of) followed by+ the contents of the "Subject:" field body of the original message.+ If this is done, only one instance of the literal string "Re: " ought+ to be used since use of other strings or more than one instance can+ lead to undesirable consequences. The "Comments:" field contains any+ additional comments on the text of the body of the message. The+ "Keywords:" field contains a comma-separated list of important words+ and phrases that might be useful for the recipient.++3.6.6. Resent fields++ Resent fields SHOULD be added to any message that is reintroduced by+ a user into the transport system. A separate set of resent fields+ SHOULD be added each time this is done. All of the resent fields+ corresponding to a particular resending of the message SHOULD be+ together. Each new set of resent fields is prepended to the message;+ that is, the most recent set of resent fields appear earlier in the+ message. No other fields in the message are changed when resent+ fields are added.++ Each of the resent fields corresponds to a particular field elsewhere+ in the syntax. For instance, the "Resent-Date:" field corresponds to+ the "Date:" field and the "Resent-To:" field corresponds to the "To:"+ field. In each case, the syntax for the field body is identical to+ the syntax given previously for the corresponding field.++ When resent fields are used, the "Resent-From:" and "Resent-Date:"+ fields MUST be sent. The "Resent-Message-ID:" field SHOULD be sent.+ "Resent-Sender:" SHOULD NOT be used if "Resent-Sender:" would be+ identical to "Resent-From:".++++Resnick Standards Track [Page 26]++RFC 2822 Internet Message Format April 2001+++resent-date = "Resent-Date:" date-time CRLF++resent-from = "Resent-From:" mailbox-list CRLF++resent-sender = "Resent-Sender:" mailbox CRLF++resent-to = "Resent-To:" address-list CRLF++resent-cc = "Resent-Cc:" address-list CRLF++resent-bcc = "Resent-Bcc:" (address-list / [CFWS]) CRLF++resent-msg-id = "Resent-Message-ID:" msg-id CRLF++ Resent fields are used to identify a message as having been+ reintroduced into the transport system by a user. The purpose of+ using resent fields is to have the message appear to the final+ recipient as if it were sent directly by the original sender, with+ all of the original fields remaining the same. Each set of resent+ fields correspond to a particular resending event. That is, if a+ message is resent multiple times, each set of resent fields gives+ identifying information for each individual time. Resent fields are+ strictly informational. They MUST NOT be used in the normal+ processing of replies or other such automatic actions on messages.++ Note: Reintroducing a message into the transport system and using+ resent fields is a different operation from "forwarding".+ "Forwarding" has two meanings: One sense of forwarding is that a mail+ reading program can be told by a user to forward a copy of a message+ to another person, making the forwarded message the body of the new+ message. A forwarded message in this sense does not appear to have+ come from the original sender, but is an entirely new message from+ the forwarder of the message. On the other hand, forwarding is also+ used to mean when a mail transport program gets a message and+ forwards it on to a different destination for final delivery. Resent+ header fields are not intended for use with either type of+ forwarding.++ The resent originator fields indicate the mailbox of the person(s) or+ system(s) that resent the message. As with the regular originator+ fields, there are two forms: a simple "Resent-From:" form which+ contains the mailbox of the individual doing the resending, and the+ more complex form, when one individual (identified in the+ "Resent-Sender:" field) resends a message on behalf of one or more+ others (identified in the "Resent-From:" field).++ Note: When replying to a resent message, replies behave just as they+ would with any other message, using the original "From:",++++Resnick Standards Track [Page 27]++RFC 2822 Internet Message Format April 2001+++ "Reply-To:", "Message-ID:", and other fields. The resent fields are+ only informational and MUST NOT be used in the normal processing of+ replies.++ The "Resent-Date:" indicates the date and time at which the resent+ message is dispatched by the resender of the message. Like the+ "Date:" field, it is not the date and time that the message was+ actually transported.++ The "Resent-To:", "Resent-Cc:", and "Resent-Bcc:" fields function+ identically to the "To:", "Cc:", and "Bcc:" fields respectively,+ except that they indicate the recipients of the resent message, not+ the recipients of the original message.++ The "Resent-Message-ID:" field provides a unique identifier for the+ resent message.++3.6.7. Trace fields++ The trace fields are a group of header fields consisting of an+ optional "Return-Path:" field, and one or more "Received:" fields.+ The "Return-Path:" header field contains a pair of angle brackets+ that enclose an optional addr-spec. The "Received:" field contains a+ (possibly empty) list of name/value pairs followed by a semicolon and+ a date-time specification. The first item of the name/value pair is+ defined by item-name, and the second item is either an addr-spec, an+ atom, a domain, or a msg-id. Further restrictions may be applied to+ the syntax of the trace fields by standards that provide for their+ use, such as [RFC2821].++trace = [return]+ 1*received++return = "Return-Path:" path CRLF++path = ([CFWS] "<" ([CFWS] / addr-spec) ">" [CFWS]) /+ obs-path++received = "Received:" name-val-list ";" date-time CRLF++name-val-list = [CFWS] [name-val-pair *(CFWS name-val-pair)]++name-val-pair = item-name CFWS item-value++item-name = ALPHA *(["-"] (ALPHA / DIGIT))++item-value = 1*angle-addr / addr-spec /+ atom / domain / msg-id++++Resnick Standards Track [Page 28]++RFC 2822 Internet Message Format April 2001+++ A full discussion of the Internet mail use of trace fields is+ contained in [RFC2821]. For the purposes of this standard, the trace+ fields are strictly informational, and any formal interpretation of+ them is outside of the scope of this document.++3.6.8. Optional fields++ Fields may appear in messages that are otherwise unspecified in this+ standard. They MUST conform to the syntax of an optional-field.+ This is a field name, made up of the printable US-ASCII characters+ except SP and colon, followed by a colon, followed by any text which+ conforms to unstructured.++ The field names of any optional-field MUST NOT be identical to any+ field name specified elsewhere in this standard.++optional-field = field-name ":" unstructured CRLF++field-name = 1*ftext++ftext = %d33-57 / ; Any character except+ %d59-126 ; controls, SP, and+ ; ":".++ For the purposes of this standard, any optional field is+ uninterpreted.++4. Obsolete Syntax++ Earlier versions of this standard allowed for different (usually more+ liberal) syntax than is allowed in this version. Also, there have+ been syntactic elements used in messages on the Internet whose+ interpretation have never been documented. Though some of these+ syntactic forms MUST NOT be generated according to the grammar in+ section 3, they MUST be accepted and parsed by a conformant receiver.+ This section documents many of these syntactic elements. Taking the+ grammar in section 3 and adding the definitions presented in this+ section will result in the grammar to use for interpretation of+ messages.++ Note: This section identifies syntactic forms that any implementation+ MUST reasonably interpret. However, there are certainly Internet+ messages which do not conform to even the additional syntax given in+ this section. The fact that a particular form does not appear in any+ section of this document is not justification for computer programs+ to crash or for malformed data to be irretrievably lost by any+ implementation. To repeat an example, though this document requires+ lines in messages to be no longer than 998 characters, silently++++Resnick Standards Track [Page 29]++RFC 2822 Internet Message Format April 2001+++ discarding the 999th and subsequent characters in a line without+ warning would still be bad behavior for an implementation. It is up+ to the implementation to deal with messages robustly.++ One important difference between the obsolete (interpreting) and the+ current (generating) syntax is that in structured header field bodies+ (i.e., between the colon and the CRLF of any structured header+ field), white space characters, including folding white space, and+ comments can be freely inserted between any syntactic tokens. This+ allows many complex forms that have proven difficult for some+ implementations to parse.++ Another key difference between the obsolete and the current syntax is+ that the rule in section 3.2.3 regarding lines composed entirely of+ white space in comments and folding white space does not apply. See+ the discussion of folding white space in section 4.2 below.++ Finally, certain characters that were formerly allowed in messages+ appear in this section. The NUL character (ASCII value 0) was once+ allowed, but is no longer for compatibility reasons. CR and LF were+ allowed to appear in messages other than as CRLF; this use is also+ shown here.++ Other differences in syntax and semantics are noted in the following+ sections.++4.1. Miscellaneous obsolete tokens++ These syntactic elements are used elsewhere in the obsolete syntax or+ in the main syntax. The obs-char and obs-qp elements each add ASCII+ value 0. Bare CR and bare LF are added to obs-text and obs-utext.+ The period character is added to obs-phrase. The obs-phrase-list+ provides for "empty" elements in a comma-separated list of phrases.++ Note: The "period" (or "full stop") character (".") in obs-phrase is+ not a form that was allowed in earlier versions of this or any other+ standard. Period (nor any other character from specials) was not+ allowed in phrase because it introduced a parsing difficulty+ distinguishing between phrases and portions of an addr-spec (see+ section 4.4). It appears here because the period character is+ currently used in many messages in the display-name portion of+ addresses, especially for initials in names, and therefore must be+ interpreted properly. In the future, period may appear in the+ regular syntax of phrase.++obs-qp = "\" (%d0-127)++obs-text = *LF *CR *(obs-char *LF *CR)++++Resnick Standards Track [Page 30]++RFC 2822 Internet Message Format April 2001+++obs-char = %d0-9 / %d11 / ; %d0-127 except CR and+ %d12 / %d14-127 ; LF++obs-utext = obs-text++obs-phrase = word *(word / "." / CFWS)++obs-phrase-list = phrase / 1*([phrase] [CFWS] "," [CFWS]) [phrase]++ Bare CR and bare LF appear in messages with two different meanings.+ In many cases, bare CR or bare LF are used improperly instead of CRLF+ to indicate line separators. In other cases, bare CR and bare LF are+ used simply as ASCII control characters with their traditional ASCII+ meanings.++4.2. Obsolete folding white space++ In the obsolete syntax, any amount of folding white space MAY be+ inserted where the obs-FWS rule is allowed. This creates the+ possibility of having two consecutive "folds" in a line, and+ therefore the possibility that a line which makes up a folded header+ field could be composed entirely of white space.++ obs-FWS = 1*WSP *(CRLF 1*WSP)++4.3. Obsolete Date and Time++ The syntax for the obsolete date format allows a 2 digit year in the+ date field and allows for a list of alphabetic time zone+ specifications that were used in earlier versions of this standard.+ It also permits comments and folding white space between many of the+ tokens.++obs-day-of-week = [CFWS] day-name [CFWS]++obs-year = [CFWS] 2*DIGIT [CFWS]++obs-month = CFWS month-name CFWS++obs-day = [CFWS] 1*2DIGIT [CFWS]++obs-hour = [CFWS] 2DIGIT [CFWS]++obs-minute = [CFWS] 2DIGIT [CFWS]++obs-second = [CFWS] 2DIGIT [CFWS]++obs-zone = "UT" / "GMT" / ; Universal Time++++Resnick Standards Track [Page 31]++RFC 2822 Internet Message Format April 2001+++ ; North American UT+ ; offsets+ "EST" / "EDT" / ; Eastern: - 5/ - 4+ "CST" / "CDT" / ; Central: - 6/ - 5+ "MST" / "MDT" / ; Mountain: - 7/ - 6+ "PST" / "PDT" / ; Pacific: - 8/ - 7++ %d65-73 / ; Military zones - "A"+ %d75-90 / ; through "I" and "K"+ %d97-105 / ; through "Z", both+ %d107-122 ; upper and lower case++ Where a two or three digit year occurs in a date, the year is to be+ interpreted as follows: If a two digit year is encountered whose+ value is between 00 and 49, the year is interpreted by adding 2000,+ ending up with a value between 2000 and 2049. If a two digit year is+ encountered with a value between 50 and 99, or any three digit year+ is encountered, the year is interpreted by adding 1900.++ In the obsolete time zone, "UT" and "GMT" are indications of+ "Universal Time" and "Greenwich Mean Time" respectively and are both+ semantically identical to "+0000".++ The remaining three character zones are the US time zones. The first+ letter, "E", "C", "M", or "P" stands for "Eastern", "Central",+ "Mountain" and "Pacific". The second letter is either "S" for+ "Standard" time, or "D" for "Daylight" (or summer) time. Their+ interpretations are as follows:++ EDT is semantically equivalent to -0400+ EST is semantically equivalent to -0500+ CDT is semantically equivalent to -0500+ CST is semantically equivalent to -0600+ MDT is semantically equivalent to -0600+ MST is semantically equivalent to -0700+ PDT is semantically equivalent to -0700+ PST is semantically equivalent to -0800++ The 1 character military time zones were defined in a non-standard+ way in [RFC822] and are therefore unpredictable in their meaning.+ The original definitions of the military zones "A" through "I" are+ equivalent to "+0100" through "+0900" respectively; "K", "L", and "M"+ are equivalent to "+1000", "+1100", and "+1200" respectively; "N"+ through "Y" are equivalent to "-0100" through "-1200" respectively;+ and "Z" is equivalent to "+0000". However, because of the error in+ [RFC822], they SHOULD all be considered equivalent to "-0000" unless+ there is out-of-band information confirming their meaning.+++++Resnick Standards Track [Page 32]++RFC 2822 Internet Message Format April 2001+++ Other multi-character (usually between 3 and 5) alphabetic time zones+ have been used in Internet messages. Any such time zone whose+ meaning is not known SHOULD be considered equivalent to "-0000"+ unless there is out-of-band information confirming their meaning.++4.4. Obsolete Addressing++ There are three primary differences in addressing. First, mailbox+ addresses were allowed to have a route portion before the addr-spec+ when enclosed in "<" and ">". The route is simply a comma-separated+ list of domain names, each preceded by "@", and the list terminated+ by a colon. Second, CFWS were allowed between the period-separated+ elements of local-part and domain (i.e., dot-atom was not used). In+ addition, local-part is allowed to contain quoted-string in addition+ to just atom. Finally, mailbox-list and address-list were allowed to+ have "null" members. That is, there could be two or more commas in+ such a list with nothing in between them.++obs-angle-addr = [CFWS] "<" [obs-route] addr-spec ">" [CFWS]++obs-route = [CFWS] obs-domain-list ":" [CFWS]++obs-domain-list = "@" domain *(*(CFWS / "," ) [CFWS] "@" domain)++obs-local-part = word *("." word)++obs-domain = atom *("." atom)++obs-mbox-list = 1*([mailbox] [CFWS] "," [CFWS]) [mailbox]++obs-addr-list = 1*([address] [CFWS] "," [CFWS]) [address]++ When interpreting addresses, the route portion SHOULD be ignored.++4.5. Obsolete header fields++ Syntactically, the primary difference in the obsolete field syntax is+ that it allows multiple occurrences of any of the fields and they may+ occur in any order. Also, any amount of white space is allowed+ before the ":" at the end of the field name.++obs-fields = *(obs-return /+ obs-received /+ obs-orig-date /+ obs-from /+ obs-sender /+ obs-reply-to /+ obs-to /++++Resnick Standards Track [Page 33]++RFC 2822 Internet Message Format April 2001+++ obs-cc /+ obs-bcc /+ obs-message-id /+ obs-in-reply-to /+ obs-references /+ obs-subject /+ obs-comments /+ obs-keywords /+ obs-resent-date /+ obs-resent-from /+ obs-resent-send /+ obs-resent-rply /+ obs-resent-to /+ obs-resent-cc /+ obs-resent-bcc /+ obs-resent-mid /+ obs-optional)++ Except for destination address fields (described in section 4.5.3),+ the interpretation of multiple occurrences of fields is unspecified.+ Also, the interpretation of trace fields and resent fields which do+ not occur in blocks prepended to the message is unspecified as well.+ Unless otherwise noted in the following sections, interpretation of+ other fields is identical to the interpretation of their non-obsolete+ counterparts in section 3.++4.5.1. Obsolete origination date field++obs-orig-date = "Date" *WSP ":" date-time CRLF++4.5.2. Obsolete originator fields++obs-from = "From" *WSP ":" mailbox-list CRLF++obs-sender = "Sender" *WSP ":" mailbox CRLF++obs-reply-to = "Reply-To" *WSP ":" mailbox-list CRLF++4.5.3. Obsolete destination address fields++obs-to = "To" *WSP ":" address-list CRLF++obs-cc = "Cc" *WSP ":" address-list CRLF++obs-bcc = "Bcc" *WSP ":" (address-list / [CFWS]) CRLF+++++++Resnick Standards Track [Page 34]++RFC 2822 Internet Message Format April 2001+++ When multiple occurrences of destination address fields occur in a+ message, they SHOULD be treated as if the address-list in the first+ occurrence of the field is combined with the address lists of the+ subsequent occurrences by adding a comma and concatenating.++4.5.4. Obsolete identification fields++ The obsolete "In-Reply-To:" and "References:" fields differ from the+ current syntax in that they allow phrase (words or quoted strings) to+ appear. The obsolete forms of the left and right sides of msg-id+ allow interspersed CFWS, making them syntactically identical to+ local-part and domain respectively.++obs-message-id = "Message-ID" *WSP ":" msg-id CRLF++obs-in-reply-to = "In-Reply-To" *WSP ":" *(phrase / msg-id) CRLF++obs-references = "References" *WSP ":" *(phrase / msg-id) CRLF++obs-id-left = local-part++obs-id-right = domain++ For purposes of interpretation, the phrases in the "In-Reply-To:" and+ "References:" fields are ignored.++ Semantically, none of the optional CFWS surrounding the local-part+ and the domain are part of the obs-id-left and obs-id-right+ respectively.++4.5.5. Obsolete informational fields++obs-subject = "Subject" *WSP ":" unstructured CRLF++obs-comments = "Comments" *WSP ":" unstructured CRLF++obs-keywords = "Keywords" *WSP ":" obs-phrase-list CRLF++4.5.6. Obsolete resent fields++ The obsolete syntax adds a "Resent-Reply-To:" field, which consists+ of the field name, the optional comments and folding white space, the+ colon, and a comma separated list of addresses.++obs-resent-from = "Resent-From" *WSP ":" mailbox-list CRLF++obs-resent-send = "Resent-Sender" *WSP ":" mailbox CRLF+++++Resnick Standards Track [Page 35]++RFC 2822 Internet Message Format April 2001+++obs-resent-date = "Resent-Date" *WSP ":" date-time CRLF++obs-resent-to = "Resent-To" *WSP ":" address-list CRLF++obs-resent-cc = "Resent-Cc" *WSP ":" address-list CRLF++obs-resent-bcc = "Resent-Bcc" *WSP ":"+ (address-list / [CFWS]) CRLF++obs-resent-mid = "Resent-Message-ID" *WSP ":" msg-id CRLF++obs-resent-rply = "Resent-Reply-To" *WSP ":" address-list CRLF++ As with other resent fields, the "Resent-Reply-To:" field is to be+ treated as trace information only.++4.5.7. Obsolete trace fields++ The obs-return and obs-received are again given here as template+ definitions, just as return and received are in section 3. Their+ full syntax is given in [RFC2821].++obs-return = "Return-Path" *WSP ":" path CRLF++obs-received = "Received" *WSP ":" name-val-list CRLF++obs-path = obs-angle-addr++4.5.8. Obsolete optional fields++obs-optional = field-name *WSP ":" unstructured CRLF++5. Security Considerations++ Care needs to be taken when displaying messages on a terminal or+ terminal emulator. Powerful terminals may act on escape sequences+ and other combinations of ASCII control characters with a variety of+ consequences. They can remap the keyboard or permit other+ modifications to the terminal which could lead to denial of service+ or even damaged data. They can trigger (sometimes programmable)+ answerback messages which can allow a message to cause commands to be+ issued on the recipient's behalf. They can also effect the operation+ of terminal attached devices such as printers. Message viewers may+ wish to strip potentially dangerous terminal escape sequences from+ the message prior to display. However, other escape sequences appear+ in messages for useful purposes (cf. [RFC2045, RFC2046, RFC2047,+ RFC2048, RFC2049, ISO2022]) and therefore should not be stripped+ indiscriminately.++++Resnick Standards Track [Page 36]++RFC 2822 Internet Message Format April 2001+++ Transmission of non-text objects in messages raises additional+ security issues. These issues are discussed in [RFC2045, RFC2046,+ RFC2047, RFC2048, RFC2049].++ Many implementations use the "Bcc:" (blind carbon copy) field+ described in section 3.6.3 to facilitate sending messages to+ recipients without revealing the addresses of one or more of the+ addressees to the other recipients. Mishandling this use of "Bcc:"+ has implications for confidential information that might be revealed,+ which could eventually lead to security problems through knowledge of+ even the existence of a particular mail address. For example, if+ using the first method described in section 3.6.3, where the "Bcc:"+ line is removed from the message, blind recipients have no explicit+ indication that they have been sent a blind copy, except insofar as+ their address does not appear in the message header. Because of+ this, one of the blind addressees could potentially send a reply to+ all of the shown recipients and accidentally reveal that the message+ went to the blind recipient. When the second method from section+ 3.6.3 is used, the blind recipient's address appears in the "Bcc:"+ field of a separate copy of the message. If the "Bcc:" field sent+ contains all of the blind addressees, all of the "Bcc:" recipients+ will be seen by each "Bcc:" recipient. Even if a separate message is+ sent to each "Bcc:" recipient with only the individual's address,+ implementations still need to be careful to process replies to the+ message as per section 3.6.3 so as not to accidentally reveal the+ blind recipient to other recipients.++6. Bibliography++ [ASCII] American National Standards Institute (ANSI), Coded+ Character Set - 7-Bit American National Standard Code for+ Information Interchange, ANSI X3.4, 1986.++ [ISO2022] International Organization for Standardization (ISO),+ Information processing - ISO 7-bit and 8-bit coded+ character sets - Code extension techniques, Third edition+ - 1986-05-01, ISO 2022, 1986.++ [RFC822] Crocker, D., "Standard for the Format of ARPA Internet+ Text Messages", RFC 822, August 1982.++ [RFC2045] Freed, N. and N. Borenstein, "Multipurpose Internet Mail+ Extensions (MIME) Part One: Format of Internet Message+ Bodies", RFC 2045, November 1996.++ [RFC2046] Freed, N. and N. Borenstein, "Multipurpose Internet Mail+ Extensions (MIME) Part Two: Media Types", RFC 2046,+ November 1996.++++Resnick Standards Track [Page 37]++RFC 2822 Internet Message Format April 2001+++ [RFC2047] Moore, K., "Multipurpose Internet Mail Extensions (MIME)+ Part Three: Message Header Extensions for Non-ASCII Text",+ RFC 2047, November 1996.++ [RFC2048] Freed, N., Klensin, J. and J. Postel, "Multipurpose+ Internet Mail Extensions (MIME) Part Four: Format of+ Internet Message Bodies", RFC 2048, November 1996.++ [RFC2049] Freed, N. and N. Borenstein, "Multipurpose Internet Mail+ Extensions (MIME) Part Five: Conformance Criteria and+ Examples", RFC 2049, November 1996.++ [RFC2119] Bradner, S., "Key words for use in RFCs to Indicate+ Requirement Levels", BCP 14, RFC 2119, March 1997.++ [RFC2234] Crocker, D., Editor, and P. Overell, "Augmented BNF for+ Syntax Specifications: ABNF", RFC 2234, November 1997.++ [RFC2821] Klensin, J., Editor, "Simple Mail Transfer Protocol", RFC+ 2821, March 2001.++ [STD3] Braden, R., "Host Requirements", STD 3, RFC 1122 and RFC+ 1123, October 1989.++ [STD12] Mills, D., "Network Time Protocol", STD 12, RFC 1119,+ September 1989.++ [STD13] Mockapetris, P., "Domain Name System", STD 13, RFC 1034+ and RFC 1035, November 1987.++ [STD14] Partridge, C., "Mail Routing and the Domain System", STD+ 14, RFC 974, January 1986.++7. Editor's Address++ Peter W. Resnick+ QUALCOMM Incorporated+ 5775 Morehouse Drive+ San Diego, CA 92121-1714+ USA++ Phone: +1 858 651 4478+ Fax: +1 858 651 1102+ EMail: presnick@qualcomm.com++++++++Resnick Standards Track [Page 38]++RFC 2822 Internet Message Format April 2001+++8. Acknowledgements++ Many people contributed to this document. They included folks who+ participated in the Detailed Revision and Update of Messaging+ Standards (DRUMS) Working Group of the Internet Engineering Task+ Force (IETF), the chair of DRUMS, the Area Directors of the IETF, and+ people who simply sent their comments in via e-mail. The editor is+ deeply indebted to them all and thanks them sincerely. The below+ list includes everyone who sent e-mail concerning this document.+ Hopefully, everyone who contributed is named here:++ Matti Aarnio Barry Finkel Larry Masinter+ Tanaka Akira Erik Forsberg Denis McKeon+ Russ Allbery Chuck Foster William P McQuillan+ Eric Allman Paul Fox Alexey Melnikov+ Harald Tveit Alvestrand Klaus M. Frank Perry E. Metzger+ Ran Atkinson Ned Freed Steven Miller+ Jos Backus Jochen Friedrich Keith Moore+ Bruce Balden Randall C. Gellens John Gardiner Myers+ Dave Barr Sukvinder Singh Gill Chris Newman+ Alan Barrett Tim Goodwin John W. Noerenberg+ John Beck Philip Guenther Eric Norman+ J. Robert von Behren Tony Hansen Mike O'Dell+ Jos den Bekker John Hawkinson Larry Osterman+ D. J. Bernstein Philip Hazel Paul Overell+ James Berriman Kai Henningsen Jacob Palme+ Norbert Bollow Robert Herriot Michael A. Patton+ Raj Bose Paul Hethmon Uzi Paz+ Antony Bowesman Jim Hill Michael A. Quinlan+ Scott Bradner Paul E. Hoffman Eric S. Raymond+ Randy Bush Steve Hole Sam Roberts+ Tom Byrer Kari Hurtta Hugh Sasse+ Bruce Campbell Marco S. Hyman Bart Schaefer+ Larry Campbell Ofer Inbar Tom Scola+ W. J. Carpenter Olle Jarnefors Wolfgang Segmuller+ Michael Chapman Kevin Johnson Nick Shelness+ Richard Clayton Sudish Joseph John Stanley+ Maurizio Codogno Maynard Kang Einar Stefferud+ Jim Conklin Prabhat Keni Jeff Stephenson+ R. Kelley Cook John C. Klensin Bernard Stern+ Steve Coya Graham Klyne Peter Sylvester+ Mark Crispin Brad Knowles Mark Symons+ Dave Crocker Shuhei Kobayashi Eric Thomas+ Matt Curtin Peter Koch Lee Thompson+ Michael D'Errico Dan Kohn Karel De Vriendt+ Cyrus Daboo Christian Kuhtz Matthew Wall+ Jutta Degener Anand Kumria Rolf Weber+ Mark Delany Steen Larsen Brent B. Welch++++Resnick Standards Track [Page 39]++RFC 2822 Internet Message Format April 2001+++ Steve Dorner Eliot Lear Dan Wing+ Harold A. Driscoll Barry Leiba Jack De Winter+ Michael Elkins Jay Levitt Gregory J. Woodhouse+ Robert Elz Lars-Johan Liman Greg A. Woods+ Johnny Eriksson Charles Lindsey Kazu Yamamoto+ Erik E. Fair Pete Loshin Alain Zahm+ Roger Fajman Simon Lyall Jamie Zawinski+ Patrik Faltstrom Bill Manning Timothy S. Zurcher+ Claus Andre Farber John Martin+++++++++++++++++++++++++++++++++++++++++++Resnick Standards Track [Page 40]++RFC 2822 Internet Message Format April 2001+++Appendix A. Example messages++ This section presents a selection of messages. These are intended to+ assist in the implementation of this standard, but should not be+ taken as normative; that is to say, although the examples in this+ section were carefully reviewed, if there happens to be a conflict+ between these examples and the syntax described in sections 3 and 4+ of this document, the syntax in those sections is to be taken as+ correct.++ Messages are delimited in this section between lines of "----". The+ "----" lines are not part of the message itself.++A.1. Addressing examples++ The following are examples of messages that might be sent between two+ individuals.++A.1.1. A message from one person to another with simple addressing++ This could be called a canonical message. It has a single author,+ John Doe, a single recipient, Mary Smith, a subject, the date, a+ message identifier, and a textual message in the body.++----+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----++++++++++++++++++Resnick Standards Track [Page 41]++RFC 2822 Internet Message Format April 2001+++ If John's secretary Michael actually sent the message, though John+ was the author and replies to this message should go back to him, the+ sender field would be used:++----+From: John Doe <jdoe@machine.example>+Sender: Michael Jones <mjones@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----++A.1.2. Different types of mailboxes++ This message includes multiple addresses in the destination fields+ and also uses several different forms of addresses.++----+From: "Joe Q. Public" <john.q.public@example.com>+To: Mary Smith <mary@x.test>, jdoe@example.org, Who? <one@y.test>+Cc: <boss@nil.test>, "Giant; \"Big\" Box" <sysservices@example.net>+Date: Tue, 1 Jul 2003 10:52:37 +0200+Message-ID: <5678.21-Nov-1997@example.com>++Hi everyone.+----++ Note that the display names for Joe Q. Public and Giant; "Big" Box+ needed to be enclosed in double-quotes because the former contains+ the period and the latter contains both semicolon and double-quote+ characters (the double-quote characters appearing as quoted-pair+ construct). Conversely, the display name for Who? could appear+ without them because the question mark is legal in an atom. Notice+ also that jdoe@example.org and boss@nil.test have no display names+ associated with them at all, and jdoe@example.org uses the simpler+ address form without the angle brackets.++++++++++++Resnick Standards Track [Page 42]++RFC 2822 Internet Message Format April 2001+++A.1.3. Group addresses++----+From: Pete <pete@silly.example>+To: A Group:Chris Jones <c@a.test>,joe@where.test,John <jdoe@one.test>;+Cc: Undisclosed recipients:;+Date: Thu, 13 Feb 1969 23:32:54 -0330+Message-ID: <testabcd.1234@silly.example>++Testing.+----++ In this message, the "To:" field has a single group recipient named A+ Group which contains 3 addresses, and a "Cc:" field with an empty+ group recipient named Undisclosed recipients.++A.2. Reply messages++ The following is a series of three messages that make up a+ conversation thread between John and Mary. John firsts sends a+ message to Mary, Mary then replies to John's message, and then John+ replies to Mary's reply message.++ Note especially the "Message-ID:", "References:", and "In-Reply-To:"+ fields in each message.++----+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----++++++++++++++++Resnick Standards Track [Page 43]++RFC 2822 Internet Message Format April 2001+++ When sending replies, the Subject field is often retained, though+ prepended with "Re: " as described in section 3.6.5.++----+From: Mary Smith <mary@example.net>+To: John Doe <jdoe@machine.example>+Reply-To: "Mary Smith: Personal Account" <smith@home.example>+Subject: Re: Saying Hello+Date: Fri, 21 Nov 1997 10:01:10 -0600+Message-ID: <3456@example.net>+In-Reply-To: <1234@local.machine.example>+References: <1234@local.machine.example>++This is a reply to your hello.+----++ Note the "Reply-To:" field in the above message. When John replies+ to Mary's message above, the reply should go to the address in the+ "Reply-To:" field instead of the address in the "From:" field.++----+To: "Mary Smith: Personal Account" <smith@home.example>+From: John Doe <jdoe@machine.example>+Subject: Re: Saying Hello+Date: Fri, 21 Nov 1997 11:00:00 -0600+Message-ID: <abcd.1234@local.machine.tld>+In-Reply-To: <3456@example.net>+References: <1234@local.machine.example> <3456@example.net>++This is a reply to your reply.+----++A.3. Resent messages++ Start with the message that has been used as an example several+ times:++----+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----+++++Resnick Standards Track [Page 44]++RFC 2822 Internet Message Format April 2001+++ Say that Mary, upon receiving this message, wishes to send a copy of+ the message to Jane such that (a) the message would appear to have+ come straight from John; (b) if Jane replies to the message, the+ reply should go back to John; and (c) all of the original+ information, like the date the message was originally sent to Mary,+ the message identifier, and the original addressee, is preserved. In+ this case, resent fields are prepended to the message:++----+Resent-From: Mary Smith <mary@example.net>+Resent-To: Jane Brown <j-brown@other.example>+Resent-Date: Mon, 24 Nov 1997 14:22:01 -0800+Resent-Message-ID: <78910@example.net>+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----++ If Jane, in turn, wished to resend this message to another person,+ she would prepend her own set of resent header fields to the above+ and send that.++++++++++++++++++++++++++Resnick Standards Track [Page 45]++RFC 2822 Internet Message Format April 2001+++A.4. Messages with trace fields++ As messages are sent through the transport system as described in+ [RFC2821], trace fields are prepended to the message. The following+ is an example of what those trace fields might look like. Note that+ there is some folding white space in the first one since these lines+ can be long.++----+Received: from x.y.test+ by example.net+ via TCP+ with ESMTP+ id ABC12345+ for <mary@example.net>; 21 Nov 1997 10:05:43 -0600+Received: from machine.example by x.y.test; 21 Nov 1997 10:01:22 -0600+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: Fri, 21 Nov 1997 09:55:06 -0600+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----+++++++++++++++++++++++++++Resnick Standards Track [Page 46]++RFC 2822 Internet Message Format April 2001+++A.5. White space, comments, and other oddities++ White space, including folding white space, and comments can be+ inserted between many of the tokens of fields. Taking the example+ from A.1.3, white space and comments can be inserted into all of the+ fields.++----+From: Pete(A wonderful \) chap) <pete(his account)@silly.test(his host)>+To:A Group(Some people)+ :Chris Jones <c@(Chris's host.)public.example>,+ joe@example.org,+ John <jdoe@one.test> (my dear friend); (the end of the group)+Cc:(Empty list)(start)Undisclosed recipients :(nobody(that I know)) ;+Date: Thu,+ 13+ Feb+ 1969+ 23:32+ -0330 (Newfoundland Time)+Message-ID: <testabcd.1234@silly.test>++Testing.+----++ The above example is aesthetically displeasing, but perfectly legal.+ Note particularly (1) the comments in the "From:" field (including+ one that has a ")" character appearing as part of a quoted-pair); (2)+ the white space absent after the ":" in the "To:" field as well as+ the comment and folding white space after the group name, the special+ character (".") in the comment in Chris Jones's address, and the+ folding white space before and after "joe@example.org,"; (3) the+ multiple and nested comments in the "Cc:" field as well as the+ comment immediately following the ":" after "Cc"; (4) the folding+ white space (but no comments except at the end) and the missing+ seconds in the time of the date field; and (5) the white space before+ (but not within) the identifier in the "Message-ID:" field.++A.6. Obsoleted forms++ The following are examples of obsolete (that is, the "MUST NOT+ generate") syntactic elements described in section 4 of this+ document.+++++++++Resnick Standards Track [Page 47]++RFC 2822 Internet Message Format April 2001+++A.6.1. Obsolete addressing++ Note in the below example the lack of quotes around Joe Q. Public,+ the route that appears in the address for Mary Smith, the two commas+ that appear in the "To:" field, and the spaces that appear around the+ "." in the jdoe address.++----+From: Joe Q. Public <john.q.public@example.com>+To: Mary Smith <@machine.tld:mary@example.net>, , jdoe@test . example+Date: Tue, 1 Jul 2003 10:52:37 +0200+Message-ID: <5678.21-Nov-1997@example.com>++Hi everyone.+----++A.6.2. Obsolete dates++ The following message uses an obsolete date format, including a non-+ numeric time zone and a two digit year. Note that although the+ day-of-week is missing, that is not specific to the obsolete syntax;+ it is optional in the current syntax as well.++----+From: John Doe <jdoe@machine.example>+To: Mary Smith <mary@example.net>+Subject: Saying Hello+Date: 21 Nov 97 09:55:06 GMT+Message-ID: <1234@local.machine.example>++This is a message just to say hello.+So, "Hello".+----++A.6.3. Obsolete white space and comments++ White space and comments can appear between many more elements than+ in the current syntax. Also, folding lines that are made up entirely+ of white space are legal.+++++++++++++Resnick Standards Track [Page 48]++RFC 2822 Internet Message Format April 2001+++----+From : John Doe <jdoe@machine(comment). example>+To : Mary Smith+__+ <mary@example.net>+Subject : Saying Hello+Date : Fri, 21 Nov 1997 09(comment): 55 : 06 -0600+Message-ID : <1234 @ local(blah) .machine .example>++This is a message just to say hello.+So, "Hello".+----++ Note especially the second line of the "To:" field. It starts with+ two space characters. (Note that "__" represent blank spaces.)+ Therefore, it is considered part of the folding as described in+ section 4.2. Also, the comments and white space throughout+ addresses, dates, and message identifiers are all part of the+ obsolete syntax.++Appendix B. Differences from earlier standards++ This appendix contains a list of changes that have been made in the+ Internet Message Format from earlier standards, specifically [RFC822]+ and [STD3]. Items marked with an asterisk (*) below are items which+ appear in section 4 of this document and therefore can no longer be+ generated.++ 1. Period allowed in obsolete form of phrase.+ 2. ABNF moved out of document to [RFC2234].+ 3. Four or more digits allowed for year.+ 4. Header field ordering (and lack thereof) made explicit.+ 5. Encrypted header field removed.+ 6. Received syntax loosened to allow any token/value pair.+ 7. Specifically allow and give meaning to "-0000" time zone.+ 8. Folding white space is not allowed between every token.+ 9. Requirement for destinations removed.+ 10. Forwarding and resending redefined.+ 11. Extension header fields no longer specifically called out.+ 12. ASCII 0 (null) removed.*+ 13. Folding continuation lines cannot contain only white space.*+ 14. Free insertion of comments not allowed in date.*+ 15. Non-numeric time zones not allowed.*+ 16. Two digit years not allowed.*+ 17. Three digit years interpreted, but not allowed for generation.+ 18. Routes in addresses not allowed.*+ 19. CFWS within local-parts and domains not allowed.*+ 20. Empty members of address lists not allowed.*++++Resnick Standards Track [Page 49]++RFC 2822 Internet Message Format April 2001+++ 21. Folding white space between field name and colon not allowed.*+ 22. Comments between field name and colon not allowed.+ 23. Tightened syntax of in-reply-to and references.*+ 24. CFWS within msg-id not allowed.*+ 25. Tightened semantics of resent fields as informational only.+ 26. Resent-Reply-To not allowed.*+ 27. No multiple occurrences of fields (except resent and received).*+ 28. Free CR and LF not allowed.*+ 29. Routes in return path not allowed.*+ 30. Line length limits specified.+ 31. Bcc more clearly specified.++Appendix C. Notices++ Intellectual Property++ The IETF takes no position regarding the validity or scope of any+ intellectual property or other rights that might be claimed to+ pertain to the implementation or use of the technology described in+ this document or the extent to which any license under such rights+ might or might not be available; neither does it represent that it+ has made any effort to identify any such rights. Information on the+ IETF's procedures with respect to rights in standards-track and+ standards-related documentation can be found in BCP-11. Copies of+ claims of rights made available for publication and any assurances of+ licenses to be made available, or the result of an attempt made to+ obtain a general license or permission for the use of such+ proprietary rights by implementors or users of this specification can+ be obtained from the IETF Secretariat.+++++++++++++++++++++++Resnick Standards Track [Page 50]++RFC 2822 Internet Message Format April 2001+++Full Copyright Statement++ Copyright (C) The Internet Society (2001). All Rights Reserved.++ This document and translations of it may be copied and furnished to+ others, and derivative works that comment on or otherwise explain it+ or assist in its implementation may be prepared, copied, published+ and distributed, in whole or in part, without restriction of any+ kind, provided that the above copyright notice and this paragraph are+ included on all such copies and derivative works. However, this+ document itself may not be modified in any way, such as by removing+ the copyright notice or references to the Internet Society or other+ Internet organizations, except as needed for the purpose of+ developing Internet standards in which case the procedures for+ copyrights defined in the Internet Standards process must be+ followed, or as required to translate it into languages other than+ English.++ The limited permissions granted above are perpetual and will not be+ revoked by the Internet Society or its successors or assigns.++ This document and the information contained herein is provided on an+ "AS IS" basis and THE INTERNET SOCIETY AND THE INTERNET ENGINEERING+ TASK FORCE DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING+ BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION+ HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF+ MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.++Acknowledgement++ Funding for the RFC Editor function is currently provided by the+ Internet Society.+++
src/Data/Concrete/Parsers/Types.hs view
@@ -2,6 +2,8 @@ module Data.Concrete.Parsers.Types ( Bookkeeper(..) , CommunicationParser , CommunicationAction+ , PathComponent(..)+ , Path ) where import Data.Text.Lazy (Text)@@ -14,7 +16,40 @@ -- | A 'CommunicationAction' gets called on each Communication -- as parsing proceeds type CommunicationAction = Communication -> IO ()- ++-- | A 'PathComponent' represents one step in navigating a parse+-- tree. The meaning will be format-specific: a "step" could+-- correspond to any number of parse rules. See the definition+-- of 'Path' for an example.+data PathComponent = Index Int -- ^ An index into an anonymous sequence of successors of a path+ | Name String -- ^ The name of an identifiable successor of a path++-- | A 'Path' is a sequence of 'PathComponent's that identifies+-- a particular location in the document being parsed, usually+-- the *current* location, as a sequence of indices and strings.+-- Think of it as the sequence of values you would use to+-- index a Python-style object of nested dictionaries and lists.+-- The meaning of the indices and strings depends on the format+-- being parsed: for example, in parsing this HTML:+--+-- > <list id="abc">+-- > <li>one</li>+-- > <li style="final">two</li>+-- > </list>+--+-- If we treat the "list" element as the top-level object, we+-- might, as we parse the document, generate the paths:+--+-- > [Name "id"]+-- > [Index 1]+-- > [Index 2]+-- > [Index 2, Name "style"]+--+-- The trick is to take a parser for a data format, and augment+-- the rules so that the current 'Path' is always correct and+-- meaningful.+type Path = [PathComponent]+ -- | A 'Bookkeeper' tracks information about an ongoing attempt -- to parse a Text stream into Communication objects. data Bookkeeper = Bookkeeper { communication :: Communication@@ -25,8 +60,13 @@ , contentSections :: [String] , commId :: Text , commType :: String+ , commNum :: Int } +-- | A StatefulParser is just a Megaparsec Parser that carries+-- a State, and has access to the IO monad.+type StatefulParser s a = ParsecT Dec Text (StateT s IO) a+ -- | A 'CommunicationParser' is a stateful Megaparsec parser that, as it -- processes a Text stream, builds a list of Concrete Communications.-type CommunicationParser a = ParsecT Dec Text (StateT Bookkeeper IO) a+type CommunicationParser a = StatefulParser Bookkeeper a
src/Data/Concrete/Parsers/Utils.hs view
@@ -1,6 +1,14 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Data.Concrete.Parsers.Utils ( communicationRule , sectionRule+ , pathDictionaryRule+ , pathDictionaryKeyRule + , pathArrayRule+ , pathArrayEntryRule+ , pushPathComponent+ , popPathComponent+ , modifyPathComponent+ , incrementPathComponent , Located(..) ) where @@ -12,22 +20,22 @@ import Text.Megaparsec.Error (Dec) import Data.Map (Map) import qualified Data.Map as Map-import Control.Monad.State (State, get, put)+import Control.Monad.State (State, get, put, modify, modify') import Data.Concrete (default_Communication, Communication(..), default_Section, Section(..), default_TextSpan, TextSpan(..)) import Data.Concrete.Utils (getUUID, createAnnotationMetadata) import Control.Monad.IO.Class (liftIO) import Data.Vector (Vector, fromList, snoc, empty, cons, toList) import Data.Maybe (fromJust)+import Text.Printf (printf) substr :: T.Text -> Int -> Int -> String substr t s e = T.unpack res where- (_, start) = T.splitAt (fromIntegral s) t + (_, start) = T.splitAt (fromIntegral s) t res = T.take (fromIntegral $ e - s) start --makeId :: [(Text, Text)] -> Text -> Text-makeId ss i = foldr (\ (a, b) x -> T.replace (T.concat ["${", a, "}"]) b x) i ss+makeId :: [(Text, Text)] -> Text -> Int -> Text+makeId ss i n = foldr (\ (a, b) x -> T.replace (T.concat ["${", a, "}"]) b x) i (("", (pack . show) n):ss) communicationRule :: (Communication -> Communication) -> CommunicationParser a -> CommunicationParser a communicationRule tr p = do@@ -46,13 +54,87 @@ c = communication { communication_metadata=m , communication_text=Just $ pack t , communication_uuid=u- , communication_id=makeId sectionVals commId+ , communication_id=makeId sectionVals commId commNum , communication_sectionList=Just $ fromList sections' }- put $ bs { communication=default_Communication { communication_sectionList=Just empty }, valueMap=Map.fromList [], sections=[] }+ put $ bs { communication=default_Communication { communication_sectionList=Just empty }, valueMap=Map.fromList [], sections=[], commNum=commNum + 1 } liftIO $ action (tr c)+ clearState return o +clearState :: CommunicationParser ()+clearState = do+ bs <- get+ let s = bs { communication=default_Communication { communication_sectionList=Just empty }+ , sections=[]+ , path=[]+ }+ put s+ return ()++--pathArrayRule :: CommunicationParser a -> CommunicationParser a+--pathArrayRule p = p+ +pathArrayRule :: CommunicationParser a -> CommunicationParser a+pathArrayRule p = do+ pushPathComponent (show (-1))+ r <- p+ popPathComponent+ return r++-- pathArrayEntryRule :: CommunicationParser a -> CommunicationParser a+-- pathArrayEntryRule p = p++pathArrayEntryRule :: CommunicationParser a -> CommunicationParser a+pathArrayEntryRule p = do+ incrementPathComponent+ p++pathDictionaryRule :: CommunicationParser a -> CommunicationParser a+pathDictionaryRule p = do+ pushPathComponent "PLACEHOLDER"+ (m, r) <- match p+ t' <- popPathComponent+ return r++pathDictionaryKeyRule :: CommunicationParser String -> CommunicationParser String+pathDictionaryKeyRule p = do+ t' <- p+ modifyPathComponent (\x -> t')+ return ""++pushPathComponent :: String -> CommunicationParser ()+pushPathComponent s = do+ Bookkeeper{..} <- get+ --liftIO $ print ("starting component") -- , s, path)+ modify (\ bs -> bs { path=s:path })+ return ()++popPathComponent :: CommunicationParser String+popPathComponent = do+ Bookkeeper{..} <- get+ let (p:ps) = path+ --liftIO $ print ("ending component", p) --, ps)+ modify (\ bs -> bs { path=ps })+ return p++modifyPathComponent :: (String -> String) -> CommunicationParser ()+modifyPathComponent f = do+ Bookkeeper{..} <- get+ let (p:ps) = path+ p' = f p+ --liftIO $ print ("modifying component", p, "to", p') -- , ps)+ modify (\ bs -> bs { path=p':ps })+ return ()++incrementPathComponent :: CommunicationParser Int+incrementPathComponent = do+ Bookkeeper{..} <- get+ let p = (read $ head path) :: Int+ p' = p + 1+ modify (\ bs -> bs { path=(show p'):(tail path) })+ return p'+ sectionRule :: (Section -> Section) -> CommunicationParser a -> CommunicationParser a sectionRule t p = do s <- (fromIntegral . stateTokensProcessed) <$> getParserState@@ -65,11 +147,11 @@ } if length path == 0 then- return ()+ return () else- put $ bs { communication=communication { communication_sectionList=(cons section) <$> (communication_sectionList communication) } }+ put $ bs { communication=communication { communication_sectionList=(cons section) <$> (communication_sectionList communication) } } return v-+ class Located a where getTextSpan :: a -> TextSpan setTextSpan :: TextSpan -> a -> a
src/Data/Concrete/Parsers/XML.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-} module Data.Concrete.Parsers.XML- ( arrayOfObjectsP+ ( parser ) where+-- https://www.w3.org/TR/REC-xml/ import Data.List (intercalate) import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)@@ -33,6 +34,7 @@ , runParserT' , State(..) , getParserState+ , many ) import Text.Megaparsec.Text.Lazy (Parser)@@ -41,66 +43,132 @@ import qualified Control.Monad.Identity as I import Data.Concrete.Types import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)- -arrayOfObjectsP :: ParsecT Dec Text (S.StateT Bookkeeper IO) ()-arrayOfObjectsP = brackets ((communicationRule id objectP) `sepBy` comma) >> return () -jsonP = sectionRule id jsonP'--jsonP' = lexeme' $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]- -nullP = symbol' "null" >> return ()- -boolP = (symbol' "true" <|> symbol' "false") >> return ()- -numberP = signed space number >> return ()--stringP = pack <$> stringLiteral >> return ()--objectP = Map.fromList <$> braces (pairP `sepBy` comma) >> return ()--arrayEntryP = do- bs@(Bookkeeper{..}) <- S.get- let p = (read $ head path) :: Int- S.put $ bs { path=(show (p + 1)):(tail path) } - jsonP- return ()- -escapedChar = do- char '\\'- choice [ char '\"' $> '\"'- , char '\\' $> '\\'- , char '/' $> '/'- , char 'n' $> '\n'- , char 'r' $> '\r'- , char 'f' $> '\f'- , char 't' $> '\t'- , char 'b' $> '\b'- , unicodeEscape- ]--unicodeEscape = char 'u' >> count 4 hexDigitChar >>= (\code -> return $ toEnum (read ("0x" ++ code)))--stringLiteral = lexeme' $ do - char '\"'- (escapedChar <|> anyChar) `manyTill` char '\"'--arrayP = do- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=(show (-1)):path })- c <- brackets (arrayEntryP `sepBy` comma)- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return ()+parser :: CommunicationParser ()+parser = document >> return () -pairP = do- key <- stringLiteral- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=key:path })- symbol' ":"- value <- jsonP- S.modify' (\ bs@(Bookkeeper{..}) -> bs { path=tail path})- return (key, value)+document = many anyChar+ --prolog element (many misc) -lexeme' = lexeme space-symbol' = symbol space-brackets = between (symbol' "[") (symbol' "]")-braces = between (symbol' "{") (symbol' "}")-comma = symbol' ","+-- Char = #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]+-- White Space+-- [3] S ::= (#x20 | #x9 | #xD | #xA)++-- Names and Tokens+-- [4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender+-- [5] Name ::= (Letter | '_' | ':') (NameChar)*+-- [6] Names ::= Name (S Name)*+-- [7] Nmtoken ::= (NameChar)++-- [8] Nmtokens ::= Nmtoken (S Nmtoken)*+-- Literals+-- [9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' | "'" ([^%&'] | PEReference | Reference)* "'"+-- [10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"+-- [11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'")+-- [12] PubidLiteral ::= '"' PubidChar* '"' | "'" (PubidChar - "'")* "'"+-- [13] PubidChar ::= #x20 | #xD | #xA | [a-zA-Z0-9] | [-'()+,./:=?;!*#@$_%]+-- Character Data+-- [14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)+-- Comments+-- [15] Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'+-- Processing Instructions+-- [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'+-- [17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))+-- CDATA Sections+-- [18] CDSect ::= CDStart CData CDEnd+-- [19] CDStart ::= '<![CDATA['+-- [20] CData ::= (Char* - (Char* ']]>' Char*))+-- [21] CDEnd ::= ']]>'+-- Prolog+-- [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?+-- [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'+-- [24] VersionInfo ::= S 'version' Eq (' VersionNum ' | " VersionNum ")+-- [25] Eq ::= S? '=' S?+-- [26] VersionNum ::= ([a-zA-Z0-9_.:] | '-')++-- [27] Misc ::= Comment | PI | S+-- Document Type Definition+-- [28] doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'+-- [29] markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment+-- External Subset+-- [30] extSubset ::= TextDecl? extSubsetDecl+-- [31] extSubsetDecl ::= ( markupdecl | conditionalSect | PEReference | S )*+-- Standalone Document Declaration+-- [32] SDDecl ::= S 'standalone' Eq (("'" ('yes' | 'no') "'") | ('"' ('yes' | 'no') '"'))+-- Language Identification+-- [33] LanguageID ::= Langcode ('-' Subcode)*+-- [34] Langcode ::= ISO639Code | IanaCode | UserCode+-- [35] ISO639Code ::= ([a-z] | [A-Z]) ([a-z] | [A-Z])+-- [36] IanaCode ::= ('i' | 'I') '-' ([a-z] | [A-Z])++-- [37] UserCode ::= ('x' | 'X') '-' ([a-z] | [A-Z])++-- [38] Subcode ::= ([a-z] | [A-Z])++-- Element+-- [39] element ::= EmptyElemTag | STag content ETag+-- Start-tag+-- [40] STag ::= '<' Name (S Attribute)* S? '>'+-- [41] Attribute ::= Name Eq AttValue+-- End-tag+-- [42] ETag ::= '</' Name S? '>'+-- Content of Elements+-- [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*+-- Tags for Empty Elements+-- [44] EmptyElemTag ::= '<' Name (S Attribute)* S? '/>'+-- Element Type Declaration+-- [45] elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'+-- [46] contentspec ::= 'EMPTY' | 'ANY' | Mixed | children+-- Element-content Models+-- [47] children ::= (choice | seq) ('?' | '*' | '+')?+-- [48] cp ::= (Name | choice | seq) ('?' | '*' | '+')?+-- [49] choice ::= '(' S? cp ( S? '|' S? cp )* S? ')'+-- [50] seq ::= '(' S? cp ( S? ',' S? cp )* S? ')'+-- Mixed-content Declaration+-- [51] Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | '(' S? '#PCDATA' S? ')'+-- Attribute-list Declaration+-- [52] AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'+-- [53] AttDef ::= S Name S AttType S DefaultDecl+-- Attribute Types+-- [54] AttType ::= StringType | TokenizedType | EnumeratedType+-- [55] StringType ::= 'CDATA'+-- [56] TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'+-- Enumerated Attribute Types+-- [57] EnumeratedType ::= NotationType | Enumeration+-- [58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'+-- [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'+-- Attribute Defaults+-- [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)+-- Conditional Section+-- [61] conditionalSect ::= includeSect | ignoreSect+-- [62] includeSect ::= '<![' S? 'INCLUDE' S? '[' extSubsetDecl ']]>'+-- [63] ignoreSect ::= '<![' S? 'IGNORE' S? '[' ignoreSectContents* ']]>'+-- [64] ignoreSectContents ::= Ignore ('<![' ignoreSectContents ']]>' Ignore)*+-- [65] Ignore ::= Char* - (Char* ('<![' | ']]>') Char*)+-- Character Reference+-- [66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'+-- Entity Reference+-- [67] Reference ::= EntityRef | CharRef+-- [68] EntityRef ::= '&' Name ';'+-- [69] PEReference ::= '%' Name ';'+-- Entity Declaration+-- [70] EntityDecl ::= GEDecl | PEDecl+-- [71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'+-- [72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'+-- [73] EntityDef ::= EntityValue | (ExternalID NDataDecl?)+-- [74] PEDef ::= EntityValue | ExternalID+-- External Entity Declaration+-- [75] ExternalID ::= 'SYSTEM' S SystemLiteral | 'PUBLIC' S PubidLiteral S SystemLiteral+-- [76] NDataDecl ::= S 'NDATA' S Name+-- Text Declaration+-- [77] TextDecl ::= '<?xml' VersionInfo? EncodingDecl S? '?>'+-- Well-Formed External Parsed Entity+-- [78] extParsedEnt ::= TextDecl? content+-- [79] extPE ::= TextDecl? extSubsetDecl+-- Encoding Declaration+-- [80] EncodingDecl ::= S 'encoding' Eq ('"' EncName '"' | "'" EncName "'" ) +-- [81] EncName ::= [A-Za-z] ([A-Za-z0-9._] | '-')* /* Encoding name contains only Latin characters */+-- Notation Declarations+-- [82] NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'+-- [83] PublicID ::= 'PUBLIC' S PubidLiteral+-- Characters+-- [84] Letter ::= BaseChar | Ideographic+-- [85] BaseChar ::= [#x0041-#x005A] | [#x0061-#x007A] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x00FF] | [#x0100-#x0131] | [#x0134-#x013E] | [#x0141-#x0148] | [#x014A-#x017E] | [#x0180-#x01C3] | [#x01CD-#x01F0] | [#x01F4-#x01F5] | [#x01FA-#x0217] | [#x0250-#x02A8] | [#x02BB-#x02C1] | #x0386 | [#x0388-#x038A] | #x038C | [#x038E-#x03A1] | [#x03A3-#x03CE] | [#x03D0-#x03D6] | #x03DA | #x03DC | #x03DE | #x03E0 | [#x03E2-#x03F3] | [#x0401-#x040C] | [#x040E-#x044F] | [#x0451-#x045C] | [#x045E-#x0481] | [#x0490-#x04C4] | [#x04C7-#x04C8] | [#x04CB-#x04CC] | [#x04D0-#x04EB] | [#x04EE-#x04F5] | [#x04F8-#x04F9] | [#x0531-#x0556] | #x0559 | [#x0561-#x0586] | [#x05D0-#x05EA] | [#x05F0-#x05F2] | [#x0621-#x063A] | [#x0641-#x064A] | [#x0671-#x06B7] | [#x06BA-#x06BE] | [#x06C0-#x06CE] | [#x06D0-#x06D3] | #x06D5 | [#x06E5-#x06E6] | [#x0905-#x0939] | #x093D | [#x0958-#x0961] | [#x0985-#x098C] | [#x098F-#x0990] | [#x0993-#x09A8] | [#x09AA-#x09B0] | #x09B2 | [#x09B6-#x09B9] | [#x09DC-#x09DD] | [#x09DF-#x09E1] | [#x09F0-#x09F1] | [#x0A05-#x0A0A] | [#x0A0F-#x0A10] | [#x0A13-#x0A28] | [#x0A2A-#x0A30] | [#x0A32-#x0A33] | [#x0A35-#x0A36] | [#x0A38-#x0A39] | [#x0A59-#x0A5C] | #x0A5E | [#x0A72-#x0A74] | [#x0A85-#x0A8B] | #x0A8D | [#x0A8F-#x0A91] | [#x0A93-#x0AA8] | [#x0AAA-#x0AB0] | [#x0AB2-#x0AB3] | [#x0AB5-#x0AB9] | #x0ABD | #x0AE0 | [#x0B05-#x0B0C] | [#x0B0F-#x0B10] | [#x0B13-#x0B28] | [#x0B2A-#x0B30] | [#x0B32-#x0B33] | [#x0B36-#x0B39] | #x0B3D | [#x0B5C-#x0B5D] | [#x0B5F-#x0B61] | [#x0B85-#x0B8A] | [#x0B8E-#x0B90] | [#x0B92-#x0B95] | [#x0B99-#x0B9A] | #x0B9C | [#x0B9E-#x0B9F] | [#x0BA3-#x0BA4] | [#x0BA8-#x0BAA] | [#x0BAE-#x0BB5] | [#x0BB7-#x0BB9] | [#x0C05-#x0C0C] | [#x0C0E-#x0C10] | [#x0C12-#x0C28] | [#x0C2A-#x0C33] | [#x0C35-#x0C39] | [#x0C60-#x0C61] | [#x0C85-#x0C8C] | [#x0C8E-#x0C90] | [#x0C92-#x0CA8] | [#x0CAA-#x0CB3] | [#x0CB5-#x0CB9] | #x0CDE | [#x0CE0-#x0CE1] | [#x0D05-#x0D0C] | [#x0D0E-#x0D10] | [#x0D12-#x0D28] | [#x0D2A-#x0D39] | [#x0D60-#x0D61] | [#x0E01-#x0E2E] | #x0E30 | [#x0E32-#x0E33] | [#x0E40-#x0E45] | [#x0E81-#x0E82] | #x0E84 | [#x0E87-#x0E88] | #x0E8A | #x0E8D | [#x0E94-#x0E97] | [#x0E99-#x0E9F] | [#x0EA1-#x0EA3] | #x0EA5 | #x0EA7 | [#x0EAA-#x0EAB] | [#x0EAD-#x0EAE] | #x0EB0 | [#x0EB2-#x0EB3] | #x0EBD | [#x0EC0-#x0EC4] | [#x0F40-#x0F47] | [#x0F49-#x0F69] | [#x10A0-#x10C5] | [#x10D0-#x10F6] | #x1100 | [#x1102-#x1103] | [#x1105-#x1107] | #x1109 | [#x110B-#x110C] | [#x110E-#x1112] | #x113C | #x113E | #x1140 | #x114C | #x114E | #x1150 | [#x1154-#x1155] | #x1159 | [#x115F-#x1161] | #x1163 | #x1165 | #x1167 | #x1169 | [#x116D-#x116E] | [#x1172-#x1173] | #x1175 | #x119E | #x11A8 | #x11AB | [#x11AE-#x11AF] | [#x11B7-#x11B8] | #x11BA | [#x11BC-#x11C2] | #x11EB | #x11F0 | #x11F9 | [#x1E00-#x1E9B] | [#x1EA0-#x1EF9] | [#x1F00-#x1F15] | [#x1F18-#x1F1D] | [#x1F20-#x1F45] | [#x1F48-#x1F4D] | [#x1F50-#x1F57] | #x1F59 | #x1F5B | #x1F5D | [#x1F5F-#x1F7D] | [#x1F80-#x1FB4] | [#x1FB6-#x1FBC] | #x1FBE | [#x1FC2-#x1FC4] | [#x1FC6-#x1FCC] | [#x1FD0-#x1FD3] | [#x1FD6-#x1FDB] | [#x1FE0-#x1FEC] | [#x1FF2-#x1FF4] | [#x1FF6-#x1FFC] | #x2126 | [#x212A-#x212B] | #x212E | [#x2180-#x2182] | [#x3041-#x3094] | [#x30A1-#x30FA] | [#x3105-#x312C] | [#xAC00-#xD7A3]+-- [86] Ideographic ::= [#x4E00-#x9FA5] | #x3007 | [#x3021-#x3029]+-- [87] CombiningChar ::= [#x0300-#x0345] | [#x0360-#x0361] | [#x0483-#x0486] | [#x0591-#x05A1] | [#x05A3-#x05B9] | [#x05BB-#x05BD] | #x05BF | [#x05C1-#x05C2] | #x05C4 | [#x064B-#x0652] | #x0670 | [#x06D6-#x06DC] | [#x06DD-#x06DF] | [#x06E0-#x06E4] | [#x06E7-#x06E8] | [#x06EA-#x06ED] | [#x0901-#x0903] | #x093C | [#x093E-#x094C] | #x094D | [#x0951-#x0954] | [#x0962-#x0963] | [#x0981-#x0983] | #x09BC | #x09BE | #x09BF | [#x09C0-#x09C4] | [#x09C7-#x09C8] | [#x09CB-#x09CD] | #x09D7 | [#x09E2-#x09E3] | #x0A02 | #x0A3C | #x0A3E | #x0A3F | [#x0A40-#x0A42] | [#x0A47-#x0A48] | [#x0A4B-#x0A4D] | [#x0A70-#x0A71] | [#x0A81-#x0A83] | #x0ABC | [#x0ABE-#x0AC5] | [#x0AC7-#x0AC9] | [#x0ACB-#x0ACD] | [#x0B01-#x0B03] | #x0B3C | [#x0B3E-#x0B43] | [#x0B47-#x0B48] | [#x0B4B-#x0B4D] | [#x0B56-#x0B57] | [#x0B82-#x0B83] | [#x0BBE-#x0BC2] | [#x0BC6-#x0BC8] | [#x0BCA-#x0BCD] | #x0BD7 | [#x0C01-#x0C03] | [#x0C3E-#x0C44] | [#x0C46-#x0C48] | [#x0C4A-#x0C4D] | [#x0C55-#x0C56] | [#x0C82-#x0C83] | [#x0CBE-#x0CC4] | [#x0CC6-#x0CC8] | [#x0CCA-#x0CCD] | [#x0CD5-#x0CD6] | [#x0D02-#x0D03] | [#x0D3E-#x0D43] | [#x0D46-#x0D48] | [#x0D4A-#x0D4D] | #x0D57 | #x0E31 | [#x0E34-#x0E3A] | [#x0E47-#x0E4E] | #x0EB1 | [#x0EB4-#x0EB9] | [#x0EBB-#x0EBC] | [#x0EC8-#x0ECD] | [#x0F18-#x0F19] | #x0F35 | #x0F37 | #x0F39 | #x0F3E | #x0F3F | [#x0F71-#x0F84] | [#x0F86-#x0F8B] | [#x0F90-#x0F95] | #x0F97 | [#x0F99-#x0FAD] | [#x0FB1-#x0FB7] | #x0FB9 | [#x20D0-#x20DC] | #x20E1 | [#x302A-#x302F] | #x3099 | #x309A+-- [88] Digit ::= [#x0030-#x0039] | [#x0660-#x0669] | [#x06F0-#x06F9] | [#x0966-#x096F] | [#x09E6-#x09EF] | [#x0A66-#x0A6F] | [#x0AE6-#x0AEF] | [#x0B66-#x0B6F] | [#x0BE7-#x0BEF] | [#x0C66-#x0C6F] | [#x0CE6-#x0CEF] | [#x0D66-#x0D6F] | [#x0E50-#x0E59] | [#x0ED0-#x0ED9] | [#x0F20-#x0F29]+-- [89] Extender ::= #x00B7 | #x02D0 | #x02D1 | #x0387 | #x0640 | #x0E46 | #x0EC6 | #x3005 | [#x3031-#x3035] | [#x309D-#x309E] | [#x30FC-#x30FE]
+ src/Data/Concrete/Services/ActiveLearnerClientService.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerClientService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import qualified Service+import Learn_Types+import qualified ActiveLearnerClientService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data SubmitSort_args = SubmitSort_args { submitSort_args_sessionId :: Uuid_Types.UUID+ , submitSort_args_unitIds :: (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitSort_args where+ hashWithSalt salt record = salt `H.hashWithSalt` submitSort_args_sessionId record `H.hashWithSalt` submitSort_args_unitIds record +instance QC.Arbitrary SubmitSort_args where + arbitrary = M.liftM SubmitSort_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SubmitSort_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitSort_args{submitSort_args_sessionId = submitSort_args_sessionId obj} then P.Nothing else P.Just $ default_SubmitSort_args{submitSort_args_sessionId = submitSort_args_sessionId obj}+ , if obj == default_SubmitSort_args{submitSort_args_unitIds = submitSort_args_unitIds obj} then P.Nothing else P.Just $ default_SubmitSort_args{submitSort_args_unitIds = submitSort_args_unitIds obj}+ ]+from_SubmitSort_args :: SubmitSort_args -> T.ThriftVal+from_SubmitSort_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v63 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v63))) $ submitSort_args_sessionId record+ , (\_v63 -> P.Just (2, ("unitIds",T.TList (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier) $ P.map (\_v65 -> Services_Types.from_AnnotationUnitIdentifier _v65) $ Vector.toList _v63))) $ submitSort_args_unitIds record+ ]+write_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_args -> P.IO ()+write_SubmitSort_args oprot record = T.writeVal oprot $ from_SubmitSort_args record+encode_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_args -> LBS.ByteString+encode_SubmitSort_args oprot record = T.serializeVal oprot $ from_SubmitSort_args record+to_SubmitSort_args :: T.ThriftVal -> SubmitSort_args+to_SubmitSort_args (T.TStruct fields) = SubmitSort_args{+ submitSort_args_sessionId = P.maybe (submitSort_args_sessionId default_SubmitSort_args) (\(_,_val67) -> (case _val67 of {T.TStruct _val68 -> (Uuid_Types.to_UUID (T.TStruct _val68)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ submitSort_args_unitIds = P.maybe (submitSort_args_unitIds default_SubmitSort_args) (\(_,_val67) -> (case _val67 of {T.TList _ _val69 -> (Vector.fromList $ P.map (\_v70 -> (case _v70 of {T.TStruct _val71 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val71)); _ -> P.error "wrong type"})) _val69); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_SubmitSort_args _ = P.error "not a struct"+read_SubmitSort_args :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitSort_args+read_SubmitSort_args iprot = to_SubmitSort_args <$> T.readVal iprot (T.T_STRUCT typemap_SubmitSort_args)+decode_SubmitSort_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitSort_args+decode_SubmitSort_args iprot bs = to_SubmitSort_args $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitSort_args) bs+typemap_SubmitSort_args :: T.TypeMap+typemap_SubmitSort_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("unitIds",(T.T_LIST (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier))))]+default_SubmitSort_args :: SubmitSort_args+default_SubmitSort_args = SubmitSort_args{+ submitSort_args_sessionId = Uuid_Types.default_UUID,+ submitSort_args_unitIds = Vector.empty}+data SubmitSort_result = SubmitSort_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitSort_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary SubmitSort_result where + arbitrary = QC.elements [SubmitSort_result]+from_SubmitSort_result :: SubmitSort_result -> T.ThriftVal+from_SubmitSort_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_result -> P.IO ()+write_SubmitSort_result oprot record = T.writeVal oprot $ from_SubmitSort_result record+encode_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> SubmitSort_result -> LBS.ByteString+encode_SubmitSort_result oprot record = T.serializeVal oprot $ from_SubmitSort_result record+to_SubmitSort_result :: T.ThriftVal -> SubmitSort_result+to_SubmitSort_result (T.TStruct fields) = SubmitSort_result{++ }+to_SubmitSort_result _ = P.error "not a struct"+read_SubmitSort_result :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitSort_result+read_SubmitSort_result iprot = to_SubmitSort_result <$> T.readVal iprot (T.T_STRUCT typemap_SubmitSort_result)+decode_SubmitSort_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitSort_result+decode_SubmitSort_result iprot bs = to_SubmitSort_result $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitSort_result) bs+typemap_SubmitSort_result :: T.TypeMap+typemap_SubmitSort_result = Map.fromList []+default_SubmitSort_result :: SubmitSort_result+default_SubmitSort_result = SubmitSort_result{+}+process_submitSort (seqid, iprot, oprot, handler) = do+ args <- read_SubmitSort_args iprot+ (X.catch+ (do+ Iface.submitSort handler (submitSort_args_sessionId args) (submitSort_args_unitIds args)+ let res = default_SubmitSort_result+ T.writeMessageBegin oprot ("submitSort", T.M_REPLY, seqid)+ write_SubmitSort_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("submitSort", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "submitSort" -> process_submitSort (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/ActiveLearnerClientService_Client.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerClientService_Client(submitSort) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types+import ActiveLearnerClientService+seqid = R.newIORef 0+submitSort (ip,op) arg_sessionId arg_unitIds = do+ send_submitSort op arg_sessionId arg_unitIds+ recv_submitSort ip+send_submitSort op arg_sessionId arg_unitIds = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("submitSort", T.M_CALL, seqn)+ write_SubmitSort_args op (SubmitSort_args{submitSort_args_sessionId=arg_sessionId,submitSort_args_unitIds=arg_unitIds})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_submitSort ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_SubmitSort_result ip+ T.readMessageEnd ip+ P.return ()
+ src/Data/Concrete/Services/ActiveLearnerClientService_Iface.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerClientService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types++import Service_Iface+class Service_Iface a => ActiveLearnerClientService_Iface a where+ submitSort :: a -> Uuid_Types.UUID -> (Vector.Vector Services_Types.AnnotationUnitIdentifier) -> P.IO ()
+ src/Data/Concrete/Services/ActiveLearnerServerService.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerServerService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import qualified Service+import Learn_Types+import qualified ActiveLearnerServerService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Start_args = Start_args { start_args_sessionId :: Uuid_Types.UUID+ , start_args_task :: AnnotationTask+ , start_args_contact :: Services_Types.AsyncContactInfo+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Start_args where+ hashWithSalt salt record = salt `H.hashWithSalt` start_args_sessionId record `H.hashWithSalt` start_args_task record `H.hashWithSalt` start_args_contact record +instance QC.Arbitrary Start_args where + arbitrary = M.liftM Start_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Start_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Start_args{start_args_sessionId = start_args_sessionId obj} then P.Nothing else P.Just $ default_Start_args{start_args_sessionId = start_args_sessionId obj}+ , if obj == default_Start_args{start_args_task = start_args_task obj} then P.Nothing else P.Just $ default_Start_args{start_args_task = start_args_task obj}+ , if obj == default_Start_args{start_args_contact = start_args_contact obj} then P.Nothing else P.Just $ default_Start_args{start_args_contact = start_args_contact obj}+ ]+from_Start_args :: Start_args -> T.ThriftVal+from_Start_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v22 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v22))) $ start_args_sessionId record+ , (\_v22 -> P.Just (2, ("task",from_AnnotationTask _v22))) $ start_args_task record+ , (\_v22 -> P.Just (3, ("contact",Services_Types.from_AsyncContactInfo _v22))) $ start_args_contact record+ ]+write_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> P.IO ()+write_Start_args oprot record = T.writeVal oprot $ from_Start_args record+encode_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> LBS.ByteString+encode_Start_args oprot record = T.serializeVal oprot $ from_Start_args record+to_Start_args :: T.ThriftVal -> Start_args+to_Start_args (T.TStruct fields) = Start_args{+ start_args_sessionId = P.maybe (start_args_sessionId default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val25 -> (Uuid_Types.to_UUID (T.TStruct _val25)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ start_args_task = P.maybe (start_args_task default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val26 -> (to_AnnotationTask (T.TStruct _val26)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ start_args_contact = P.maybe (start_args_contact default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val27 -> (Services_Types.to_AsyncContactInfo (T.TStruct _val27)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_Start_args _ = P.error "not a struct"+read_Start_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_args+read_Start_args iprot = to_Start_args <$> T.readVal iprot (T.T_STRUCT typemap_Start_args)+decode_Start_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_args+decode_Start_args iprot bs = to_Start_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_args) bs+typemap_Start_args :: T.TypeMap+typemap_Start_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("task",(T.T_STRUCT typemap_AnnotationTask))),(3,("contact",(T.T_STRUCT Services_Types.typemap_AsyncContactInfo)))]+default_Start_args :: Start_args+default_Start_args = Start_args{+ start_args_sessionId = Uuid_Types.default_UUID,+ start_args_task = default_AnnotationTask,+ start_args_contact = Services_Types.default_AsyncContactInfo}+data Start_result = Start_result { start_result_success :: P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Start_result where+ hashWithSalt salt record = salt `H.hashWithSalt` start_result_success record +instance QC.Arbitrary Start_result where + arbitrary = M.liftM Start_result (QC.arbitrary)+ shrink obj | obj == default_Start_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Start_result{start_result_success = start_result_success obj} then P.Nothing else P.Just $ default_Start_result{start_result_success = start_result_success obj}+ ]+from_Start_result :: Start_result -> T.ThriftVal+from_Start_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v30 -> P.Just (0, ("success",T.TBool _v30))) $ start_result_success record+ ]+write_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> P.IO ()+write_Start_result oprot record = T.writeVal oprot $ from_Start_result record+encode_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> LBS.ByteString+encode_Start_result oprot record = T.serializeVal oprot $ from_Start_result record+to_Start_result :: T.ThriftVal -> Start_result+to_Start_result (T.TStruct fields) = Start_result{+ start_result_success = P.maybe (start_result_success default_Start_result) (\(_,_val32) -> (case _val32 of {T.TBool _val33 -> _val33; _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_Start_result _ = P.error "not a struct"+read_Start_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_result+read_Start_result iprot = to_Start_result <$> T.readVal iprot (T.T_STRUCT typemap_Start_result)+decode_Start_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_result+decode_Start_result iprot bs = to_Start_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_result) bs+typemap_Start_result :: T.TypeMap+typemap_Start_result = Map.fromList [(0,("success",T.T_BOOL))]+default_Start_result :: Start_result+default_Start_result = Start_result{+ start_result_success = P.False}+data Stop_args = Stop_args { stop_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Stop_args where+ hashWithSalt salt record = salt `H.hashWithSalt` stop_args_sessionId record +instance QC.Arbitrary Stop_args where + arbitrary = M.liftM Stop_args (QC.arbitrary)+ shrink obj | obj == default_Stop_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Stop_args{stop_args_sessionId = stop_args_sessionId obj} then P.Nothing else P.Just $ default_Stop_args{stop_args_sessionId = stop_args_sessionId obj}+ ]+from_Stop_args :: Stop_args -> T.ThriftVal+from_Stop_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v36 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v36))) $ stop_args_sessionId record+ ]+write_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> P.IO ()+write_Stop_args oprot record = T.writeVal oprot $ from_Stop_args record+encode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> LBS.ByteString+encode_Stop_args oprot record = T.serializeVal oprot $ from_Stop_args record+to_Stop_args :: T.ThriftVal -> Stop_args+to_Stop_args (T.TStruct fields) = Stop_args{+ stop_args_sessionId = P.maybe (stop_args_sessionId default_Stop_args) (\(_,_val38) -> (case _val38 of {T.TStruct _val39 -> (Uuid_Types.to_UUID (T.TStruct _val39)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Stop_args _ = P.error "not a struct"+read_Stop_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_args+read_Stop_args iprot = to_Stop_args <$> T.readVal iprot (T.T_STRUCT typemap_Stop_args)+decode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_args+decode_Stop_args iprot bs = to_Stop_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_args) bs+typemap_Stop_args :: T.TypeMap+typemap_Stop_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_Stop_args :: Stop_args+default_Stop_args = Stop_args{+ stop_args_sessionId = Uuid_Types.default_UUID}+data Stop_result = Stop_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Stop_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary Stop_result where + arbitrary = QC.elements [Stop_result]+from_Stop_result :: Stop_result -> T.ThriftVal+from_Stop_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> P.IO ()+write_Stop_result oprot record = T.writeVal oprot $ from_Stop_result record+encode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> LBS.ByteString+encode_Stop_result oprot record = T.serializeVal oprot $ from_Stop_result record+to_Stop_result :: T.ThriftVal -> Stop_result+to_Stop_result (T.TStruct fields) = Stop_result{++ }+to_Stop_result _ = P.error "not a struct"+read_Stop_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_result+read_Stop_result iprot = to_Stop_result <$> T.readVal iprot (T.T_STRUCT typemap_Stop_result)+decode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_result+decode_Stop_result iprot bs = to_Stop_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_result) bs+typemap_Stop_result :: T.TypeMap+typemap_Stop_result = Map.fromList []+default_Stop_result :: Stop_result+default_Stop_result = Stop_result{+}+data AddAnnotations_args = AddAnnotations_args { addAnnotations_args_sessionId :: Uuid_Types.UUID+ , addAnnotations_args_annotations :: (Vector.Vector Annotation)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddAnnotations_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addAnnotations_args_sessionId record `H.hashWithSalt` addAnnotations_args_annotations record +instance QC.Arbitrary AddAnnotations_args where + arbitrary = M.liftM AddAnnotations_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddAnnotations_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj}+ , if obj == default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj}+ ]+from_AddAnnotations_args :: AddAnnotations_args -> T.ThriftVal+from_AddAnnotations_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v47 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v47))) $ addAnnotations_args_sessionId record+ , (\_v47 -> P.Just (2, ("annotations",T.TList (T.T_STRUCT typemap_Annotation) $ P.map (\_v49 -> from_Annotation _v49) $ Vector.toList _v47))) $ addAnnotations_args_annotations record+ ]+write_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> P.IO ()+write_AddAnnotations_args oprot record = T.writeVal oprot $ from_AddAnnotations_args record+encode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> LBS.ByteString+encode_AddAnnotations_args oprot record = T.serializeVal oprot $ from_AddAnnotations_args record+to_AddAnnotations_args :: T.ThriftVal -> AddAnnotations_args+to_AddAnnotations_args (T.TStruct fields) = AddAnnotations_args{+ addAnnotations_args_sessionId = P.maybe (addAnnotations_args_sessionId default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TStruct _val52 -> (Uuid_Types.to_UUID (T.TStruct _val52)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addAnnotations_args_annotations = P.maybe (addAnnotations_args_annotations default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TList _ _val53 -> (Vector.fromList $ P.map (\_v54 -> (case _v54 of {T.TStruct _val55 -> (to_Annotation (T.TStruct _val55)); _ -> P.error "wrong type"})) _val53); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_AddAnnotations_args _ = P.error "not a struct"+read_AddAnnotations_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_args+read_AddAnnotations_args iprot = to_AddAnnotations_args <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_args)+decode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_args+decode_AddAnnotations_args iprot bs = to_AddAnnotations_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_args) bs+typemap_AddAnnotations_args :: T.TypeMap+typemap_AddAnnotations_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("annotations",(T.T_LIST (T.T_STRUCT typemap_Annotation))))]+default_AddAnnotations_args :: AddAnnotations_args+default_AddAnnotations_args = AddAnnotations_args{+ addAnnotations_args_sessionId = Uuid_Types.default_UUID,+ addAnnotations_args_annotations = Vector.empty}+data AddAnnotations_result = AddAnnotations_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddAnnotations_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary AddAnnotations_result where + arbitrary = QC.elements [AddAnnotations_result]+from_AddAnnotations_result :: AddAnnotations_result -> T.ThriftVal+from_AddAnnotations_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> P.IO ()+write_AddAnnotations_result oprot record = T.writeVal oprot $ from_AddAnnotations_result record+encode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> LBS.ByteString+encode_AddAnnotations_result oprot record = T.serializeVal oprot $ from_AddAnnotations_result record+to_AddAnnotations_result :: T.ThriftVal -> AddAnnotations_result+to_AddAnnotations_result (T.TStruct fields) = AddAnnotations_result{++ }+to_AddAnnotations_result _ = P.error "not a struct"+read_AddAnnotations_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_result+read_AddAnnotations_result iprot = to_AddAnnotations_result <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_result)+decode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_result+decode_AddAnnotations_result iprot bs = to_AddAnnotations_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_result) bs+typemap_AddAnnotations_result :: T.TypeMap+typemap_AddAnnotations_result = Map.fromList []+default_AddAnnotations_result :: AddAnnotations_result+default_AddAnnotations_result = AddAnnotations_result{+}+process_start (seqid, iprot, oprot, handler) = do+ args <- read_Start_args iprot+ (X.catch+ (do+ val <- Iface.start handler (start_args_sessionId args) (start_args_task args) (start_args_contact args)+ let res = default_Start_result{start_result_success = val}+ T.writeMessageBegin oprot ("start", T.M_REPLY, seqid)+ write_Start_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("start", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_stop (seqid, iprot, oprot, handler) = do+ args <- read_Stop_args iprot+ (X.catch+ (do+ Iface.stop handler (stop_args_sessionId args)+ let res = default_Stop_result+ T.writeMessageBegin oprot ("stop", T.M_REPLY, seqid)+ write_Stop_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("stop", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addAnnotations (seqid, iprot, oprot, handler) = do+ args <- read_AddAnnotations_args iprot+ (X.catch+ (do+ Iface.addAnnotations handler (addAnnotations_args_sessionId args) (addAnnotations_args_annotations args)+ let res = default_AddAnnotations_result+ T.writeMessageBegin oprot ("addAnnotations", T.M_REPLY, seqid)+ write_AddAnnotations_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("addAnnotations", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "start" -> process_start (seqid,iprot,oprot,handler)+ "stop" -> process_stop (seqid,iprot,oprot,handler)+ "addAnnotations" -> process_addAnnotations (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/ActiveLearnerServerService_Client.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerServerService_Client(start,stop,addAnnotations) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types+import ActiveLearnerServerService+seqid = R.newIORef 0+start (ip,op) arg_sessionId arg_task arg_contact = do+ send_start op arg_sessionId arg_task arg_contact+ recv_start ip+send_start op arg_sessionId arg_task arg_contact = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("start", T.M_CALL, seqn)+ write_Start_args op (Start_args{start_args_sessionId=arg_sessionId,start_args_task=arg_task,start_args_contact=arg_contact})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_start ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Start_result ip+ T.readMessageEnd ip+ P.return $ start_result_success res+stop (ip,op) arg_sessionId = do+ send_stop op arg_sessionId+ recv_stop ip+send_stop op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("stop", T.M_CALL, seqn)+ write_Stop_args op (Stop_args{stop_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_stop ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Stop_result ip+ T.readMessageEnd ip+ P.return ()+addAnnotations (ip,op) arg_sessionId arg_annotations = do+ send_addAnnotations op arg_sessionId arg_annotations+ recv_addAnnotations ip+send_addAnnotations op arg_sessionId arg_annotations = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addAnnotations", T.M_CALL, seqn)+ write_AddAnnotations_args op (AddAnnotations_args{addAnnotations_args_sessionId=arg_sessionId,addAnnotations_args_annotations=arg_annotations})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addAnnotations ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddAnnotations_result ip+ T.readMessageEnd ip+ P.return ()
+ src/Data/Concrete/Services/ActiveLearnerServerService_Iface.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ActiveLearnerServerService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types++import Service_Iface+class Service_Iface a => ActiveLearnerServerService_Iface a where+ start :: a -> Uuid_Types.UUID -> AnnotationTask -> Services_Types.AsyncContactInfo -> P.IO P.Bool+ stop :: a -> Uuid_Types.UUID -> P.IO ()+ addAnnotations :: a -> Uuid_Types.UUID -> (Vector.Vector Annotation) -> P.IO ()
+ src/Data/Concrete/Services/AnnotateCommunicationService.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.AnnotateCommunicationService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Language_Types+import qualified Structure_Types+import qualified Entities_Types+import qualified Situations_Types+import qualified Ex_Types+import qualified Email_Types+import qualified Twitter_Types+import qualified Audio_Types+import qualified Communication_Types+++import Annotate_Types+import qualified AnnotateCommunicationService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Annotate_args = Annotate_args { annotate_args_original :: Communication_Types.Communication+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Annotate_args where+ hashWithSalt salt record = salt `H.hashWithSalt` annotate_args_original record +instance QC.Arbitrary Annotate_args where + arbitrary = M.liftM Annotate_args (QC.arbitrary)+ shrink obj | obj == default_Annotate_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Annotate_args{annotate_args_original = annotate_args_original obj} then P.Nothing else P.Just $ default_Annotate_args{annotate_args_original = annotate_args_original obj}+ ]+from_Annotate_args :: Annotate_args -> T.ThriftVal+from_Annotate_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("original",Communication_Types.from_Communication _v2))) $ annotate_args_original record+ ]+write_Annotate_args :: (T.Protocol p, T.Transport t) => p t -> Annotate_args -> P.IO ()+write_Annotate_args oprot record = T.writeVal oprot $ from_Annotate_args record+encode_Annotate_args :: (T.Protocol p, T.Transport t) => p t -> Annotate_args -> LBS.ByteString+encode_Annotate_args oprot record = T.serializeVal oprot $ from_Annotate_args record+to_Annotate_args :: T.ThriftVal -> Annotate_args+to_Annotate_args (T.TStruct fields) = Annotate_args{+ annotate_args_original = P.maybe (annotate_args_original default_Annotate_args) (\(_,_val4) -> (case _val4 of {T.TStruct _val5 -> (Communication_Types.to_Communication (T.TStruct _val5)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Annotate_args _ = P.error "not a struct"+read_Annotate_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Annotate_args+read_Annotate_args iprot = to_Annotate_args <$> T.readVal iprot (T.T_STRUCT typemap_Annotate_args)+decode_Annotate_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Annotate_args+decode_Annotate_args iprot bs = to_Annotate_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Annotate_args) bs+typemap_Annotate_args :: T.TypeMap+typemap_Annotate_args = Map.fromList [(1,("original",(T.T_STRUCT Communication_Types.typemap_Communication)))]+default_Annotate_args :: Annotate_args+default_Annotate_args = Annotate_args{+ annotate_args_original = Communication_Types.default_Communication}+data Annotate_result = Annotate_result { annotate_result_success :: Communication_Types.Communication+ , annotate_result_ex :: P.Maybe Ex_Types.ConcreteThriftException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Annotate_result where+ hashWithSalt salt record = salt `H.hashWithSalt` annotate_result_success record `H.hashWithSalt` annotate_result_ex record +instance QC.Arbitrary Annotate_result where + arbitrary = M.liftM Annotate_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Annotate_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Annotate_result{annotate_result_success = annotate_result_success obj} then P.Nothing else P.Just $ default_Annotate_result{annotate_result_success = annotate_result_success obj}+ , if obj == default_Annotate_result{annotate_result_ex = annotate_result_ex obj} then P.Nothing else P.Just $ default_Annotate_result{annotate_result_ex = annotate_result_ex obj}+ ]+from_Annotate_result :: Annotate_result -> T.ThriftVal+from_Annotate_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v8 -> (1, ("ex",Ex_Types.from_ConcreteThriftException _v8))) <$> annotate_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v8 -> P.Just (0, ("success",Communication_Types.from_Communication _v8))) $ annotate_result_success record+ , (\_v8 -> (1, ("ex",Ex_Types.from_ConcreteThriftException _v8))) <$> annotate_result_ex record+ ]+ )+write_Annotate_result :: (T.Protocol p, T.Transport t) => p t -> Annotate_result -> P.IO ()+write_Annotate_result oprot record = T.writeVal oprot $ from_Annotate_result record+encode_Annotate_result :: (T.Protocol p, T.Transport t) => p t -> Annotate_result -> LBS.ByteString+encode_Annotate_result oprot record = T.serializeVal oprot $ from_Annotate_result record+to_Annotate_result :: T.ThriftVal -> Annotate_result+to_Annotate_result (T.TStruct fields) = Annotate_result{+ annotate_result_success = P.maybe (annotate_result_success default_Annotate_result) (\(_,_val10) -> (case _val10 of {T.TStruct _val11 -> (Communication_Types.to_Communication (T.TStruct _val11)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ annotate_result_ex = P.maybe (P.Nothing) (\(_,_val10) -> P.Just (case _val10 of {T.TStruct _val12 -> (Ex_Types.to_ConcreteThriftException (T.TStruct _val12)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Annotate_result _ = P.error "not a struct"+read_Annotate_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Annotate_result+read_Annotate_result iprot = to_Annotate_result <$> T.readVal iprot (T.T_STRUCT typemap_Annotate_result)+decode_Annotate_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Annotate_result+decode_Annotate_result iprot bs = to_Annotate_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Annotate_result) bs+typemap_Annotate_result :: T.TypeMap+typemap_Annotate_result = Map.fromList [(0,("success",(T.T_STRUCT Communication_Types.typemap_Communication))),(1,("ex",(T.T_STRUCT Ex_Types.typemap_ConcreteThriftException)))]+default_Annotate_result :: Annotate_result+default_Annotate_result = Annotate_result{+ annotate_result_success = Communication_Types.default_Communication,+ annotate_result_ex = P.Nothing}+data GetMetadata_args = GetMetadata_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetMetadata_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetMetadata_args where + arbitrary = QC.elements [GetMetadata_args]+from_GetMetadata_args :: GetMetadata_args -> T.ThriftVal+from_GetMetadata_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetMetadata_args :: (T.Protocol p, T.Transport t) => p t -> GetMetadata_args -> P.IO ()+write_GetMetadata_args oprot record = T.writeVal oprot $ from_GetMetadata_args record+encode_GetMetadata_args :: (T.Protocol p, T.Transport t) => p t -> GetMetadata_args -> LBS.ByteString+encode_GetMetadata_args oprot record = T.serializeVal oprot $ from_GetMetadata_args record+to_GetMetadata_args :: T.ThriftVal -> GetMetadata_args+to_GetMetadata_args (T.TStruct fields) = GetMetadata_args{++ }+to_GetMetadata_args _ = P.error "not a struct"+read_GetMetadata_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetMetadata_args+read_GetMetadata_args iprot = to_GetMetadata_args <$> T.readVal iprot (T.T_STRUCT typemap_GetMetadata_args)+decode_GetMetadata_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetMetadata_args+decode_GetMetadata_args iprot bs = to_GetMetadata_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetMetadata_args) bs+typemap_GetMetadata_args :: T.TypeMap+typemap_GetMetadata_args = Map.fromList []+default_GetMetadata_args :: GetMetadata_args+default_GetMetadata_args = GetMetadata_args{+}+data GetMetadata_result = GetMetadata_result { getMetadata_result_success :: Metadata_Types.AnnotationMetadata+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetMetadata_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getMetadata_result_success record +instance QC.Arbitrary GetMetadata_result where + arbitrary = M.liftM GetMetadata_result (QC.arbitrary)+ shrink obj | obj == default_GetMetadata_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetMetadata_result{getMetadata_result_success = getMetadata_result_success obj} then P.Nothing else P.Just $ default_GetMetadata_result{getMetadata_result_success = getMetadata_result_success obj}+ ]+from_GetMetadata_result :: GetMetadata_result -> T.ThriftVal+from_GetMetadata_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v20 -> P.Just (0, ("success",Metadata_Types.from_AnnotationMetadata _v20))) $ getMetadata_result_success record+ ]+write_GetMetadata_result :: (T.Protocol p, T.Transport t) => p t -> GetMetadata_result -> P.IO ()+write_GetMetadata_result oprot record = T.writeVal oprot $ from_GetMetadata_result record+encode_GetMetadata_result :: (T.Protocol p, T.Transport t) => p t -> GetMetadata_result -> LBS.ByteString+encode_GetMetadata_result oprot record = T.serializeVal oprot $ from_GetMetadata_result record+to_GetMetadata_result :: T.ThriftVal -> GetMetadata_result+to_GetMetadata_result (T.TStruct fields) = GetMetadata_result{+ getMetadata_result_success = P.maybe (getMetadata_result_success default_GetMetadata_result) (\(_,_val22) -> (case _val22 of {T.TStruct _val23 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val23)); _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_GetMetadata_result _ = P.error "not a struct"+read_GetMetadata_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetMetadata_result+read_GetMetadata_result iprot = to_GetMetadata_result <$> T.readVal iprot (T.T_STRUCT typemap_GetMetadata_result)+decode_GetMetadata_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetMetadata_result+decode_GetMetadata_result iprot bs = to_GetMetadata_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetMetadata_result) bs+typemap_GetMetadata_result :: T.TypeMap+typemap_GetMetadata_result = Map.fromList [(0,("success",(T.T_STRUCT Metadata_Types.typemap_AnnotationMetadata)))]+default_GetMetadata_result :: GetMetadata_result+default_GetMetadata_result = GetMetadata_result{+ getMetadata_result_success = Metadata_Types.default_AnnotationMetadata}+data GetDocumentation_args = GetDocumentation_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetDocumentation_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetDocumentation_args where + arbitrary = QC.elements [GetDocumentation_args]+from_GetDocumentation_args :: GetDocumentation_args -> T.ThriftVal+from_GetDocumentation_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetDocumentation_args :: (T.Protocol p, T.Transport t) => p t -> GetDocumentation_args -> P.IO ()+write_GetDocumentation_args oprot record = T.writeVal oprot $ from_GetDocumentation_args record+encode_GetDocumentation_args :: (T.Protocol p, T.Transport t) => p t -> GetDocumentation_args -> LBS.ByteString+encode_GetDocumentation_args oprot record = T.serializeVal oprot $ from_GetDocumentation_args record+to_GetDocumentation_args :: T.ThriftVal -> GetDocumentation_args+to_GetDocumentation_args (T.TStruct fields) = GetDocumentation_args{++ }+to_GetDocumentation_args _ = P.error "not a struct"+read_GetDocumentation_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetDocumentation_args+read_GetDocumentation_args iprot = to_GetDocumentation_args <$> T.readVal iprot (T.T_STRUCT typemap_GetDocumentation_args)+decode_GetDocumentation_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetDocumentation_args+decode_GetDocumentation_args iprot bs = to_GetDocumentation_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetDocumentation_args) bs+typemap_GetDocumentation_args :: T.TypeMap+typemap_GetDocumentation_args = Map.fromList []+default_GetDocumentation_args :: GetDocumentation_args+default_GetDocumentation_args = GetDocumentation_args{+}+data GetDocumentation_result = GetDocumentation_result { getDocumentation_result_success :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetDocumentation_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getDocumentation_result_success record +instance QC.Arbitrary GetDocumentation_result where + arbitrary = M.liftM GetDocumentation_result (QC.arbitrary)+ shrink obj | obj == default_GetDocumentation_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetDocumentation_result{getDocumentation_result_success = getDocumentation_result_success obj} then P.Nothing else P.Just $ default_GetDocumentation_result{getDocumentation_result_success = getDocumentation_result_success obj}+ ]+from_GetDocumentation_result :: GetDocumentation_result -> T.ThriftVal+from_GetDocumentation_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v31 -> P.Just (0, ("success",T.TString $ E.encodeUtf8 _v31))) $ getDocumentation_result_success record+ ]+write_GetDocumentation_result :: (T.Protocol p, T.Transport t) => p t -> GetDocumentation_result -> P.IO ()+write_GetDocumentation_result oprot record = T.writeVal oprot $ from_GetDocumentation_result record+encode_GetDocumentation_result :: (T.Protocol p, T.Transport t) => p t -> GetDocumentation_result -> LBS.ByteString+encode_GetDocumentation_result oprot record = T.serializeVal oprot $ from_GetDocumentation_result record+to_GetDocumentation_result :: T.ThriftVal -> GetDocumentation_result+to_GetDocumentation_result (T.TStruct fields) = GetDocumentation_result{+ getDocumentation_result_success = P.maybe (getDocumentation_result_success default_GetDocumentation_result) (\(_,_val33) -> (case _val33 of {T.TString _val34 -> E.decodeUtf8 _val34; _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_GetDocumentation_result _ = P.error "not a struct"+read_GetDocumentation_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetDocumentation_result+read_GetDocumentation_result iprot = to_GetDocumentation_result <$> T.readVal iprot (T.T_STRUCT typemap_GetDocumentation_result)+decode_GetDocumentation_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetDocumentation_result+decode_GetDocumentation_result iprot bs = to_GetDocumentation_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetDocumentation_result) bs+typemap_GetDocumentation_result :: T.TypeMap+typemap_GetDocumentation_result = Map.fromList [(0,("success",T.T_STRING))]+default_GetDocumentation_result :: GetDocumentation_result+default_GetDocumentation_result = GetDocumentation_result{+ getDocumentation_result_success = ""}+data Shutdown_args = Shutdown_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Shutdown_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary Shutdown_args where + arbitrary = QC.elements [Shutdown_args]+from_Shutdown_args :: Shutdown_args -> T.ThriftVal+from_Shutdown_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_Shutdown_args :: (T.Protocol p, T.Transport t) => p t -> Shutdown_args -> P.IO ()+write_Shutdown_args oprot record = T.writeVal oprot $ from_Shutdown_args record+encode_Shutdown_args :: (T.Protocol p, T.Transport t) => p t -> Shutdown_args -> LBS.ByteString+encode_Shutdown_args oprot record = T.serializeVal oprot $ from_Shutdown_args record+to_Shutdown_args :: T.ThriftVal -> Shutdown_args+to_Shutdown_args (T.TStruct fields) = Shutdown_args{++ }+to_Shutdown_args _ = P.error "not a struct"+read_Shutdown_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Shutdown_args+read_Shutdown_args iprot = to_Shutdown_args <$> T.readVal iprot (T.T_STRUCT typemap_Shutdown_args)+decode_Shutdown_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Shutdown_args+decode_Shutdown_args iprot bs = to_Shutdown_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Shutdown_args) bs+typemap_Shutdown_args :: T.TypeMap+typemap_Shutdown_args = Map.fromList []+default_Shutdown_args :: Shutdown_args+default_Shutdown_args = Shutdown_args{+}+data Shutdown_result = Shutdown_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Shutdown_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary Shutdown_result where + arbitrary = QC.elements [Shutdown_result]+from_Shutdown_result :: Shutdown_result -> T.ThriftVal+from_Shutdown_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_Shutdown_result :: (T.Protocol p, T.Transport t) => p t -> Shutdown_result -> P.IO ()+write_Shutdown_result oprot record = T.writeVal oprot $ from_Shutdown_result record+encode_Shutdown_result :: (T.Protocol p, T.Transport t) => p t -> Shutdown_result -> LBS.ByteString+encode_Shutdown_result oprot record = T.serializeVal oprot $ from_Shutdown_result record+to_Shutdown_result :: T.ThriftVal -> Shutdown_result+to_Shutdown_result (T.TStruct fields) = Shutdown_result{++ }+to_Shutdown_result _ = P.error "not a struct"+read_Shutdown_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Shutdown_result+read_Shutdown_result iprot = to_Shutdown_result <$> T.readVal iprot (T.T_STRUCT typemap_Shutdown_result)+decode_Shutdown_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Shutdown_result+decode_Shutdown_result iprot bs = to_Shutdown_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Shutdown_result) bs+typemap_Shutdown_result :: T.TypeMap+typemap_Shutdown_result = Map.fromList []+default_Shutdown_result :: Shutdown_result+default_Shutdown_result = Shutdown_result{+}+process_annotate (seqid, iprot, oprot, handler) = do+ args <- read_Annotate_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.annotate handler (annotate_args_original args)+ let res = default_Annotate_result{annotate_result_success = val}+ T.writeMessageBegin oprot ("annotate", T.M_REPLY, seqid)+ write_Annotate_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Annotate_result{annotate_result_ex = P.Just e}+ T.writeMessageBegin oprot ("annotate", T.M_REPLY, seqid)+ write_Annotate_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("annotate", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getMetadata (seqid, iprot, oprot, handler) = do+ args <- read_GetMetadata_args iprot+ (X.catch+ (do+ val <- Iface.getMetadata handler+ let res = default_GetMetadata_result{getMetadata_result_success = val}+ T.writeMessageBegin oprot ("getMetadata", T.M_REPLY, seqid)+ write_GetMetadata_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("getMetadata", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getDocumentation (seqid, iprot, oprot, handler) = do+ args <- read_GetDocumentation_args iprot+ (X.catch+ (do+ val <- Iface.getDocumentation handler+ let res = default_GetDocumentation_result{getDocumentation_result_success = val}+ T.writeMessageBegin oprot ("getDocumentation", T.M_REPLY, seqid)+ write_GetDocumentation_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("getDocumentation", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_shutdown (seqid, iprot, oprot, handler) = do+ args <- read_Shutdown_args iprot+ (X.catch+ (do+ Iface.shutdown handler+ P.return ())+ ((\_ -> do+ P.return ()) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "annotate" -> process_annotate (seqid,iprot,oprot,handler)+ "getMetadata" -> process_getMetadata (seqid,iprot,oprot,handler)+ "getDocumentation" -> process_getDocumentation (seqid,iprot,oprot,handler)+ "shutdown" -> process_shutdown (seqid,iprot,oprot,handler)+ _ -> do+ _ <- T.readVal iprot (T.T_STRUCT Map.empty)+ T.writeMessageBegin oprot (name,T.M_EXCEPTION,seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD ("Unknown function " ++ LT.unpack name))+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/AnnotateCommunicationService_Client.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.AnnotateCommunicationService_Client(annotate,getMetadata,getDocumentation,shutdown) where+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Language_Types+import qualified Structure_Types+import qualified Entities_Types+import qualified Situations_Types+import qualified Ex_Types+import qualified Email_Types+import qualified Twitter_Types+import qualified Audio_Types+import qualified Communication_Types+++import Annotate_Types+import AnnotateCommunicationService+seqid = R.newIORef 0+annotate (ip,op) arg_original = do+ send_annotate op arg_original+ recv_annotate ip+send_annotate op arg_original = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("annotate", T.M_CALL, seqn)+ write_Annotate_args op (Annotate_args{annotate_args_original=arg_original})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_annotate ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Annotate_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (annotate_result_ex res)+ P.return $ annotate_result_success res+getMetadata (ip,op) = do+ send_getMetadata op+ recv_getMetadata ip+send_getMetadata op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getMetadata", T.M_CALL, seqn)+ write_GetMetadata_args op (GetMetadata_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getMetadata ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetMetadata_result ip+ T.readMessageEnd ip+ P.return $ getMetadata_result_success res+getDocumentation (ip,op) = do+ send_getDocumentation op+ recv_getDocumentation ip+send_getDocumentation op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getDocumentation", T.M_CALL, seqn)+ write_GetDocumentation_args op (GetDocumentation_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getDocumentation ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetDocumentation_result ip+ T.readMessageEnd ip+ P.return $ getDocumentation_result_success res+shutdown (ip,op) = do+ send_shutdown op+send_shutdown op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("shutdown", T.M_ONEWAY, seqn)+ write_Shutdown_args op (Shutdown_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)
+ src/Data/Concrete/Services/AnnotateCommunicationService_Iface.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.AnnotateCommunicationService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Language_Types+import qualified Structure_Types+import qualified Entities_Types+import qualified Situations_Types+import qualified Ex_Types+import qualified Email_Types+import qualified Twitter_Types+import qualified Audio_Types+import qualified Communication_Types+++import Annotate_Types++class AnnotateCommunicationService_Iface a where+ annotate :: a -> Communication_Types.Communication -> P.IO Communication_Types.Communication+ getMetadata :: a -> P.IO Metadata_Types.AnnotationMetadata+ getDocumentation :: a -> P.IO LT.Text+ shutdown :: a -> P.IO ()
+ src/Data/Concrete/Services/FeedbackService.hs view
@@ -0,0 +1,359 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FeedbackService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import qualified Service+import Search_Types+import qualified FeedbackService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data StartFeedback_args = StartFeedback_args { startFeedback_args_results :: SearchResult+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` startFeedback_args_results record +instance QC.Arbitrary StartFeedback_args where + arbitrary = M.liftM StartFeedback_args (QC.arbitrary)+ shrink obj | obj == default_StartFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartFeedback_args{startFeedback_args_results = startFeedback_args_results obj} then P.Nothing else P.Just $ default_StartFeedback_args{startFeedback_args_results = startFeedback_args_results obj}+ ]+from_StartFeedback_args :: StartFeedback_args -> T.ThriftVal+from_StartFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v173 -> P.Just (1, ("results",from_SearchResult _v173))) $ startFeedback_args_results record+ ]+write_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_args -> P.IO ()+write_StartFeedback_args oprot record = T.writeVal oprot $ from_StartFeedback_args record+encode_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_args -> LBS.ByteString+encode_StartFeedback_args oprot record = T.serializeVal oprot $ from_StartFeedback_args record+to_StartFeedback_args :: T.ThriftVal -> StartFeedback_args+to_StartFeedback_args (T.TStruct fields) = StartFeedback_args{+ startFeedback_args_results = P.maybe (startFeedback_args_results default_StartFeedback_args) (\(_,_val175) -> (case _val175 of {T.TStruct _val176 -> (to_SearchResult (T.TStruct _val176)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartFeedback_args _ = P.error "not a struct"+read_StartFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StartFeedback_args+read_StartFeedback_args iprot = to_StartFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_StartFeedback_args)+decode_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartFeedback_args+decode_StartFeedback_args iprot bs = to_StartFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StartFeedback_args) bs+typemap_StartFeedback_args :: T.TypeMap+typemap_StartFeedback_args = Map.fromList [(1,("results",(T.T_STRUCT typemap_SearchResult)))]+default_StartFeedback_args :: StartFeedback_args+default_StartFeedback_args = StartFeedback_args{+ startFeedback_args_results = default_SearchResult}+data StartFeedback_result = StartFeedback_result { startFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` startFeedback_result_ex record +instance QC.Arbitrary StartFeedback_result where + arbitrary = M.liftM StartFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StartFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartFeedback_result{startFeedback_result_ex = startFeedback_result_ex obj} then P.Nothing else P.Just $ default_StartFeedback_result{startFeedback_result_ex = startFeedback_result_ex obj}+ ]+from_StartFeedback_result :: StartFeedback_result -> T.ThriftVal+from_StartFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v179 -> (1, ("ex",Services_Types.from_ServicesException _v179))) <$> startFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v179 -> (1, ("ex",Services_Types.from_ServicesException _v179))) <$> startFeedback_result_ex record+ ]+ )+write_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_result -> P.IO ()+write_StartFeedback_result oprot record = T.writeVal oprot $ from_StartFeedback_result record+encode_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_result -> LBS.ByteString+encode_StartFeedback_result oprot record = T.serializeVal oprot $ from_StartFeedback_result record+to_StartFeedback_result :: T.ThriftVal -> StartFeedback_result+to_StartFeedback_result (T.TStruct fields) = StartFeedback_result{+ startFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val181) -> P.Just (case _val181 of {T.TStruct _val182 -> (Services_Types.to_ServicesException (T.TStruct _val182)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartFeedback_result _ = P.error "not a struct"+read_StartFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StartFeedback_result+read_StartFeedback_result iprot = to_StartFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_StartFeedback_result)+decode_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartFeedback_result+decode_StartFeedback_result iprot bs = to_StartFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StartFeedback_result) bs+typemap_StartFeedback_result :: T.TypeMap+typemap_StartFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StartFeedback_result :: StartFeedback_result+default_StartFeedback_result = StartFeedback_result{+ startFeedback_result_ex = P.Nothing}+data AddCommunicationFeedback_args = AddCommunicationFeedback_args { addCommunicationFeedback_args_searchResultsId :: Uuid_Types.UUID+ , addCommunicationFeedback_args_communicationId :: LT.Text+ , addCommunicationFeedback_args_feedback :: SearchFeedback+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddCommunicationFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addCommunicationFeedback_args_searchResultsId record `H.hashWithSalt` addCommunicationFeedback_args_communicationId record `H.hashWithSalt` addCommunicationFeedback_args_feedback record +instance QC.Arbitrary AddCommunicationFeedback_args where + arbitrary = M.liftM AddCommunicationFeedback_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddCommunicationFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId = addCommunicationFeedback_args_searchResultsId obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId = addCommunicationFeedback_args_searchResultsId obj}+ , if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_communicationId = addCommunicationFeedback_args_communicationId obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_communicationId = addCommunicationFeedback_args_communicationId obj}+ , if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_feedback = addCommunicationFeedback_args_feedback obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_feedback = addCommunicationFeedback_args_feedback obj}+ ]+from_AddCommunicationFeedback_args :: AddCommunicationFeedback_args -> T.ThriftVal+from_AddCommunicationFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v185 -> P.Just (1, ("searchResultsId",Uuid_Types.from_UUID _v185))) $ addCommunicationFeedback_args_searchResultsId record+ , (\_v185 -> P.Just (2, ("communicationId",T.TString $ E.encodeUtf8 _v185))) $ addCommunicationFeedback_args_communicationId record+ , (\_v185 -> P.Just (3, ("feedback",T.TI32 $ P.fromIntegral $ P.fromEnum _v185))) $ addCommunicationFeedback_args_feedback record+ ]+write_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_args -> P.IO ()+write_AddCommunicationFeedback_args oprot record = T.writeVal oprot $ from_AddCommunicationFeedback_args record+encode_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_args -> LBS.ByteString+encode_AddCommunicationFeedback_args oprot record = T.serializeVal oprot $ from_AddCommunicationFeedback_args record+to_AddCommunicationFeedback_args :: T.ThriftVal -> AddCommunicationFeedback_args+to_AddCommunicationFeedback_args (T.TStruct fields) = AddCommunicationFeedback_args{+ addCommunicationFeedback_args_searchResultsId = P.maybe (addCommunicationFeedback_args_searchResultsId default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TStruct _val188 -> (Uuid_Types.to_UUID (T.TStruct _val188)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addCommunicationFeedback_args_communicationId = P.maybe (addCommunicationFeedback_args_communicationId default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TString _val189 -> E.decodeUtf8 _val189; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ addCommunicationFeedback_args_feedback = P.maybe (addCommunicationFeedback_args_feedback default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TI32 _val190 -> P.toEnum $ P.fromIntegral _val190; _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_AddCommunicationFeedback_args _ = P.error "not a struct"+read_AddCommunicationFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddCommunicationFeedback_args+read_AddCommunicationFeedback_args iprot = to_AddCommunicationFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_args)+decode_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddCommunicationFeedback_args+decode_AddCommunicationFeedback_args iprot bs = to_AddCommunicationFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_args) bs+typemap_AddCommunicationFeedback_args :: T.TypeMap+typemap_AddCommunicationFeedback_args = Map.fromList [(1,("searchResultsId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("communicationId",T.T_STRING)),(3,("feedback",T.T_I32))]+default_AddCommunicationFeedback_args :: AddCommunicationFeedback_args+default_AddCommunicationFeedback_args = AddCommunicationFeedback_args{+ addCommunicationFeedback_args_searchResultsId = Uuid_Types.default_UUID,+ addCommunicationFeedback_args_communicationId = "",+ addCommunicationFeedback_args_feedback = (P.toEnum 0)}+data AddCommunicationFeedback_result = AddCommunicationFeedback_result { addCommunicationFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddCommunicationFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` addCommunicationFeedback_result_ex record +instance QC.Arbitrary AddCommunicationFeedback_result where + arbitrary = M.liftM AddCommunicationFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_AddCommunicationFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = addCommunicationFeedback_result_ex obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = addCommunicationFeedback_result_ex obj}+ ]+from_AddCommunicationFeedback_result :: AddCommunicationFeedback_result -> T.ThriftVal+from_AddCommunicationFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v193 -> (1, ("ex",Services_Types.from_ServicesException _v193))) <$> addCommunicationFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v193 -> (1, ("ex",Services_Types.from_ServicesException _v193))) <$> addCommunicationFeedback_result_ex record+ ]+ )+write_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_result -> P.IO ()+write_AddCommunicationFeedback_result oprot record = T.writeVal oprot $ from_AddCommunicationFeedback_result record+encode_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_result -> LBS.ByteString+encode_AddCommunicationFeedback_result oprot record = T.serializeVal oprot $ from_AddCommunicationFeedback_result record+to_AddCommunicationFeedback_result :: T.ThriftVal -> AddCommunicationFeedback_result+to_AddCommunicationFeedback_result (T.TStruct fields) = AddCommunicationFeedback_result{+ addCommunicationFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val195) -> P.Just (case _val195 of {T.TStruct _val196 -> (Services_Types.to_ServicesException (T.TStruct _val196)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_AddCommunicationFeedback_result _ = P.error "not a struct"+read_AddCommunicationFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddCommunicationFeedback_result+read_AddCommunicationFeedback_result iprot = to_AddCommunicationFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_result)+decode_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddCommunicationFeedback_result+decode_AddCommunicationFeedback_result iprot bs = to_AddCommunicationFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_result) bs+typemap_AddCommunicationFeedback_result :: T.TypeMap+typemap_AddCommunicationFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_AddCommunicationFeedback_result :: AddCommunicationFeedback_result+default_AddCommunicationFeedback_result = AddCommunicationFeedback_result{+ addCommunicationFeedback_result_ex = P.Nothing}+data AddSentenceFeedback_args = AddSentenceFeedback_args { addSentenceFeedback_args_searchResultsId :: Uuid_Types.UUID+ , addSentenceFeedback_args_communicationId :: LT.Text+ , addSentenceFeedback_args_sentenceId :: Uuid_Types.UUID+ , addSentenceFeedback_args_feedback :: SearchFeedback+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddSentenceFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addSentenceFeedback_args_searchResultsId record `H.hashWithSalt` addSentenceFeedback_args_communicationId record `H.hashWithSalt` addSentenceFeedback_args_sentenceId record `H.hashWithSalt` addSentenceFeedback_args_feedback record +instance QC.Arbitrary AddSentenceFeedback_args where + arbitrary = M.liftM AddSentenceFeedback_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddSentenceFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId = addSentenceFeedback_args_searchResultsId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId = addSentenceFeedback_args_searchResultsId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_communicationId = addSentenceFeedback_args_communicationId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_communicationId = addSentenceFeedback_args_communicationId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_sentenceId = addSentenceFeedback_args_sentenceId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_sentenceId = addSentenceFeedback_args_sentenceId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_feedback = addSentenceFeedback_args_feedback obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_feedback = addSentenceFeedback_args_feedback obj}+ ]+from_AddSentenceFeedback_args :: AddSentenceFeedback_args -> T.ThriftVal+from_AddSentenceFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v199 -> P.Just (1, ("searchResultsId",Uuid_Types.from_UUID _v199))) $ addSentenceFeedback_args_searchResultsId record+ , (\_v199 -> P.Just (2, ("communicationId",T.TString $ E.encodeUtf8 _v199))) $ addSentenceFeedback_args_communicationId record+ , (\_v199 -> P.Just (3, ("sentenceId",Uuid_Types.from_UUID _v199))) $ addSentenceFeedback_args_sentenceId record+ , (\_v199 -> P.Just (4, ("feedback",T.TI32 $ P.fromIntegral $ P.fromEnum _v199))) $ addSentenceFeedback_args_feedback record+ ]+write_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_args -> P.IO ()+write_AddSentenceFeedback_args oprot record = T.writeVal oprot $ from_AddSentenceFeedback_args record+encode_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_args -> LBS.ByteString+encode_AddSentenceFeedback_args oprot record = T.serializeVal oprot $ from_AddSentenceFeedback_args record+to_AddSentenceFeedback_args :: T.ThriftVal -> AddSentenceFeedback_args+to_AddSentenceFeedback_args (T.TStruct fields) = AddSentenceFeedback_args{+ addSentenceFeedback_args_searchResultsId = P.maybe (addSentenceFeedback_args_searchResultsId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TStruct _val202 -> (Uuid_Types.to_UUID (T.TStruct _val202)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addSentenceFeedback_args_communicationId = P.maybe (addSentenceFeedback_args_communicationId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TString _val203 -> E.decodeUtf8 _val203; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ addSentenceFeedback_args_sentenceId = P.maybe (addSentenceFeedback_args_sentenceId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TStruct _val204 -> (Uuid_Types.to_UUID (T.TStruct _val204)); _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ addSentenceFeedback_args_feedback = P.maybe (addSentenceFeedback_args_feedback default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TI32 _val205 -> P.toEnum $ P.fromIntegral _val205; _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_AddSentenceFeedback_args _ = P.error "not a struct"+read_AddSentenceFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddSentenceFeedback_args+read_AddSentenceFeedback_args iprot = to_AddSentenceFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_args)+decode_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddSentenceFeedback_args+decode_AddSentenceFeedback_args iprot bs = to_AddSentenceFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_args) bs+typemap_AddSentenceFeedback_args :: T.TypeMap+typemap_AddSentenceFeedback_args = Map.fromList [(1,("searchResultsId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("communicationId",T.T_STRING)),(3,("sentenceId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(4,("feedback",T.T_I32))]+default_AddSentenceFeedback_args :: AddSentenceFeedback_args+default_AddSentenceFeedback_args = AddSentenceFeedback_args{+ addSentenceFeedback_args_searchResultsId = Uuid_Types.default_UUID,+ addSentenceFeedback_args_communicationId = "",+ addSentenceFeedback_args_sentenceId = Uuid_Types.default_UUID,+ addSentenceFeedback_args_feedback = (P.toEnum 0)}+data AddSentenceFeedback_result = AddSentenceFeedback_result { addSentenceFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddSentenceFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` addSentenceFeedback_result_ex record +instance QC.Arbitrary AddSentenceFeedback_result where + arbitrary = M.liftM AddSentenceFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_AddSentenceFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = addSentenceFeedback_result_ex obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = addSentenceFeedback_result_ex obj}+ ]+from_AddSentenceFeedback_result :: AddSentenceFeedback_result -> T.ThriftVal+from_AddSentenceFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v208 -> (1, ("ex",Services_Types.from_ServicesException _v208))) <$> addSentenceFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v208 -> (1, ("ex",Services_Types.from_ServicesException _v208))) <$> addSentenceFeedback_result_ex record+ ]+ )+write_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_result -> P.IO ()+write_AddSentenceFeedback_result oprot record = T.writeVal oprot $ from_AddSentenceFeedback_result record+encode_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_result -> LBS.ByteString+encode_AddSentenceFeedback_result oprot record = T.serializeVal oprot $ from_AddSentenceFeedback_result record+to_AddSentenceFeedback_result :: T.ThriftVal -> AddSentenceFeedback_result+to_AddSentenceFeedback_result (T.TStruct fields) = AddSentenceFeedback_result{+ addSentenceFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val210) -> P.Just (case _val210 of {T.TStruct _val211 -> (Services_Types.to_ServicesException (T.TStruct _val211)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_AddSentenceFeedback_result _ = P.error "not a struct"+read_AddSentenceFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddSentenceFeedback_result+read_AddSentenceFeedback_result iprot = to_AddSentenceFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_result)+decode_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddSentenceFeedback_result+decode_AddSentenceFeedback_result iprot bs = to_AddSentenceFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_result) bs+typemap_AddSentenceFeedback_result :: T.TypeMap+typemap_AddSentenceFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_AddSentenceFeedback_result :: AddSentenceFeedback_result+default_AddSentenceFeedback_result = AddSentenceFeedback_result{+ addSentenceFeedback_result_ex = P.Nothing}+process_startFeedback (seqid, iprot, oprot, handler) = do+ args <- read_StartFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.startFeedback handler (startFeedback_args_results args)+ let res = default_StartFeedback_result+ T.writeMessageBegin oprot ("startFeedback", T.M_REPLY, seqid)+ write_StartFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StartFeedback_result{startFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("startFeedback", T.M_REPLY, seqid)+ write_StartFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("startFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addCommunicationFeedback (seqid, iprot, oprot, handler) = do+ args <- read_AddCommunicationFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.addCommunicationFeedback handler (addCommunicationFeedback_args_searchResultsId args) (addCommunicationFeedback_args_communicationId args) (addCommunicationFeedback_args_feedback args)+ let res = default_AddCommunicationFeedback_result+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_REPLY, seqid)+ write_AddCommunicationFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_REPLY, seqid)+ write_AddCommunicationFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addSentenceFeedback (seqid, iprot, oprot, handler) = do+ args <- read_AddSentenceFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.addSentenceFeedback handler (addSentenceFeedback_args_searchResultsId args) (addSentenceFeedback_args_communicationId args) (addSentenceFeedback_args_sentenceId args) (addSentenceFeedback_args_feedback args)+ let res = default_AddSentenceFeedback_result+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_REPLY, seqid)+ write_AddSentenceFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_REPLY, seqid)+ write_AddSentenceFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "startFeedback" -> process_startFeedback (seqid,iprot,oprot,handler)+ "addCommunicationFeedback" -> process_addCommunicationFeedback (seqid,iprot,oprot,handler)+ "addSentenceFeedback" -> process_addSentenceFeedback (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/FeedbackService_Client.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FeedbackService_Client(startFeedback,addCommunicationFeedback,addSentenceFeedback) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types+import FeedbackService+seqid = R.newIORef 0+startFeedback (ip,op) arg_results = do+ send_startFeedback op arg_results+ recv_startFeedback ip+send_startFeedback op arg_results = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("startFeedback", T.M_CALL, seqn)+ write_StartFeedback_args op (StartFeedback_args{startFeedback_args_results=arg_results})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_startFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StartFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (startFeedback_result_ex res)+ P.return ()+addCommunicationFeedback (ip,op) arg_searchResultsId arg_communicationId arg_feedback = do+ send_addCommunicationFeedback op arg_searchResultsId arg_communicationId arg_feedback+ recv_addCommunicationFeedback ip+send_addCommunicationFeedback op arg_searchResultsId arg_communicationId arg_feedback = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addCommunicationFeedback", T.M_CALL, seqn)+ write_AddCommunicationFeedback_args op (AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId=arg_searchResultsId,addCommunicationFeedback_args_communicationId=arg_communicationId,addCommunicationFeedback_args_feedback=arg_feedback})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addCommunicationFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddCommunicationFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (addCommunicationFeedback_result_ex res)+ P.return ()+addSentenceFeedback (ip,op) arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback = do+ send_addSentenceFeedback op arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback+ recv_addSentenceFeedback ip+send_addSentenceFeedback op arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addSentenceFeedback", T.M_CALL, seqn)+ write_AddSentenceFeedback_args op (AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId=arg_searchResultsId,addSentenceFeedback_args_communicationId=arg_communicationId,addSentenceFeedback_args_sentenceId=arg_sentenceId,addSentenceFeedback_args_feedback=arg_feedback})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addSentenceFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddSentenceFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (addSentenceFeedback_result_ex res)+ P.return ()
+ src/Data/Concrete/Services/FeedbackService_Iface.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FeedbackService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types++import Service_Iface+class Service_Iface a => FeedbackService_Iface a where+ startFeedback :: a -> SearchResult -> P.IO ()+ addCommunicationFeedback :: a -> Uuid_Types.UUID -> LT.Text -> SearchFeedback -> P.IO ()+ addSentenceFeedback :: a -> Uuid_Types.UUID -> LT.Text -> Uuid_Types.UUID -> SearchFeedback -> P.IO ()
+ src/Data/Concrete/Services/FetchCommunicationService.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FetchCommunicationService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import qualified Service+import Access_Types+import qualified FetchCommunicationService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Fetch_args = Fetch_args { fetch_args_request :: FetchRequest+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Fetch_args where+ hashWithSalt salt record = salt `H.hashWithSalt` fetch_args_request record +instance QC.Arbitrary Fetch_args where + arbitrary = M.liftM Fetch_args (QC.arbitrary)+ shrink obj | obj == default_Fetch_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Fetch_args{fetch_args_request = fetch_args_request obj} then P.Nothing else P.Just $ default_Fetch_args{fetch_args_request = fetch_args_request obj}+ ]+from_Fetch_args :: Fetch_args -> T.ThriftVal+from_Fetch_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v23 -> P.Just (1, ("request",from_FetchRequest _v23))) $ fetch_args_request record+ ]+write_Fetch_args :: (T.Protocol p, T.Transport t) => p t -> Fetch_args -> P.IO ()+write_Fetch_args oprot record = T.writeVal oprot $ from_Fetch_args record+encode_Fetch_args :: (T.Protocol p, T.Transport t) => p t -> Fetch_args -> LBS.ByteString+encode_Fetch_args oprot record = T.serializeVal oprot $ from_Fetch_args record+to_Fetch_args :: T.ThriftVal -> Fetch_args+to_Fetch_args (T.TStruct fields) = Fetch_args{+ fetch_args_request = P.maybe (fetch_args_request default_Fetch_args) (\(_,_val25) -> (case _val25 of {T.TStruct _val26 -> (to_FetchRequest (T.TStruct _val26)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Fetch_args _ = P.error "not a struct"+read_Fetch_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Fetch_args+read_Fetch_args iprot = to_Fetch_args <$> T.readVal iprot (T.T_STRUCT typemap_Fetch_args)+decode_Fetch_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Fetch_args+decode_Fetch_args iprot bs = to_Fetch_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Fetch_args) bs+typemap_Fetch_args :: T.TypeMap+typemap_Fetch_args = Map.fromList [(1,("request",(T.T_STRUCT typemap_FetchRequest)))]+default_Fetch_args :: Fetch_args+default_Fetch_args = Fetch_args{+ fetch_args_request = default_FetchRequest}+data Fetch_result = Fetch_result { fetch_result_success :: FetchResult+ , fetch_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Fetch_result where+ hashWithSalt salt record = salt `H.hashWithSalt` fetch_result_success record `H.hashWithSalt` fetch_result_ex record +instance QC.Arbitrary Fetch_result where + arbitrary = M.liftM Fetch_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Fetch_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Fetch_result{fetch_result_success = fetch_result_success obj} then P.Nothing else P.Just $ default_Fetch_result{fetch_result_success = fetch_result_success obj}+ , if obj == default_Fetch_result{fetch_result_ex = fetch_result_ex obj} then P.Nothing else P.Just $ default_Fetch_result{fetch_result_ex = fetch_result_ex obj}+ ]+from_Fetch_result :: Fetch_result -> T.ThriftVal+from_Fetch_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v29 -> (1, ("ex",Services_Types.from_ServicesException _v29))) <$> fetch_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v29 -> P.Just (0, ("success",from_FetchResult _v29))) $ fetch_result_success record+ , (\_v29 -> (1, ("ex",Services_Types.from_ServicesException _v29))) <$> fetch_result_ex record+ ]+ )+write_Fetch_result :: (T.Protocol p, T.Transport t) => p t -> Fetch_result -> P.IO ()+write_Fetch_result oprot record = T.writeVal oprot $ from_Fetch_result record+encode_Fetch_result :: (T.Protocol p, T.Transport t) => p t -> Fetch_result -> LBS.ByteString+encode_Fetch_result oprot record = T.serializeVal oprot $ from_Fetch_result record+to_Fetch_result :: T.ThriftVal -> Fetch_result+to_Fetch_result (T.TStruct fields) = Fetch_result{+ fetch_result_success = P.maybe (fetch_result_success default_Fetch_result) (\(_,_val31) -> (case _val31 of {T.TStruct _val32 -> (to_FetchResult (T.TStruct _val32)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ fetch_result_ex = P.maybe (P.Nothing) (\(_,_val31) -> P.Just (case _val31 of {T.TStruct _val33 -> (Services_Types.to_ServicesException (T.TStruct _val33)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Fetch_result _ = P.error "not a struct"+read_Fetch_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Fetch_result+read_Fetch_result iprot = to_Fetch_result <$> T.readVal iprot (T.T_STRUCT typemap_Fetch_result)+decode_Fetch_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Fetch_result+decode_Fetch_result iprot bs = to_Fetch_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Fetch_result) bs+typemap_Fetch_result :: T.TypeMap+typemap_Fetch_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_FetchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Fetch_result :: Fetch_result+default_Fetch_result = Fetch_result{+ fetch_result_success = default_FetchResult,+ fetch_result_ex = P.Nothing}+data GetCommunicationIDs_args = GetCommunicationIDs_args { getCommunicationIDs_args_offset :: I.Int64+ , getCommunicationIDs_args_count :: I.Int64+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCommunicationIDs_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getCommunicationIDs_args_offset record `H.hashWithSalt` getCommunicationIDs_args_count record +instance QC.Arbitrary GetCommunicationIDs_args where + arbitrary = M.liftM GetCommunicationIDs_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_GetCommunicationIDs_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCommunicationIDs_args{getCommunicationIDs_args_offset = getCommunicationIDs_args_offset obj} then P.Nothing else P.Just $ default_GetCommunicationIDs_args{getCommunicationIDs_args_offset = getCommunicationIDs_args_offset obj}+ , if obj == default_GetCommunicationIDs_args{getCommunicationIDs_args_count = getCommunicationIDs_args_count obj} then P.Nothing else P.Just $ default_GetCommunicationIDs_args{getCommunicationIDs_args_count = getCommunicationIDs_args_count obj}+ ]+from_GetCommunicationIDs_args :: GetCommunicationIDs_args -> T.ThriftVal+from_GetCommunicationIDs_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v36 -> P.Just (1, ("offset",T.TI64 _v36))) $ getCommunicationIDs_args_offset record+ , (\_v36 -> P.Just (2, ("count",T.TI64 _v36))) $ getCommunicationIDs_args_count record+ ]+write_GetCommunicationIDs_args :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationIDs_args -> P.IO ()+write_GetCommunicationIDs_args oprot record = T.writeVal oprot $ from_GetCommunicationIDs_args record+encode_GetCommunicationIDs_args :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationIDs_args -> LBS.ByteString+encode_GetCommunicationIDs_args oprot record = T.serializeVal oprot $ from_GetCommunicationIDs_args record+to_GetCommunicationIDs_args :: T.ThriftVal -> GetCommunicationIDs_args+to_GetCommunicationIDs_args (T.TStruct fields) = GetCommunicationIDs_args{+ getCommunicationIDs_args_offset = P.maybe (getCommunicationIDs_args_offset default_GetCommunicationIDs_args) (\(_,_val38) -> (case _val38 of {T.TI64 _val39 -> _val39; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ getCommunicationIDs_args_count = P.maybe (getCommunicationIDs_args_count default_GetCommunicationIDs_args) (\(_,_val38) -> (case _val38 of {T.TI64 _val40 -> _val40; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_GetCommunicationIDs_args _ = P.error "not a struct"+read_GetCommunicationIDs_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCommunicationIDs_args+read_GetCommunicationIDs_args iprot = to_GetCommunicationIDs_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCommunicationIDs_args)+decode_GetCommunicationIDs_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCommunicationIDs_args+decode_GetCommunicationIDs_args iprot bs = to_GetCommunicationIDs_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCommunicationIDs_args) bs+typemap_GetCommunicationIDs_args :: T.TypeMap+typemap_GetCommunicationIDs_args = Map.fromList [(1,("offset",T.T_I64)),(2,("count",T.T_I64))]+default_GetCommunicationIDs_args :: GetCommunicationIDs_args+default_GetCommunicationIDs_args = GetCommunicationIDs_args{+ getCommunicationIDs_args_offset = 0,+ getCommunicationIDs_args_count = 0}+data GetCommunicationIDs_result = GetCommunicationIDs_result { getCommunicationIDs_result_success :: (Vector.Vector LT.Text)+ , getCommunicationIDs_result_ex :: P.Maybe Services_Types.NotImplementedException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCommunicationIDs_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCommunicationIDs_result_success record `H.hashWithSalt` getCommunicationIDs_result_ex record +instance QC.Arbitrary GetCommunicationIDs_result where + arbitrary = M.liftM GetCommunicationIDs_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCommunicationIDs_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCommunicationIDs_result{getCommunicationIDs_result_success = getCommunicationIDs_result_success obj} then P.Nothing else P.Just $ default_GetCommunicationIDs_result{getCommunicationIDs_result_success = getCommunicationIDs_result_success obj}+ , if obj == default_GetCommunicationIDs_result{getCommunicationIDs_result_ex = getCommunicationIDs_result_ex obj} then P.Nothing else P.Just $ default_GetCommunicationIDs_result{getCommunicationIDs_result_ex = getCommunicationIDs_result_ex obj}+ ]+from_GetCommunicationIDs_result :: GetCommunicationIDs_result -> T.ThriftVal+from_GetCommunicationIDs_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v43 -> (1, ("ex",Services_Types.from_NotImplementedException _v43))) <$> getCommunicationIDs_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v43 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v45 -> T.TString $ E.encodeUtf8 _v45) $ Vector.toList _v43))) $ getCommunicationIDs_result_success record+ , (\_v43 -> (1, ("ex",Services_Types.from_NotImplementedException _v43))) <$> getCommunicationIDs_result_ex record+ ]+ )+write_GetCommunicationIDs_result :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationIDs_result -> P.IO ()+write_GetCommunicationIDs_result oprot record = T.writeVal oprot $ from_GetCommunicationIDs_result record+encode_GetCommunicationIDs_result :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationIDs_result -> LBS.ByteString+encode_GetCommunicationIDs_result oprot record = T.serializeVal oprot $ from_GetCommunicationIDs_result record+to_GetCommunicationIDs_result :: T.ThriftVal -> GetCommunicationIDs_result+to_GetCommunicationIDs_result (T.TStruct fields) = GetCommunicationIDs_result{+ getCommunicationIDs_result_success = P.maybe (getCommunicationIDs_result_success default_GetCommunicationIDs_result) (\(_,_val47) -> (case _val47 of {T.TList _ _val48 -> (Vector.fromList $ P.map (\_v49 -> (case _v49 of {T.TString _val50 -> E.decodeUtf8 _val50; _ -> P.error "wrong type"})) _val48); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCommunicationIDs_result_ex = P.maybe (P.Nothing) (\(_,_val47) -> P.Just (case _val47 of {T.TStruct _val51 -> (Services_Types.to_NotImplementedException (T.TStruct _val51)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCommunicationIDs_result _ = P.error "not a struct"+read_GetCommunicationIDs_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCommunicationIDs_result+read_GetCommunicationIDs_result iprot = to_GetCommunicationIDs_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCommunicationIDs_result)+decode_GetCommunicationIDs_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCommunicationIDs_result+decode_GetCommunicationIDs_result iprot bs = to_GetCommunicationIDs_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCommunicationIDs_result) bs+typemap_GetCommunicationIDs_result :: T.TypeMap+typemap_GetCommunicationIDs_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_NotImplementedException)))]+default_GetCommunicationIDs_result :: GetCommunicationIDs_result+default_GetCommunicationIDs_result = GetCommunicationIDs_result{+ getCommunicationIDs_result_success = Vector.empty,+ getCommunicationIDs_result_ex = P.Nothing}+data GetCommunicationCount_args = GetCommunicationCount_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCommunicationCount_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetCommunicationCount_args where + arbitrary = QC.elements [GetCommunicationCount_args]+from_GetCommunicationCount_args :: GetCommunicationCount_args -> T.ThriftVal+from_GetCommunicationCount_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetCommunicationCount_args :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationCount_args -> P.IO ()+write_GetCommunicationCount_args oprot record = T.writeVal oprot $ from_GetCommunicationCount_args record+encode_GetCommunicationCount_args :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationCount_args -> LBS.ByteString+encode_GetCommunicationCount_args oprot record = T.serializeVal oprot $ from_GetCommunicationCount_args record+to_GetCommunicationCount_args :: T.ThriftVal -> GetCommunicationCount_args+to_GetCommunicationCount_args (T.TStruct fields) = GetCommunicationCount_args{++ }+to_GetCommunicationCount_args _ = P.error "not a struct"+read_GetCommunicationCount_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCommunicationCount_args+read_GetCommunicationCount_args iprot = to_GetCommunicationCount_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCommunicationCount_args)+decode_GetCommunicationCount_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCommunicationCount_args+decode_GetCommunicationCount_args iprot bs = to_GetCommunicationCount_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCommunicationCount_args) bs+typemap_GetCommunicationCount_args :: T.TypeMap+typemap_GetCommunicationCount_args = Map.fromList []+default_GetCommunicationCount_args :: GetCommunicationCount_args+default_GetCommunicationCount_args = GetCommunicationCount_args{+}+data GetCommunicationCount_result = GetCommunicationCount_result { getCommunicationCount_result_success :: I.Int64+ , getCommunicationCount_result_ex :: P.Maybe Services_Types.NotImplementedException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCommunicationCount_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCommunicationCount_result_success record `H.hashWithSalt` getCommunicationCount_result_ex record +instance QC.Arbitrary GetCommunicationCount_result where + arbitrary = M.liftM GetCommunicationCount_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCommunicationCount_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCommunicationCount_result{getCommunicationCount_result_success = getCommunicationCount_result_success obj} then P.Nothing else P.Just $ default_GetCommunicationCount_result{getCommunicationCount_result_success = getCommunicationCount_result_success obj}+ , if obj == default_GetCommunicationCount_result{getCommunicationCount_result_ex = getCommunicationCount_result_ex obj} then P.Nothing else P.Just $ default_GetCommunicationCount_result{getCommunicationCount_result_ex = getCommunicationCount_result_ex obj}+ ]+from_GetCommunicationCount_result :: GetCommunicationCount_result -> T.ThriftVal+from_GetCommunicationCount_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v59 -> (1, ("ex",Services_Types.from_NotImplementedException _v59))) <$> getCommunicationCount_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v59 -> P.Just (0, ("success",T.TI64 _v59))) $ getCommunicationCount_result_success record+ , (\_v59 -> (1, ("ex",Services_Types.from_NotImplementedException _v59))) <$> getCommunicationCount_result_ex record+ ]+ )+write_GetCommunicationCount_result :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationCount_result -> P.IO ()+write_GetCommunicationCount_result oprot record = T.writeVal oprot $ from_GetCommunicationCount_result record+encode_GetCommunicationCount_result :: (T.Protocol p, T.Transport t) => p t -> GetCommunicationCount_result -> LBS.ByteString+encode_GetCommunicationCount_result oprot record = T.serializeVal oprot $ from_GetCommunicationCount_result record+to_GetCommunicationCount_result :: T.ThriftVal -> GetCommunicationCount_result+to_GetCommunicationCount_result (T.TStruct fields) = GetCommunicationCount_result{+ getCommunicationCount_result_success = P.maybe (getCommunicationCount_result_success default_GetCommunicationCount_result) (\(_,_val61) -> (case _val61 of {T.TI64 _val62 -> _val62; _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCommunicationCount_result_ex = P.maybe (P.Nothing) (\(_,_val61) -> P.Just (case _val61 of {T.TStruct _val63 -> (Services_Types.to_NotImplementedException (T.TStruct _val63)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCommunicationCount_result _ = P.error "not a struct"+read_GetCommunicationCount_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCommunicationCount_result+read_GetCommunicationCount_result iprot = to_GetCommunicationCount_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCommunicationCount_result)+decode_GetCommunicationCount_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCommunicationCount_result+decode_GetCommunicationCount_result iprot bs = to_GetCommunicationCount_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCommunicationCount_result) bs+typemap_GetCommunicationCount_result :: T.TypeMap+typemap_GetCommunicationCount_result = Map.fromList [(0,("success",T.T_I64)),(1,("ex",(T.T_STRUCT Services_Types.typemap_NotImplementedException)))]+default_GetCommunicationCount_result :: GetCommunicationCount_result+default_GetCommunicationCount_result = GetCommunicationCount_result{+ getCommunicationCount_result_success = 0,+ getCommunicationCount_result_ex = P.Nothing}+process_fetch (seqid, iprot, oprot, handler) = do+ args <- read_Fetch_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.fetch handler (fetch_args_request args)+ let res = default_Fetch_result{fetch_result_success = val}+ T.writeMessageBegin oprot ("fetch", T.M_REPLY, seqid)+ write_Fetch_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Fetch_result{fetch_result_ex = P.Just e}+ T.writeMessageBegin oprot ("fetch", T.M_REPLY, seqid)+ write_Fetch_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("fetch", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCommunicationIDs (seqid, iprot, oprot, handler) = do+ args <- read_GetCommunicationIDs_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCommunicationIDs handler (getCommunicationIDs_args_offset args) (getCommunicationIDs_args_count args)+ let res = default_GetCommunicationIDs_result{getCommunicationIDs_result_success = val}+ T.writeMessageBegin oprot ("getCommunicationIDs", T.M_REPLY, seqid)+ write_GetCommunicationIDs_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCommunicationIDs_result{getCommunicationIDs_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCommunicationIDs", T.M_REPLY, seqid)+ write_GetCommunicationIDs_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCommunicationIDs", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCommunicationCount (seqid, iprot, oprot, handler) = do+ args <- read_GetCommunicationCount_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCommunicationCount handler+ let res = default_GetCommunicationCount_result{getCommunicationCount_result_success = val}+ T.writeMessageBegin oprot ("getCommunicationCount", T.M_REPLY, seqid)+ write_GetCommunicationCount_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCommunicationCount_result{getCommunicationCount_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCommunicationCount", T.M_REPLY, seqid)+ write_GetCommunicationCount_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCommunicationCount", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "fetch" -> process_fetch (seqid,iprot,oprot,handler)+ "getCommunicationIDs" -> process_getCommunicationIDs (seqid,iprot,oprot,handler)+ "getCommunicationCount" -> process_getCommunicationCount (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/FetchCommunicationService_Client.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FetchCommunicationService_Client(fetch,getCommunicationIDs,getCommunicationCount) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import Access_Types+import FetchCommunicationService+seqid = R.newIORef 0+fetch (ip,op) arg_request = do+ send_fetch op arg_request+ recv_fetch ip+send_fetch op arg_request = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("fetch", T.M_CALL, seqn)+ write_Fetch_args op (Fetch_args{fetch_args_request=arg_request})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_fetch ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Fetch_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (fetch_result_ex res)+ P.return $ fetch_result_success res+getCommunicationIDs (ip,op) arg_offset arg_count = do+ send_getCommunicationIDs op arg_offset arg_count+ recv_getCommunicationIDs ip+send_getCommunicationIDs op arg_offset arg_count = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCommunicationIDs", T.M_CALL, seqn)+ write_GetCommunicationIDs_args op (GetCommunicationIDs_args{getCommunicationIDs_args_offset=arg_offset,getCommunicationIDs_args_count=arg_count})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCommunicationIDs ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCommunicationIDs_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCommunicationIDs_result_ex res)+ P.return $ getCommunicationIDs_result_success res+getCommunicationCount (ip,op) = do+ send_getCommunicationCount op+ recv_getCommunicationCount ip+send_getCommunicationCount op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCommunicationCount", T.M_CALL, seqn)+ write_GetCommunicationCount_args op (GetCommunicationCount_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCommunicationCount ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCommunicationCount_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCommunicationCount_result_ex res)+ P.return $ getCommunicationCount_result_success res
+ src/Data/Concrete/Services/FetchCommunicationService_Iface.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.FetchCommunicationService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import Access_Types++import Service_Iface+class Service_Iface a => FetchCommunicationService_Iface a where+ fetch :: a -> FetchRequest -> P.IO FetchResult+ getCommunicationIDs :: a -> I.Int64 -> I.Int64 -> P.IO (Vector.Vector LT.Text)+ getCommunicationCount :: a -> P.IO I.Int64
+ src/Data/Concrete/Services/ResultsServerService.hs view
@@ -0,0 +1,945 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ResultsServerService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import qualified Service+import Results_Types+import qualified ResultsServerService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data RegisterSearchResult_args = RegisterSearchResult_args { registerSearchResult_args_result :: Search_Types.SearchResult+ , registerSearchResult_args_taskType :: Services_Types.AnnotationTaskType+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable RegisterSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` registerSearchResult_args_result record `H.hashWithSalt` registerSearchResult_args_taskType record +instance QC.Arbitrary RegisterSearchResult_args where + arbitrary = M.liftM RegisterSearchResult_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_RegisterSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_RegisterSearchResult_args{registerSearchResult_args_result = registerSearchResult_args_result obj} then P.Nothing else P.Just $ default_RegisterSearchResult_args{registerSearchResult_args_result = registerSearchResult_args_result obj}+ , if obj == default_RegisterSearchResult_args{registerSearchResult_args_taskType = registerSearchResult_args_taskType obj} then P.Nothing else P.Just $ default_RegisterSearchResult_args{registerSearchResult_args_taskType = registerSearchResult_args_taskType obj}+ ]+from_RegisterSearchResult_args :: RegisterSearchResult_args -> T.ThriftVal+from_RegisterSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("result",Search_Types.from_SearchResult _v2))) $ registerSearchResult_args_result record+ , (\_v2 -> P.Just (2, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v2))) $ registerSearchResult_args_taskType record+ ]+write_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_args -> P.IO ()+write_RegisterSearchResult_args oprot record = T.writeVal oprot $ from_RegisterSearchResult_args record+encode_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_args -> LBS.ByteString+encode_RegisterSearchResult_args oprot record = T.serializeVal oprot $ from_RegisterSearchResult_args record+to_RegisterSearchResult_args :: T.ThriftVal -> RegisterSearchResult_args+to_RegisterSearchResult_args (T.TStruct fields) = RegisterSearchResult_args{+ registerSearchResult_args_result = P.maybe (registerSearchResult_args_result default_RegisterSearchResult_args) (\(_,_val4) -> (case _val4 of {T.TStruct _val5 -> (Search_Types.to_SearchResult (T.TStruct _val5)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ registerSearchResult_args_taskType = P.maybe (registerSearchResult_args_taskType default_RegisterSearchResult_args) (\(_,_val4) -> (case _val4 of {T.TI32 _val6 -> P.toEnum $ P.fromIntegral _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_RegisterSearchResult_args _ = P.error "not a struct"+read_RegisterSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO RegisterSearchResult_args+read_RegisterSearchResult_args iprot = to_RegisterSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_RegisterSearchResult_args)+decode_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> RegisterSearchResult_args+decode_RegisterSearchResult_args iprot bs = to_RegisterSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_RegisterSearchResult_args) bs+typemap_RegisterSearchResult_args :: T.TypeMap+typemap_RegisterSearchResult_args = Map.fromList [(1,("result",(T.T_STRUCT Search_Types.typemap_SearchResult))),(2,("taskType",T.T_I32))]+default_RegisterSearchResult_args :: RegisterSearchResult_args+default_RegisterSearchResult_args = RegisterSearchResult_args{+ registerSearchResult_args_result = Search_Types.default_SearchResult,+ registerSearchResult_args_taskType = (P.toEnum 0)}+data RegisterSearchResult_result = RegisterSearchResult_result { registerSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable RegisterSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` registerSearchResult_result_ex record +instance QC.Arbitrary RegisterSearchResult_result where + arbitrary = M.liftM RegisterSearchResult_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_RegisterSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_RegisterSearchResult_result{registerSearchResult_result_ex = registerSearchResult_result_ex obj} then P.Nothing else P.Just $ default_RegisterSearchResult_result{registerSearchResult_result_ex = registerSearchResult_result_ex obj}+ ]+from_RegisterSearchResult_result :: RegisterSearchResult_result -> T.ThriftVal+from_RegisterSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v9 -> (1, ("ex",Services_Types.from_ServicesException _v9))) <$> registerSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v9 -> (1, ("ex",Services_Types.from_ServicesException _v9))) <$> registerSearchResult_result_ex record+ ]+ )+write_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_result -> P.IO ()+write_RegisterSearchResult_result oprot record = T.writeVal oprot $ from_RegisterSearchResult_result record+encode_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_result -> LBS.ByteString+encode_RegisterSearchResult_result oprot record = T.serializeVal oprot $ from_RegisterSearchResult_result record+to_RegisterSearchResult_result :: T.ThriftVal -> RegisterSearchResult_result+to_RegisterSearchResult_result (T.TStruct fields) = RegisterSearchResult_result{+ registerSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val11) -> P.Just (case _val11 of {T.TStruct _val12 -> (Services_Types.to_ServicesException (T.TStruct _val12)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_RegisterSearchResult_result _ = P.error "not a struct"+read_RegisterSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO RegisterSearchResult_result+read_RegisterSearchResult_result iprot = to_RegisterSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_RegisterSearchResult_result)+decode_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> RegisterSearchResult_result+decode_RegisterSearchResult_result iprot bs = to_RegisterSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_RegisterSearchResult_result) bs+typemap_RegisterSearchResult_result :: T.TypeMap+typemap_RegisterSearchResult_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_RegisterSearchResult_result :: RegisterSearchResult_result+default_RegisterSearchResult_result = RegisterSearchResult_result{+ registerSearchResult_result_ex = P.Nothing}+data GetSearchResults_args = GetSearchResults_args { getSearchResults_args_taskType :: Services_Types.AnnotationTaskType+ , getSearchResults_args_limit :: I.Int32+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResults_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResults_args_taskType record `H.hashWithSalt` getSearchResults_args_limit record +instance QC.Arbitrary GetSearchResults_args where + arbitrary = M.liftM GetSearchResults_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_GetSearchResults_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResults_args{getSearchResults_args_taskType = getSearchResults_args_taskType obj} then P.Nothing else P.Just $ default_GetSearchResults_args{getSearchResults_args_taskType = getSearchResults_args_taskType obj}+ , if obj == default_GetSearchResults_args{getSearchResults_args_limit = getSearchResults_args_limit obj} then P.Nothing else P.Just $ default_GetSearchResults_args{getSearchResults_args_limit = getSearchResults_args_limit obj}+ ]+from_GetSearchResults_args :: GetSearchResults_args -> T.ThriftVal+from_GetSearchResults_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v15 -> P.Just (1, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v15))) $ getSearchResults_args_taskType record+ , (\_v15 -> P.Just (2, ("limit",T.TI32 _v15))) $ getSearchResults_args_limit record+ ]+write_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_args -> P.IO ()+write_GetSearchResults_args oprot record = T.writeVal oprot $ from_GetSearchResults_args record+encode_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_args -> LBS.ByteString+encode_GetSearchResults_args oprot record = T.serializeVal oprot $ from_GetSearchResults_args record+to_GetSearchResults_args :: T.ThriftVal -> GetSearchResults_args+to_GetSearchResults_args (T.TStruct fields) = GetSearchResults_args{+ getSearchResults_args_taskType = P.maybe (getSearchResults_args_taskType default_GetSearchResults_args) (\(_,_val17) -> (case _val17 of {T.TI32 _val18 -> P.toEnum $ P.fromIntegral _val18; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ getSearchResults_args_limit = P.maybe (getSearchResults_args_limit default_GetSearchResults_args) (\(_,_val17) -> (case _val17 of {T.TI32 _val19 -> _val19; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_GetSearchResults_args _ = P.error "not a struct"+read_GetSearchResults_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResults_args+read_GetSearchResults_args iprot = to_GetSearchResults_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResults_args)+decode_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResults_args+decode_GetSearchResults_args iprot bs = to_GetSearchResults_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResults_args) bs+typemap_GetSearchResults_args :: T.TypeMap+typemap_GetSearchResults_args = Map.fromList [(1,("taskType",T.T_I32)),(2,("limit",T.T_I32))]+default_GetSearchResults_args :: GetSearchResults_args+default_GetSearchResults_args = GetSearchResults_args{+ getSearchResults_args_taskType = (P.toEnum 0),+ getSearchResults_args_limit = 0}+data GetSearchResults_result = GetSearchResults_result { getSearchResults_result_success :: (Vector.Vector Search_Types.SearchResult)+ , getSearchResults_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResults_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResults_result_success record `H.hashWithSalt` getSearchResults_result_ex record +instance QC.Arbitrary GetSearchResults_result where + arbitrary = M.liftM GetSearchResults_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResults_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResults_result{getSearchResults_result_success = getSearchResults_result_success obj} then P.Nothing else P.Just $ default_GetSearchResults_result{getSearchResults_result_success = getSearchResults_result_success obj}+ , if obj == default_GetSearchResults_result{getSearchResults_result_ex = getSearchResults_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResults_result{getSearchResults_result_ex = getSearchResults_result_ex obj}+ ]+from_GetSearchResults_result :: GetSearchResults_result -> T.ThriftVal+from_GetSearchResults_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v22 -> (1, ("ex",Services_Types.from_ServicesException _v22))) <$> getSearchResults_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v22 -> P.Just (0, ("success",T.TList (T.T_STRUCT Search_Types.typemap_SearchResult) $ P.map (\_v24 -> Search_Types.from_SearchResult _v24) $ Vector.toList _v22))) $ getSearchResults_result_success record+ , (\_v22 -> (1, ("ex",Services_Types.from_ServicesException _v22))) <$> getSearchResults_result_ex record+ ]+ )+write_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_result -> P.IO ()+write_GetSearchResults_result oprot record = T.writeVal oprot $ from_GetSearchResults_result record+encode_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_result -> LBS.ByteString+encode_GetSearchResults_result oprot record = T.serializeVal oprot $ from_GetSearchResults_result record+to_GetSearchResults_result :: T.ThriftVal -> GetSearchResults_result+to_GetSearchResults_result (T.TStruct fields) = GetSearchResults_result{+ getSearchResults_result_success = P.maybe (getSearchResults_result_success default_GetSearchResults_result) (\(_,_val26) -> (case _val26 of {T.TList _ _val27 -> (Vector.fromList $ P.map (\_v28 -> (case _v28 of {T.TStruct _val29 -> (Search_Types.to_SearchResult (T.TStruct _val29)); _ -> P.error "wrong type"})) _val27); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResults_result_ex = P.maybe (P.Nothing) (\(_,_val26) -> P.Just (case _val26 of {T.TStruct _val30 -> (Services_Types.to_ServicesException (T.TStruct _val30)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResults_result _ = P.error "not a struct"+read_GetSearchResults_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResults_result+read_GetSearchResults_result iprot = to_GetSearchResults_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResults_result)+decode_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResults_result+decode_GetSearchResults_result iprot bs = to_GetSearchResults_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResults_result) bs+typemap_GetSearchResults_result :: T.TypeMap+typemap_GetSearchResults_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Search_Types.typemap_SearchResult)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResults_result :: GetSearchResults_result+default_GetSearchResults_result = GetSearchResults_result{+ getSearchResults_result_success = Vector.empty,+ getSearchResults_result_ex = P.Nothing}+data GetSearchResultsByUser_args = GetSearchResultsByUser_args { getSearchResultsByUser_args_taskType :: Services_Types.AnnotationTaskType+ , getSearchResultsByUser_args_userId :: LT.Text+ , getSearchResultsByUser_args_limit :: I.Int32+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResultsByUser_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResultsByUser_args_taskType record `H.hashWithSalt` getSearchResultsByUser_args_userId record `H.hashWithSalt` getSearchResultsByUser_args_limit record +instance QC.Arbitrary GetSearchResultsByUser_args where + arbitrary = M.liftM GetSearchResultsByUser_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_GetSearchResultsByUser_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType = getSearchResultsByUser_args_taskType obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType = getSearchResultsByUser_args_taskType obj}+ , if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_userId = getSearchResultsByUser_args_userId obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_userId = getSearchResultsByUser_args_userId obj}+ , if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_limit = getSearchResultsByUser_args_limit obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_limit = getSearchResultsByUser_args_limit obj}+ ]+from_GetSearchResultsByUser_args :: GetSearchResultsByUser_args -> T.ThriftVal+from_GetSearchResultsByUser_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v33 -> P.Just (1, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v33))) $ getSearchResultsByUser_args_taskType record+ , (\_v33 -> P.Just (2, ("userId",T.TString $ E.encodeUtf8 _v33))) $ getSearchResultsByUser_args_userId record+ , (\_v33 -> P.Just (3, ("limit",T.TI32 _v33))) $ getSearchResultsByUser_args_limit record+ ]+write_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_args -> P.IO ()+write_GetSearchResultsByUser_args oprot record = T.writeVal oprot $ from_GetSearchResultsByUser_args record+encode_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_args -> LBS.ByteString+encode_GetSearchResultsByUser_args oprot record = T.serializeVal oprot $ from_GetSearchResultsByUser_args record+to_GetSearchResultsByUser_args :: T.ThriftVal -> GetSearchResultsByUser_args+to_GetSearchResultsByUser_args (T.TStruct fields) = GetSearchResultsByUser_args{+ getSearchResultsByUser_args_taskType = P.maybe (getSearchResultsByUser_args_taskType default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TI32 _val36 -> P.toEnum $ P.fromIntegral _val36; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ getSearchResultsByUser_args_userId = P.maybe (getSearchResultsByUser_args_userId default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TString _val37 -> E.decodeUtf8 _val37; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ getSearchResultsByUser_args_limit = P.maybe (getSearchResultsByUser_args_limit default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TI32 _val38 -> _val38; _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_GetSearchResultsByUser_args _ = P.error "not a struct"+read_GetSearchResultsByUser_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResultsByUser_args+read_GetSearchResultsByUser_args iprot = to_GetSearchResultsByUser_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_args)+decode_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResultsByUser_args+decode_GetSearchResultsByUser_args iprot bs = to_GetSearchResultsByUser_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_args) bs+typemap_GetSearchResultsByUser_args :: T.TypeMap+typemap_GetSearchResultsByUser_args = Map.fromList [(1,("taskType",T.T_I32)),(2,("userId",T.T_STRING)),(3,("limit",T.T_I32))]+default_GetSearchResultsByUser_args :: GetSearchResultsByUser_args+default_GetSearchResultsByUser_args = GetSearchResultsByUser_args{+ getSearchResultsByUser_args_taskType = (P.toEnum 0),+ getSearchResultsByUser_args_userId = "",+ getSearchResultsByUser_args_limit = 0}+data GetSearchResultsByUser_result = GetSearchResultsByUser_result { getSearchResultsByUser_result_success :: (Vector.Vector Search_Types.SearchResult)+ , getSearchResultsByUser_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResultsByUser_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResultsByUser_result_success record `H.hashWithSalt` getSearchResultsByUser_result_ex record +instance QC.Arbitrary GetSearchResultsByUser_result where + arbitrary = M.liftM GetSearchResultsByUser_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResultsByUser_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = getSearchResultsByUser_result_success obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = getSearchResultsByUser_result_success obj}+ , if obj == default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = getSearchResultsByUser_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = getSearchResultsByUser_result_ex obj}+ ]+from_GetSearchResultsByUser_result :: GetSearchResultsByUser_result -> T.ThriftVal+from_GetSearchResultsByUser_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v41 -> (1, ("ex",Services_Types.from_ServicesException _v41))) <$> getSearchResultsByUser_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v41 -> P.Just (0, ("success",T.TList (T.T_STRUCT Search_Types.typemap_SearchResult) $ P.map (\_v43 -> Search_Types.from_SearchResult _v43) $ Vector.toList _v41))) $ getSearchResultsByUser_result_success record+ , (\_v41 -> (1, ("ex",Services_Types.from_ServicesException _v41))) <$> getSearchResultsByUser_result_ex record+ ]+ )+write_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_result -> P.IO ()+write_GetSearchResultsByUser_result oprot record = T.writeVal oprot $ from_GetSearchResultsByUser_result record+encode_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_result -> LBS.ByteString+encode_GetSearchResultsByUser_result oprot record = T.serializeVal oprot $ from_GetSearchResultsByUser_result record+to_GetSearchResultsByUser_result :: T.ThriftVal -> GetSearchResultsByUser_result+to_GetSearchResultsByUser_result (T.TStruct fields) = GetSearchResultsByUser_result{+ getSearchResultsByUser_result_success = P.maybe (getSearchResultsByUser_result_success default_GetSearchResultsByUser_result) (\(_,_val45) -> (case _val45 of {T.TList _ _val46 -> (Vector.fromList $ P.map (\_v47 -> (case _v47 of {T.TStruct _val48 -> (Search_Types.to_SearchResult (T.TStruct _val48)); _ -> P.error "wrong type"})) _val46); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResultsByUser_result_ex = P.maybe (P.Nothing) (\(_,_val45) -> P.Just (case _val45 of {T.TStruct _val49 -> (Services_Types.to_ServicesException (T.TStruct _val49)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResultsByUser_result _ = P.error "not a struct"+read_GetSearchResultsByUser_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResultsByUser_result+read_GetSearchResultsByUser_result iprot = to_GetSearchResultsByUser_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_result)+decode_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResultsByUser_result+decode_GetSearchResultsByUser_result iprot bs = to_GetSearchResultsByUser_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_result) bs+typemap_GetSearchResultsByUser_result :: T.TypeMap+typemap_GetSearchResultsByUser_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Search_Types.typemap_SearchResult)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResultsByUser_result :: GetSearchResultsByUser_result+default_GetSearchResultsByUser_result = GetSearchResultsByUser_result{+ getSearchResultsByUser_result_success = Vector.empty,+ getSearchResultsByUser_result_ex = P.Nothing}+data GetLatestSearchResult_args = GetLatestSearchResult_args { getLatestSearchResult_args_userId :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetLatestSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getLatestSearchResult_args_userId record +instance QC.Arbitrary GetLatestSearchResult_args where + arbitrary = M.liftM GetLatestSearchResult_args (QC.arbitrary)+ shrink obj | obj == default_GetLatestSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetLatestSearchResult_args{getLatestSearchResult_args_userId = getLatestSearchResult_args_userId obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_args{getLatestSearchResult_args_userId = getLatestSearchResult_args_userId obj}+ ]+from_GetLatestSearchResult_args :: GetLatestSearchResult_args -> T.ThriftVal+from_GetLatestSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v52 -> P.Just (1, ("userId",T.TString $ E.encodeUtf8 _v52))) $ getLatestSearchResult_args_userId record+ ]+write_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_args -> P.IO ()+write_GetLatestSearchResult_args oprot record = T.writeVal oprot $ from_GetLatestSearchResult_args record+encode_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_args -> LBS.ByteString+encode_GetLatestSearchResult_args oprot record = T.serializeVal oprot $ from_GetLatestSearchResult_args record+to_GetLatestSearchResult_args :: T.ThriftVal -> GetLatestSearchResult_args+to_GetLatestSearchResult_args (T.TStruct fields) = GetLatestSearchResult_args{+ getLatestSearchResult_args_userId = P.maybe (getLatestSearchResult_args_userId default_GetLatestSearchResult_args) (\(_,_val54) -> (case _val54 of {T.TString _val55 -> E.decodeUtf8 _val55; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetLatestSearchResult_args _ = P.error "not a struct"+read_GetLatestSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetLatestSearchResult_args+read_GetLatestSearchResult_args iprot = to_GetLatestSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_args)+decode_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetLatestSearchResult_args+decode_GetLatestSearchResult_args iprot bs = to_GetLatestSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_args) bs+typemap_GetLatestSearchResult_args :: T.TypeMap+typemap_GetLatestSearchResult_args = Map.fromList [(1,("userId",T.T_STRING))]+default_GetLatestSearchResult_args :: GetLatestSearchResult_args+default_GetLatestSearchResult_args = GetLatestSearchResult_args{+ getLatestSearchResult_args_userId = ""}+data GetLatestSearchResult_result = GetLatestSearchResult_result { getLatestSearchResult_result_success :: Search_Types.SearchResult+ , getLatestSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetLatestSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getLatestSearchResult_result_success record `H.hashWithSalt` getLatestSearchResult_result_ex record +instance QC.Arbitrary GetLatestSearchResult_result where + arbitrary = M.liftM GetLatestSearchResult_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetLatestSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetLatestSearchResult_result{getLatestSearchResult_result_success = getLatestSearchResult_result_success obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_result{getLatestSearchResult_result_success = getLatestSearchResult_result_success obj}+ , if obj == default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = getLatestSearchResult_result_ex obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = getLatestSearchResult_result_ex obj}+ ]+from_GetLatestSearchResult_result :: GetLatestSearchResult_result -> T.ThriftVal+from_GetLatestSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v58 -> (1, ("ex",Services_Types.from_ServicesException _v58))) <$> getLatestSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v58 -> P.Just (0, ("success",Search_Types.from_SearchResult _v58))) $ getLatestSearchResult_result_success record+ , (\_v58 -> (1, ("ex",Services_Types.from_ServicesException _v58))) <$> getLatestSearchResult_result_ex record+ ]+ )+write_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_result -> P.IO ()+write_GetLatestSearchResult_result oprot record = T.writeVal oprot $ from_GetLatestSearchResult_result record+encode_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_result -> LBS.ByteString+encode_GetLatestSearchResult_result oprot record = T.serializeVal oprot $ from_GetLatestSearchResult_result record+to_GetLatestSearchResult_result :: T.ThriftVal -> GetLatestSearchResult_result+to_GetLatestSearchResult_result (T.TStruct fields) = GetLatestSearchResult_result{+ getLatestSearchResult_result_success = P.maybe (getLatestSearchResult_result_success default_GetLatestSearchResult_result) (\(_,_val60) -> (case _val60 of {T.TStruct _val61 -> (Search_Types.to_SearchResult (T.TStruct _val61)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getLatestSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val60) -> P.Just (case _val60 of {T.TStruct _val62 -> (Services_Types.to_ServicesException (T.TStruct _val62)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetLatestSearchResult_result _ = P.error "not a struct"+read_GetLatestSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetLatestSearchResult_result+read_GetLatestSearchResult_result iprot = to_GetLatestSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_result)+decode_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetLatestSearchResult_result+decode_GetLatestSearchResult_result iprot bs = to_GetLatestSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_result) bs+typemap_GetLatestSearchResult_result :: T.TypeMap+typemap_GetLatestSearchResult_result = Map.fromList [(0,("success",(T.T_STRUCT Search_Types.typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetLatestSearchResult_result :: GetLatestSearchResult_result+default_GetLatestSearchResult_result = GetLatestSearchResult_result{+ getLatestSearchResult_result_success = Search_Types.default_SearchResult,+ getLatestSearchResult_result_ex = P.Nothing}+data GetSearchResult_args = GetSearchResult_args { getSearchResult_args_searchResultId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResult_args_searchResultId record +instance QC.Arbitrary GetSearchResult_args where + arbitrary = M.liftM GetSearchResult_args (QC.arbitrary)+ shrink obj | obj == default_GetSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResult_args{getSearchResult_args_searchResultId = getSearchResult_args_searchResultId obj} then P.Nothing else P.Just $ default_GetSearchResult_args{getSearchResult_args_searchResultId = getSearchResult_args_searchResultId obj}+ ]+from_GetSearchResult_args :: GetSearchResult_args -> T.ThriftVal+from_GetSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v65 -> P.Just (1, ("searchResultId",Uuid_Types.from_UUID _v65))) $ getSearchResult_args_searchResultId record+ ]+write_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_args -> P.IO ()+write_GetSearchResult_args oprot record = T.writeVal oprot $ from_GetSearchResult_args record+encode_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_args -> LBS.ByteString+encode_GetSearchResult_args oprot record = T.serializeVal oprot $ from_GetSearchResult_args record+to_GetSearchResult_args :: T.ThriftVal -> GetSearchResult_args+to_GetSearchResult_args (T.TStruct fields) = GetSearchResult_args{+ getSearchResult_args_searchResultId = P.maybe (getSearchResult_args_searchResultId default_GetSearchResult_args) (\(_,_val67) -> (case _val67 of {T.TStruct _val68 -> (Uuid_Types.to_UUID (T.TStruct _val68)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResult_args _ = P.error "not a struct"+read_GetSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResult_args+read_GetSearchResult_args iprot = to_GetSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResult_args)+decode_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResult_args+decode_GetSearchResult_args iprot bs = to_GetSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResult_args) bs+typemap_GetSearchResult_args :: T.TypeMap+typemap_GetSearchResult_args = Map.fromList [(1,("searchResultId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_GetSearchResult_args :: GetSearchResult_args+default_GetSearchResult_args = GetSearchResult_args{+ getSearchResult_args_searchResultId = Uuid_Types.default_UUID}+data GetSearchResult_result = GetSearchResult_result { getSearchResult_result_success :: Search_Types.SearchResult+ , getSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResult_result_success record `H.hashWithSalt` getSearchResult_result_ex record +instance QC.Arbitrary GetSearchResult_result where + arbitrary = M.liftM GetSearchResult_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResult_result{getSearchResult_result_success = getSearchResult_result_success obj} then P.Nothing else P.Just $ default_GetSearchResult_result{getSearchResult_result_success = getSearchResult_result_success obj}+ , if obj == default_GetSearchResult_result{getSearchResult_result_ex = getSearchResult_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResult_result{getSearchResult_result_ex = getSearchResult_result_ex obj}+ ]+from_GetSearchResult_result :: GetSearchResult_result -> T.ThriftVal+from_GetSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v71 -> (1, ("ex",Services_Types.from_ServicesException _v71))) <$> getSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v71 -> P.Just (0, ("success",Search_Types.from_SearchResult _v71))) $ getSearchResult_result_success record+ , (\_v71 -> (1, ("ex",Services_Types.from_ServicesException _v71))) <$> getSearchResult_result_ex record+ ]+ )+write_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_result -> P.IO ()+write_GetSearchResult_result oprot record = T.writeVal oprot $ from_GetSearchResult_result record+encode_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_result -> LBS.ByteString+encode_GetSearchResult_result oprot record = T.serializeVal oprot $ from_GetSearchResult_result record+to_GetSearchResult_result :: T.ThriftVal -> GetSearchResult_result+to_GetSearchResult_result (T.TStruct fields) = GetSearchResult_result{+ getSearchResult_result_success = P.maybe (getSearchResult_result_success default_GetSearchResult_result) (\(_,_val73) -> (case _val73 of {T.TStruct _val74 -> (Search_Types.to_SearchResult (T.TStruct _val74)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val73) -> P.Just (case _val73 of {T.TStruct _val75 -> (Services_Types.to_ServicesException (T.TStruct _val75)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResult_result _ = P.error "not a struct"+read_GetSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResult_result+read_GetSearchResult_result iprot = to_GetSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResult_result)+decode_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResult_result+decode_GetSearchResult_result iprot bs = to_GetSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResult_result) bs+typemap_GetSearchResult_result :: T.TypeMap+typemap_GetSearchResult_result = Map.fromList [(0,("success",(T.T_STRUCT Search_Types.typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResult_result :: GetSearchResult_result+default_GetSearchResult_result = GetSearchResult_result{+ getSearchResult_result_success = Search_Types.default_SearchResult,+ getSearchResult_result_ex = P.Nothing}+data StartSession_args = StartSession_args { startSession_args_searchResultId :: Uuid_Types.UUID+ , startSession_args_taskType :: Services_Types.AnnotationTaskType+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartSession_args where+ hashWithSalt salt record = salt `H.hashWithSalt` startSession_args_searchResultId record `H.hashWithSalt` startSession_args_taskType record +instance QC.Arbitrary StartSession_args where + arbitrary = M.liftM StartSession_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_StartSession_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartSession_args{startSession_args_searchResultId = startSession_args_searchResultId obj} then P.Nothing else P.Just $ default_StartSession_args{startSession_args_searchResultId = startSession_args_searchResultId obj}+ , if obj == default_StartSession_args{startSession_args_taskType = startSession_args_taskType obj} then P.Nothing else P.Just $ default_StartSession_args{startSession_args_taskType = startSession_args_taskType obj}+ ]+from_StartSession_args :: StartSession_args -> T.ThriftVal+from_StartSession_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v78 -> P.Just (1, ("searchResultId",Uuid_Types.from_UUID _v78))) $ startSession_args_searchResultId record+ , (\_v78 -> P.Just (2, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v78))) $ startSession_args_taskType record+ ]+write_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> StartSession_args -> P.IO ()+write_StartSession_args oprot record = T.writeVal oprot $ from_StartSession_args record+encode_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> StartSession_args -> LBS.ByteString+encode_StartSession_args oprot record = T.serializeVal oprot $ from_StartSession_args record+to_StartSession_args :: T.ThriftVal -> StartSession_args+to_StartSession_args (T.TStruct fields) = StartSession_args{+ startSession_args_searchResultId = P.maybe (startSession_args_searchResultId default_StartSession_args) (\(_,_val80) -> (case _val80 of {T.TStruct _val81 -> (Uuid_Types.to_UUID (T.TStruct _val81)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ startSession_args_taskType = P.maybe (startSession_args_taskType default_StartSession_args) (\(_,_val80) -> (case _val80 of {T.TI32 _val82 -> P.toEnum $ P.fromIntegral _val82; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_StartSession_args _ = P.error "not a struct"+read_StartSession_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StartSession_args+read_StartSession_args iprot = to_StartSession_args <$> T.readVal iprot (T.T_STRUCT typemap_StartSession_args)+decode_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartSession_args+decode_StartSession_args iprot bs = to_StartSession_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StartSession_args) bs+typemap_StartSession_args :: T.TypeMap+typemap_StartSession_args = Map.fromList [(1,("searchResultId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("taskType",T.T_I32))]+default_StartSession_args :: StartSession_args+default_StartSession_args = StartSession_args{+ startSession_args_searchResultId = Uuid_Types.default_UUID,+ startSession_args_taskType = (P.toEnum 0)}+data StartSession_result = StartSession_result { startSession_result_success :: Uuid_Types.UUID+ , startSession_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartSession_result where+ hashWithSalt salt record = salt `H.hashWithSalt` startSession_result_success record `H.hashWithSalt` startSession_result_ex record +instance QC.Arbitrary StartSession_result where + arbitrary = M.liftM StartSession_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StartSession_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartSession_result{startSession_result_success = startSession_result_success obj} then P.Nothing else P.Just $ default_StartSession_result{startSession_result_success = startSession_result_success obj}+ , if obj == default_StartSession_result{startSession_result_ex = startSession_result_ex obj} then P.Nothing else P.Just $ default_StartSession_result{startSession_result_ex = startSession_result_ex obj}+ ]+from_StartSession_result :: StartSession_result -> T.ThriftVal+from_StartSession_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v85 -> (1, ("ex",Services_Types.from_ServicesException _v85))) <$> startSession_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v85 -> P.Just (0, ("success",Uuid_Types.from_UUID _v85))) $ startSession_result_success record+ , (\_v85 -> (1, ("ex",Services_Types.from_ServicesException _v85))) <$> startSession_result_ex record+ ]+ )+write_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> StartSession_result -> P.IO ()+write_StartSession_result oprot record = T.writeVal oprot $ from_StartSession_result record+encode_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> StartSession_result -> LBS.ByteString+encode_StartSession_result oprot record = T.serializeVal oprot $ from_StartSession_result record+to_StartSession_result :: T.ThriftVal -> StartSession_result+to_StartSession_result (T.TStruct fields) = StartSession_result{+ startSession_result_success = P.maybe (startSession_result_success default_StartSession_result) (\(_,_val87) -> (case _val87 of {T.TStruct _val88 -> (Uuid_Types.to_UUID (T.TStruct _val88)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ startSession_result_ex = P.maybe (P.Nothing) (\(_,_val87) -> P.Just (case _val87 of {T.TStruct _val89 -> (Services_Types.to_ServicesException (T.TStruct _val89)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartSession_result _ = P.error "not a struct"+read_StartSession_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StartSession_result+read_StartSession_result iprot = to_StartSession_result <$> T.readVal iprot (T.T_STRUCT typemap_StartSession_result)+decode_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartSession_result+decode_StartSession_result iprot bs = to_StartSession_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StartSession_result) bs+typemap_StartSession_result :: T.TypeMap+typemap_StartSession_result = Map.fromList [(0,("success",(T.T_STRUCT Uuid_Types.typemap_UUID))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StartSession_result :: StartSession_result+default_StartSession_result = StartSession_result{+ startSession_result_success = Uuid_Types.default_UUID,+ startSession_result_ex = P.Nothing}+data StopSession_args = StopSession_args { stopSession_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StopSession_args where+ hashWithSalt salt record = salt `H.hashWithSalt` stopSession_args_sessionId record +instance QC.Arbitrary StopSession_args where + arbitrary = M.liftM StopSession_args (QC.arbitrary)+ shrink obj | obj == default_StopSession_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StopSession_args{stopSession_args_sessionId = stopSession_args_sessionId obj} then P.Nothing else P.Just $ default_StopSession_args{stopSession_args_sessionId = stopSession_args_sessionId obj}+ ]+from_StopSession_args :: StopSession_args -> T.ThriftVal+from_StopSession_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v92 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v92))) $ stopSession_args_sessionId record+ ]+write_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> StopSession_args -> P.IO ()+write_StopSession_args oprot record = T.writeVal oprot $ from_StopSession_args record+encode_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> StopSession_args -> LBS.ByteString+encode_StopSession_args oprot record = T.serializeVal oprot $ from_StopSession_args record+to_StopSession_args :: T.ThriftVal -> StopSession_args+to_StopSession_args (T.TStruct fields) = StopSession_args{+ stopSession_args_sessionId = P.maybe (stopSession_args_sessionId default_StopSession_args) (\(_,_val94) -> (case _val94 of {T.TStruct _val95 -> (Uuid_Types.to_UUID (T.TStruct _val95)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StopSession_args _ = P.error "not a struct"+read_StopSession_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StopSession_args+read_StopSession_args iprot = to_StopSession_args <$> T.readVal iprot (T.T_STRUCT typemap_StopSession_args)+decode_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StopSession_args+decode_StopSession_args iprot bs = to_StopSession_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StopSession_args) bs+typemap_StopSession_args :: T.TypeMap+typemap_StopSession_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_StopSession_args :: StopSession_args+default_StopSession_args = StopSession_args{+ stopSession_args_sessionId = Uuid_Types.default_UUID}+data StopSession_result = StopSession_result { stopSession_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StopSession_result where+ hashWithSalt salt record = salt `H.hashWithSalt` stopSession_result_ex record +instance QC.Arbitrary StopSession_result where + arbitrary = M.liftM StopSession_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StopSession_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StopSession_result{stopSession_result_ex = stopSession_result_ex obj} then P.Nothing else P.Just $ default_StopSession_result{stopSession_result_ex = stopSession_result_ex obj}+ ]+from_StopSession_result :: StopSession_result -> T.ThriftVal+from_StopSession_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> stopSession_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> stopSession_result_ex record+ ]+ )+write_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> StopSession_result -> P.IO ()+write_StopSession_result oprot record = T.writeVal oprot $ from_StopSession_result record+encode_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> StopSession_result -> LBS.ByteString+encode_StopSession_result oprot record = T.serializeVal oprot $ from_StopSession_result record+to_StopSession_result :: T.ThriftVal -> StopSession_result+to_StopSession_result (T.TStruct fields) = StopSession_result{+ stopSession_result_ex = P.maybe (P.Nothing) (\(_,_val100) -> P.Just (case _val100 of {T.TStruct _val101 -> (Services_Types.to_ServicesException (T.TStruct _val101)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StopSession_result _ = P.error "not a struct"+read_StopSession_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StopSession_result+read_StopSession_result iprot = to_StopSession_result <$> T.readVal iprot (T.T_STRUCT typemap_StopSession_result)+decode_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StopSession_result+decode_StopSession_result iprot bs = to_StopSession_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StopSession_result) bs+typemap_StopSession_result :: T.TypeMap+typemap_StopSession_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StopSession_result :: StopSession_result+default_StopSession_result = StopSession_result{+ stopSession_result_ex = P.Nothing}+data GetNextChunk_args = GetNextChunk_args { getNextChunk_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetNextChunk_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getNextChunk_args_sessionId record +instance QC.Arbitrary GetNextChunk_args where + arbitrary = M.liftM GetNextChunk_args (QC.arbitrary)+ shrink obj | obj == default_GetNextChunk_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetNextChunk_args{getNextChunk_args_sessionId = getNextChunk_args_sessionId obj} then P.Nothing else P.Just $ default_GetNextChunk_args{getNextChunk_args_sessionId = getNextChunk_args_sessionId obj}+ ]+from_GetNextChunk_args :: GetNextChunk_args -> T.ThriftVal+from_GetNextChunk_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v104 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v104))) $ getNextChunk_args_sessionId record+ ]+write_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_args -> P.IO ()+write_GetNextChunk_args oprot record = T.writeVal oprot $ from_GetNextChunk_args record+encode_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_args -> LBS.ByteString+encode_GetNextChunk_args oprot record = T.serializeVal oprot $ from_GetNextChunk_args record+to_GetNextChunk_args :: T.ThriftVal -> GetNextChunk_args+to_GetNextChunk_args (T.TStruct fields) = GetNextChunk_args{+ getNextChunk_args_sessionId = P.maybe (getNextChunk_args_sessionId default_GetNextChunk_args) (\(_,_val106) -> (case _val106 of {T.TStruct _val107 -> (Uuid_Types.to_UUID (T.TStruct _val107)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetNextChunk_args _ = P.error "not a struct"+read_GetNextChunk_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetNextChunk_args+read_GetNextChunk_args iprot = to_GetNextChunk_args <$> T.readVal iprot (T.T_STRUCT typemap_GetNextChunk_args)+decode_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetNextChunk_args+decode_GetNextChunk_args iprot bs = to_GetNextChunk_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetNextChunk_args) bs+typemap_GetNextChunk_args :: T.TypeMap+typemap_GetNextChunk_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_GetNextChunk_args :: GetNextChunk_args+default_GetNextChunk_args = GetNextChunk_args{+ getNextChunk_args_sessionId = Uuid_Types.default_UUID}+data GetNextChunk_result = GetNextChunk_result { getNextChunk_result_success :: (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ , getNextChunk_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetNextChunk_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getNextChunk_result_success record `H.hashWithSalt` getNextChunk_result_ex record +instance QC.Arbitrary GetNextChunk_result where + arbitrary = M.liftM GetNextChunk_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetNextChunk_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetNextChunk_result{getNextChunk_result_success = getNextChunk_result_success obj} then P.Nothing else P.Just $ default_GetNextChunk_result{getNextChunk_result_success = getNextChunk_result_success obj}+ , if obj == default_GetNextChunk_result{getNextChunk_result_ex = getNextChunk_result_ex obj} then P.Nothing else P.Just $ default_GetNextChunk_result{getNextChunk_result_ex = getNextChunk_result_ex obj}+ ]+from_GetNextChunk_result :: GetNextChunk_result -> T.ThriftVal+from_GetNextChunk_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v110 -> (1, ("ex",Services_Types.from_ServicesException _v110))) <$> getNextChunk_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v110 -> P.Just (0, ("success",T.TList (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier) $ P.map (\_v112 -> Services_Types.from_AnnotationUnitIdentifier _v112) $ Vector.toList _v110))) $ getNextChunk_result_success record+ , (\_v110 -> (1, ("ex",Services_Types.from_ServicesException _v110))) <$> getNextChunk_result_ex record+ ]+ )+write_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_result -> P.IO ()+write_GetNextChunk_result oprot record = T.writeVal oprot $ from_GetNextChunk_result record+encode_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_result -> LBS.ByteString+encode_GetNextChunk_result oprot record = T.serializeVal oprot $ from_GetNextChunk_result record+to_GetNextChunk_result :: T.ThriftVal -> GetNextChunk_result+to_GetNextChunk_result (T.TStruct fields) = GetNextChunk_result{+ getNextChunk_result_success = P.maybe (getNextChunk_result_success default_GetNextChunk_result) (\(_,_val114) -> (case _val114 of {T.TList _ _val115 -> (Vector.fromList $ P.map (\_v116 -> (case _v116 of {T.TStruct _val117 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val117)); _ -> P.error "wrong type"})) _val115); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getNextChunk_result_ex = P.maybe (P.Nothing) (\(_,_val114) -> P.Just (case _val114 of {T.TStruct _val118 -> (Services_Types.to_ServicesException (T.TStruct _val118)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetNextChunk_result _ = P.error "not a struct"+read_GetNextChunk_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetNextChunk_result+read_GetNextChunk_result iprot = to_GetNextChunk_result <$> T.readVal iprot (T.T_STRUCT typemap_GetNextChunk_result)+decode_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetNextChunk_result+decode_GetNextChunk_result iprot bs = to_GetNextChunk_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetNextChunk_result) bs+typemap_GetNextChunk_result :: T.TypeMap+typemap_GetNextChunk_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetNextChunk_result :: GetNextChunk_result+default_GetNextChunk_result = GetNextChunk_result{+ getNextChunk_result_success = Vector.empty,+ getNextChunk_result_ex = P.Nothing}+data SubmitAnnotation_args = SubmitAnnotation_args { submitAnnotation_args_sessionId :: Uuid_Types.UUID+ , submitAnnotation_args_unitId :: Services_Types.AnnotationUnitIdentifier+ , submitAnnotation_args_communication :: Communication_Types.Communication+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitAnnotation_args where+ hashWithSalt salt record = salt `H.hashWithSalt` submitAnnotation_args_sessionId record `H.hashWithSalt` submitAnnotation_args_unitId record `H.hashWithSalt` submitAnnotation_args_communication record +instance QC.Arbitrary SubmitAnnotation_args where + arbitrary = M.liftM SubmitAnnotation_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SubmitAnnotation_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitAnnotation_args{submitAnnotation_args_sessionId = submitAnnotation_args_sessionId obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_sessionId = submitAnnotation_args_sessionId obj}+ , if obj == default_SubmitAnnotation_args{submitAnnotation_args_unitId = submitAnnotation_args_unitId obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_unitId = submitAnnotation_args_unitId obj}+ , if obj == default_SubmitAnnotation_args{submitAnnotation_args_communication = submitAnnotation_args_communication obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_communication = submitAnnotation_args_communication obj}+ ]+from_SubmitAnnotation_args :: SubmitAnnotation_args -> T.ThriftVal+from_SubmitAnnotation_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v121 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v121))) $ submitAnnotation_args_sessionId record+ , (\_v121 -> P.Just (2, ("unitId",Services_Types.from_AnnotationUnitIdentifier _v121))) $ submitAnnotation_args_unitId record+ , (\_v121 -> P.Just (3, ("communication",Communication_Types.from_Communication _v121))) $ submitAnnotation_args_communication record+ ]+write_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_args -> P.IO ()+write_SubmitAnnotation_args oprot record = T.writeVal oprot $ from_SubmitAnnotation_args record+encode_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_args -> LBS.ByteString+encode_SubmitAnnotation_args oprot record = T.serializeVal oprot $ from_SubmitAnnotation_args record+to_SubmitAnnotation_args :: T.ThriftVal -> SubmitAnnotation_args+to_SubmitAnnotation_args (T.TStruct fields) = SubmitAnnotation_args{+ submitAnnotation_args_sessionId = P.maybe (submitAnnotation_args_sessionId default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val124 -> (Uuid_Types.to_UUID (T.TStruct _val124)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ submitAnnotation_args_unitId = P.maybe (submitAnnotation_args_unitId default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val125 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val125)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ submitAnnotation_args_communication = P.maybe (submitAnnotation_args_communication default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val126 -> (Communication_Types.to_Communication (T.TStruct _val126)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_SubmitAnnotation_args _ = P.error "not a struct"+read_SubmitAnnotation_args :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitAnnotation_args+read_SubmitAnnotation_args iprot = to_SubmitAnnotation_args <$> T.readVal iprot (T.T_STRUCT typemap_SubmitAnnotation_args)+decode_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitAnnotation_args+decode_SubmitAnnotation_args iprot bs = to_SubmitAnnotation_args $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitAnnotation_args) bs+typemap_SubmitAnnotation_args :: T.TypeMap+typemap_SubmitAnnotation_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("unitId",(T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier))),(3,("communication",(T.T_STRUCT Communication_Types.typemap_Communication)))]+default_SubmitAnnotation_args :: SubmitAnnotation_args+default_SubmitAnnotation_args = SubmitAnnotation_args{+ submitAnnotation_args_sessionId = Uuid_Types.default_UUID,+ submitAnnotation_args_unitId = Services_Types.default_AnnotationUnitIdentifier,+ submitAnnotation_args_communication = Communication_Types.default_Communication}+data SubmitAnnotation_result = SubmitAnnotation_result { submitAnnotation_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitAnnotation_result where+ hashWithSalt salt record = salt `H.hashWithSalt` submitAnnotation_result_ex record +instance QC.Arbitrary SubmitAnnotation_result where + arbitrary = M.liftM SubmitAnnotation_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_SubmitAnnotation_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitAnnotation_result{submitAnnotation_result_ex = submitAnnotation_result_ex obj} then P.Nothing else P.Just $ default_SubmitAnnotation_result{submitAnnotation_result_ex = submitAnnotation_result_ex obj}+ ]+from_SubmitAnnotation_result :: SubmitAnnotation_result -> T.ThriftVal+from_SubmitAnnotation_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v129 -> (1, ("ex",Services_Types.from_ServicesException _v129))) <$> submitAnnotation_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v129 -> (1, ("ex",Services_Types.from_ServicesException _v129))) <$> submitAnnotation_result_ex record+ ]+ )+write_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_result -> P.IO ()+write_SubmitAnnotation_result oprot record = T.writeVal oprot $ from_SubmitAnnotation_result record+encode_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_result -> LBS.ByteString+encode_SubmitAnnotation_result oprot record = T.serializeVal oprot $ from_SubmitAnnotation_result record+to_SubmitAnnotation_result :: T.ThriftVal -> SubmitAnnotation_result+to_SubmitAnnotation_result (T.TStruct fields) = SubmitAnnotation_result{+ submitAnnotation_result_ex = P.maybe (P.Nothing) (\(_,_val131) -> P.Just (case _val131 of {T.TStruct _val132 -> (Services_Types.to_ServicesException (T.TStruct _val132)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_SubmitAnnotation_result _ = P.error "not a struct"+read_SubmitAnnotation_result :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitAnnotation_result+read_SubmitAnnotation_result iprot = to_SubmitAnnotation_result <$> T.readVal iprot (T.T_STRUCT typemap_SubmitAnnotation_result)+decode_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitAnnotation_result+decode_SubmitAnnotation_result iprot bs = to_SubmitAnnotation_result $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitAnnotation_result) bs+typemap_SubmitAnnotation_result :: T.TypeMap+typemap_SubmitAnnotation_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_SubmitAnnotation_result :: SubmitAnnotation_result+default_SubmitAnnotation_result = SubmitAnnotation_result{+ submitAnnotation_result_ex = P.Nothing}+process_registerSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_RegisterSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ Iface.registerSearchResult handler (registerSearchResult_args_result args) (registerSearchResult_args_taskType args)+ let res = default_RegisterSearchResult_result+ T.writeMessageBegin oprot ("registerSearchResult", T.M_REPLY, seqid)+ write_RegisterSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_RegisterSearchResult_result{registerSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("registerSearchResult", T.M_REPLY, seqid)+ write_RegisterSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("registerSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResults (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResults_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResults handler (getSearchResults_args_taskType args) (getSearchResults_args_limit args)+ let res = default_GetSearchResults_result{getSearchResults_result_success = val}+ T.writeMessageBegin oprot ("getSearchResults", T.M_REPLY, seqid)+ write_GetSearchResults_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResults_result{getSearchResults_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResults", T.M_REPLY, seqid)+ write_GetSearchResults_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResults", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResultsByUser (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResultsByUser_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResultsByUser handler (getSearchResultsByUser_args_taskType args) (getSearchResultsByUser_args_userId args) (getSearchResultsByUser_args_limit args)+ let res = default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = val}+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_REPLY, seqid)+ write_GetSearchResultsByUser_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_REPLY, seqid)+ write_GetSearchResultsByUser_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getLatestSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_GetLatestSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getLatestSearchResult handler (getLatestSearchResult_args_userId args)+ let res = default_GetLatestSearchResult_result{getLatestSearchResult_result_success = val}+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_REPLY, seqid)+ write_GetLatestSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_REPLY, seqid)+ write_GetLatestSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResult handler (getSearchResult_args_searchResultId args)+ let res = default_GetSearchResult_result{getSearchResult_result_success = val}+ T.writeMessageBegin oprot ("getSearchResult", T.M_REPLY, seqid)+ write_GetSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResult_result{getSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResult", T.M_REPLY, seqid)+ write_GetSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_startSession (seqid, iprot, oprot, handler) = do+ args <- read_StartSession_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.startSession handler (startSession_args_searchResultId args) (startSession_args_taskType args)+ let res = default_StartSession_result{startSession_result_success = val}+ T.writeMessageBegin oprot ("startSession", T.M_REPLY, seqid)+ write_StartSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StartSession_result{startSession_result_ex = P.Just e}+ T.writeMessageBegin oprot ("startSession", T.M_REPLY, seqid)+ write_StartSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("startSession", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_stopSession (seqid, iprot, oprot, handler) = do+ args <- read_StopSession_args iprot+ (X.catch+ (X.catch+ (do+ Iface.stopSession handler (stopSession_args_sessionId args)+ let res = default_StopSession_result+ T.writeMessageBegin oprot ("stopSession", T.M_REPLY, seqid)+ write_StopSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StopSession_result{stopSession_result_ex = P.Just e}+ T.writeMessageBegin oprot ("stopSession", T.M_REPLY, seqid)+ write_StopSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("stopSession", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getNextChunk (seqid, iprot, oprot, handler) = do+ args <- read_GetNextChunk_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getNextChunk handler (getNextChunk_args_sessionId args)+ let res = default_GetNextChunk_result{getNextChunk_result_success = val}+ T.writeMessageBegin oprot ("getNextChunk", T.M_REPLY, seqid)+ write_GetNextChunk_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetNextChunk_result{getNextChunk_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getNextChunk", T.M_REPLY, seqid)+ write_GetNextChunk_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getNextChunk", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_submitAnnotation (seqid, iprot, oprot, handler) = do+ args <- read_SubmitAnnotation_args iprot+ (X.catch+ (X.catch+ (do+ Iface.submitAnnotation handler (submitAnnotation_args_sessionId args) (submitAnnotation_args_unitId args) (submitAnnotation_args_communication args)+ let res = default_SubmitAnnotation_result+ T.writeMessageBegin oprot ("submitAnnotation", T.M_REPLY, seqid)+ write_SubmitAnnotation_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_SubmitAnnotation_result{submitAnnotation_result_ex = P.Just e}+ T.writeMessageBegin oprot ("submitAnnotation", T.M_REPLY, seqid)+ write_SubmitAnnotation_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("submitAnnotation", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "registerSearchResult" -> process_registerSearchResult (seqid,iprot,oprot,handler)+ "getSearchResults" -> process_getSearchResults (seqid,iprot,oprot,handler)+ "getSearchResultsByUser" -> process_getSearchResultsByUser (seqid,iprot,oprot,handler)+ "getLatestSearchResult" -> process_getLatestSearchResult (seqid,iprot,oprot,handler)+ "getSearchResult" -> process_getSearchResult (seqid,iprot,oprot,handler)+ "startSession" -> process_startSession (seqid,iprot,oprot,handler)+ "stopSession" -> process_stopSession (seqid,iprot,oprot,handler)+ "getNextChunk" -> process_getNextChunk (seqid,iprot,oprot,handler)+ "submitAnnotation" -> process_submitAnnotation (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/ResultsServerService_Client.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ResultsServerService_Client(registerSearchResult,getSearchResults,getSearchResultsByUser,getLatestSearchResult,getSearchResult,startSession,stopSession,getNextChunk,submitAnnotation) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import Results_Types+import ResultsServerService+seqid = R.newIORef 0+registerSearchResult (ip,op) arg_result arg_taskType = do+ send_registerSearchResult op arg_result arg_taskType+ recv_registerSearchResult ip+send_registerSearchResult op arg_result arg_taskType = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("registerSearchResult", T.M_CALL, seqn)+ write_RegisterSearchResult_args op (RegisterSearchResult_args{registerSearchResult_args_result=arg_result,registerSearchResult_args_taskType=arg_taskType})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_registerSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_RegisterSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (registerSearchResult_result_ex res)+ P.return ()+getSearchResults (ip,op) arg_taskType arg_limit = do+ send_getSearchResults op arg_taskType arg_limit+ recv_getSearchResults ip+send_getSearchResults op arg_taskType arg_limit = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResults", T.M_CALL, seqn)+ write_GetSearchResults_args op (GetSearchResults_args{getSearchResults_args_taskType=arg_taskType,getSearchResults_args_limit=arg_limit})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResults ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResults_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResults_result_ex res)+ P.return $ getSearchResults_result_success res+getSearchResultsByUser (ip,op) arg_taskType arg_userId arg_limit = do+ send_getSearchResultsByUser op arg_taskType arg_userId arg_limit+ recv_getSearchResultsByUser ip+send_getSearchResultsByUser op arg_taskType arg_userId arg_limit = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResultsByUser", T.M_CALL, seqn)+ write_GetSearchResultsByUser_args op (GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType=arg_taskType,getSearchResultsByUser_args_userId=arg_userId,getSearchResultsByUser_args_limit=arg_limit})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResultsByUser ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResultsByUser_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResultsByUser_result_ex res)+ P.return $ getSearchResultsByUser_result_success res+getLatestSearchResult (ip,op) arg_userId = do+ send_getLatestSearchResult op arg_userId+ recv_getLatestSearchResult ip+send_getLatestSearchResult op arg_userId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getLatestSearchResult", T.M_CALL, seqn)+ write_GetLatestSearchResult_args op (GetLatestSearchResult_args{getLatestSearchResult_args_userId=arg_userId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getLatestSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetLatestSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getLatestSearchResult_result_ex res)+ P.return $ getLatestSearchResult_result_success res+getSearchResult (ip,op) arg_searchResultId = do+ send_getSearchResult op arg_searchResultId+ recv_getSearchResult ip+send_getSearchResult op arg_searchResultId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResult", T.M_CALL, seqn)+ write_GetSearchResult_args op (GetSearchResult_args{getSearchResult_args_searchResultId=arg_searchResultId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResult_result_ex res)+ P.return $ getSearchResult_result_success res+startSession (ip,op) arg_searchResultId arg_taskType = do+ send_startSession op arg_searchResultId arg_taskType+ recv_startSession ip+send_startSession op arg_searchResultId arg_taskType = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("startSession", T.M_CALL, seqn)+ write_StartSession_args op (StartSession_args{startSession_args_searchResultId=arg_searchResultId,startSession_args_taskType=arg_taskType})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_startSession ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StartSession_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (startSession_result_ex res)+ P.return $ startSession_result_success res+stopSession (ip,op) arg_sessionId = do+ send_stopSession op arg_sessionId+ recv_stopSession ip+send_stopSession op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("stopSession", T.M_CALL, seqn)+ write_StopSession_args op (StopSession_args{stopSession_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_stopSession ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StopSession_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (stopSession_result_ex res)+ P.return ()+getNextChunk (ip,op) arg_sessionId = do+ send_getNextChunk op arg_sessionId+ recv_getNextChunk ip+send_getNextChunk op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getNextChunk", T.M_CALL, seqn)+ write_GetNextChunk_args op (GetNextChunk_args{getNextChunk_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getNextChunk ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetNextChunk_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getNextChunk_result_ex res)+ P.return $ getNextChunk_result_success res+submitAnnotation (ip,op) arg_sessionId arg_unitId arg_communication = do+ send_submitAnnotation op arg_sessionId arg_unitId arg_communication+ recv_submitAnnotation ip+send_submitAnnotation op arg_sessionId arg_unitId arg_communication = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("submitAnnotation", T.M_CALL, seqn)+ write_SubmitAnnotation_args op (SubmitAnnotation_args{submitAnnotation_args_sessionId=arg_sessionId,submitAnnotation_args_unitId=arg_unitId,submitAnnotation_args_communication=arg_communication})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_submitAnnotation ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_SubmitAnnotation_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (submitAnnotation_result_ex res)+ P.return ()
+ src/Data/Concrete/Services/ResultsServerService_Iface.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.ResultsServerService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import Results_Types++import Service_Iface+class Service_Iface a => ResultsServerService_Iface a where+ registerSearchResult :: a -> Search_Types.SearchResult -> Services_Types.AnnotationTaskType -> P.IO ()+ getSearchResults :: a -> Services_Types.AnnotationTaskType -> I.Int32 -> P.IO (Vector.Vector Search_Types.SearchResult)+ getSearchResultsByUser :: a -> Services_Types.AnnotationTaskType -> LT.Text -> I.Int32 -> P.IO (Vector.Vector Search_Types.SearchResult)+ getLatestSearchResult :: a -> LT.Text -> P.IO Search_Types.SearchResult+ getSearchResult :: a -> Uuid_Types.UUID -> P.IO Search_Types.SearchResult+ startSession :: a -> Uuid_Types.UUID -> Services_Types.AnnotationTaskType -> P.IO Uuid_Types.UUID+ stopSession :: a -> Uuid_Types.UUID -> P.IO ()+ getNextChunk :: a -> Uuid_Types.UUID -> P.IO (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ submitAnnotation :: a -> Uuid_Types.UUID -> Services_Types.AnnotationUnitIdentifier -> Communication_Types.Communication -> P.IO ()
+ src/Data/Concrete/Services/SearchProxyService.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchProxyService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import qualified Service+import Search_Types+import qualified SearchProxyService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Search_args = Search_args { search_args_query :: SearchQuery+ , search_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_args where+ hashWithSalt salt record = salt `H.hashWithSalt` search_args_query record `H.hashWithSalt` search_args_provider record +instance QC.Arbitrary Search_args where + arbitrary = M.liftM Search_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Search_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_args{search_args_query = search_args_query obj} then P.Nothing else P.Just $ default_Search_args{search_args_query = search_args_query obj}+ , if obj == default_Search_args{search_args_provider = search_args_provider obj} then P.Nothing else P.Just $ default_Search_args{search_args_provider = search_args_provider obj}+ ]+from_Search_args :: Search_args -> T.ThriftVal+from_Search_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v109 -> P.Just (1, ("query",from_SearchQuery _v109))) $ search_args_query record+ , (\_v109 -> P.Just (2, ("provider",T.TString $ E.encodeUtf8 _v109))) $ search_args_provider record+ ]+write_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> P.IO ()+write_Search_args oprot record = T.writeVal oprot $ from_Search_args record+encode_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> LBS.ByteString+encode_Search_args oprot record = T.serializeVal oprot $ from_Search_args record+to_Search_args :: T.ThriftVal -> Search_args+to_Search_args (T.TStruct fields) = Search_args{+ search_args_query = P.maybe (search_args_query default_Search_args) (\(_,_val111) -> (case _val111 of {T.TStruct _val112 -> (to_SearchQuery (T.TStruct _val112)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ search_args_provider = P.maybe (search_args_provider default_Search_args) (\(_,_val111) -> (case _val111 of {T.TString _val113 -> E.decodeUtf8 _val113; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Search_args _ = P.error "not a struct"+read_Search_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_args+read_Search_args iprot = to_Search_args <$> T.readVal iprot (T.T_STRUCT typemap_Search_args)+decode_Search_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_args+decode_Search_args iprot bs = to_Search_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_args) bs+typemap_Search_args :: T.TypeMap+typemap_Search_args = Map.fromList [(1,("query",(T.T_STRUCT typemap_SearchQuery))),(2,("provider",T.T_STRING))]+default_Search_args :: Search_args+default_Search_args = Search_args{+ search_args_query = default_SearchQuery,+ search_args_provider = ""}+data Search_result = Search_result { search_result_success :: SearchResult+ , search_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_result where+ hashWithSalt salt record = salt `H.hashWithSalt` search_result_success record `H.hashWithSalt` search_result_ex record +instance QC.Arbitrary Search_result where + arbitrary = M.liftM Search_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Search_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_result{search_result_success = search_result_success obj} then P.Nothing else P.Just $ default_Search_result{search_result_success = search_result_success obj}+ , if obj == default_Search_result{search_result_ex = search_result_ex obj} then P.Nothing else P.Just $ default_Search_result{search_result_ex = search_result_ex obj}+ ]+from_Search_result :: Search_result -> T.ThriftVal+from_Search_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v116 -> (1, ("ex",Services_Types.from_ServicesException _v116))) <$> search_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v116 -> P.Just (0, ("success",from_SearchResult _v116))) $ search_result_success record+ , (\_v116 -> (1, ("ex",Services_Types.from_ServicesException _v116))) <$> search_result_ex record+ ]+ )+write_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> P.IO ()+write_Search_result oprot record = T.writeVal oprot $ from_Search_result record+encode_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> LBS.ByteString+encode_Search_result oprot record = T.serializeVal oprot $ from_Search_result record+to_Search_result :: T.ThriftVal -> Search_result+to_Search_result (T.TStruct fields) = Search_result{+ search_result_success = P.maybe (search_result_success default_Search_result) (\(_,_val118) -> (case _val118 of {T.TStruct _val119 -> (to_SearchResult (T.TStruct _val119)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ search_result_ex = P.maybe (P.Nothing) (\(_,_val118) -> P.Just (case _val118 of {T.TStruct _val120 -> (Services_Types.to_ServicesException (T.TStruct _val120)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Search_result _ = P.error "not a struct"+read_Search_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_result+read_Search_result iprot = to_Search_result <$> T.readVal iprot (T.T_STRUCT typemap_Search_result)+decode_Search_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_result+decode_Search_result iprot bs = to_Search_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_result) bs+typemap_Search_result :: T.TypeMap+typemap_Search_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Search_result :: Search_result+default_Search_result = Search_result{+ search_result_success = default_SearchResult,+ search_result_ex = P.Nothing}+data GetProviders_args = GetProviders_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetProviders_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetProviders_args where + arbitrary = QC.elements [GetProviders_args]+from_GetProviders_args :: GetProviders_args -> T.ThriftVal+from_GetProviders_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> GetProviders_args -> P.IO ()+write_GetProviders_args oprot record = T.writeVal oprot $ from_GetProviders_args record+encode_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> GetProviders_args -> LBS.ByteString+encode_GetProviders_args oprot record = T.serializeVal oprot $ from_GetProviders_args record+to_GetProviders_args :: T.ThriftVal -> GetProviders_args+to_GetProviders_args (T.TStruct fields) = GetProviders_args{++ }+to_GetProviders_args _ = P.error "not a struct"+read_GetProviders_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetProviders_args+read_GetProviders_args iprot = to_GetProviders_args <$> T.readVal iprot (T.T_STRUCT typemap_GetProviders_args)+decode_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetProviders_args+decode_GetProviders_args iprot bs = to_GetProviders_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetProviders_args) bs+typemap_GetProviders_args :: T.TypeMap+typemap_GetProviders_args = Map.fromList []+default_GetProviders_args :: GetProviders_args+default_GetProviders_args = GetProviders_args{+}+data GetProviders_result = GetProviders_result { getProviders_result_success :: (Vector.Vector LT.Text)+ , getProviders_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetProviders_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getProviders_result_success record `H.hashWithSalt` getProviders_result_ex record +instance QC.Arbitrary GetProviders_result where + arbitrary = M.liftM GetProviders_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetProviders_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetProviders_result{getProviders_result_success = getProviders_result_success obj} then P.Nothing else P.Just $ default_GetProviders_result{getProviders_result_success = getProviders_result_success obj}+ , if obj == default_GetProviders_result{getProviders_result_ex = getProviders_result_ex obj} then P.Nothing else P.Just $ default_GetProviders_result{getProviders_result_ex = getProviders_result_ex obj}+ ]+from_GetProviders_result :: GetProviders_result -> T.ThriftVal+from_GetProviders_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v128 -> (1, ("ex",Services_Types.from_ServicesException _v128))) <$> getProviders_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v128 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v130 -> T.TString $ E.encodeUtf8 _v130) $ Vector.toList _v128))) $ getProviders_result_success record+ , (\_v128 -> (1, ("ex",Services_Types.from_ServicesException _v128))) <$> getProviders_result_ex record+ ]+ )+write_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> GetProviders_result -> P.IO ()+write_GetProviders_result oprot record = T.writeVal oprot $ from_GetProviders_result record+encode_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> GetProviders_result -> LBS.ByteString+encode_GetProviders_result oprot record = T.serializeVal oprot $ from_GetProviders_result record+to_GetProviders_result :: T.ThriftVal -> GetProviders_result+to_GetProviders_result (T.TStruct fields) = GetProviders_result{+ getProviders_result_success = P.maybe (getProviders_result_success default_GetProviders_result) (\(_,_val132) -> (case _val132 of {T.TList _ _val133 -> (Vector.fromList $ P.map (\_v134 -> (case _v134 of {T.TString _val135 -> E.decodeUtf8 _val135; _ -> P.error "wrong type"})) _val133); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getProviders_result_ex = P.maybe (P.Nothing) (\(_,_val132) -> P.Just (case _val132 of {T.TStruct _val136 -> (Services_Types.to_ServicesException (T.TStruct _val136)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetProviders_result _ = P.error "not a struct"+read_GetProviders_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetProviders_result+read_GetProviders_result iprot = to_GetProviders_result <$> T.readVal iprot (T.T_STRUCT typemap_GetProviders_result)+decode_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetProviders_result+decode_GetProviders_result iprot bs = to_GetProviders_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetProviders_result) bs+typemap_GetProviders_result :: T.TypeMap+typemap_GetProviders_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetProviders_result :: GetProviders_result+default_GetProviders_result = GetProviders_result{+ getProviders_result_success = Vector.empty,+ getProviders_result_ex = P.Nothing}+data GetCapabilities_args = GetCapabilities_args { getCapabilities_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_args_provider record +instance QC.Arbitrary GetCapabilities_args where + arbitrary = M.liftM GetCapabilities_args (QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_args{getCapabilities_args_provider = getCapabilities_args_provider obj} then P.Nothing else P.Just $ default_GetCapabilities_args{getCapabilities_args_provider = getCapabilities_args_provider obj}+ ]+from_GetCapabilities_args :: GetCapabilities_args -> T.ThriftVal+from_GetCapabilities_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v139 -> P.Just (1, ("provider",T.TString $ E.encodeUtf8 _v139))) $ getCapabilities_args_provider record+ ]+write_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> P.IO ()+write_GetCapabilities_args oprot record = T.writeVal oprot $ from_GetCapabilities_args record+encode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> LBS.ByteString+encode_GetCapabilities_args oprot record = T.serializeVal oprot $ from_GetCapabilities_args record+to_GetCapabilities_args :: T.ThriftVal -> GetCapabilities_args+to_GetCapabilities_args (T.TStruct fields) = GetCapabilities_args{+ getCapabilities_args_provider = P.maybe (getCapabilities_args_provider default_GetCapabilities_args) (\(_,_val141) -> (case _val141 of {T.TString _val142 -> E.decodeUtf8 _val142; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_args _ = P.error "not a struct"+read_GetCapabilities_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_args+read_GetCapabilities_args iprot = to_GetCapabilities_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_args)+decode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_args+decode_GetCapabilities_args iprot bs = to_GetCapabilities_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_args) bs+typemap_GetCapabilities_args :: T.TypeMap+typemap_GetCapabilities_args = Map.fromList [(1,("provider",T.T_STRING))]+default_GetCapabilities_args :: GetCapabilities_args+default_GetCapabilities_args = GetCapabilities_args{+ getCapabilities_args_provider = ""}+data GetCapabilities_result = GetCapabilities_result { getCapabilities_result_success :: (Vector.Vector SearchCapability)+ , getCapabilities_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_result_success record `H.hashWithSalt` getCapabilities_result_ex record +instance QC.Arbitrary GetCapabilities_result where + arbitrary = M.liftM GetCapabilities_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj}+ , if obj == default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj}+ ]+from_GetCapabilities_result :: GetCapabilities_result -> T.ThriftVal+from_GetCapabilities_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v145 -> (1, ("ex",Services_Types.from_ServicesException _v145))) <$> getCapabilities_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v145 -> P.Just (0, ("success",T.TList (T.T_STRUCT typemap_SearchCapability) $ P.map (\_v147 -> from_SearchCapability _v147) $ Vector.toList _v145))) $ getCapabilities_result_success record+ , (\_v145 -> (1, ("ex",Services_Types.from_ServicesException _v145))) <$> getCapabilities_result_ex record+ ]+ )+write_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> P.IO ()+write_GetCapabilities_result oprot record = T.writeVal oprot $ from_GetCapabilities_result record+encode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> LBS.ByteString+encode_GetCapabilities_result oprot record = T.serializeVal oprot $ from_GetCapabilities_result record+to_GetCapabilities_result :: T.ThriftVal -> GetCapabilities_result+to_GetCapabilities_result (T.TStruct fields) = GetCapabilities_result{+ getCapabilities_result_success = P.maybe (getCapabilities_result_success default_GetCapabilities_result) (\(_,_val149) -> (case _val149 of {T.TList _ _val150 -> (Vector.fromList $ P.map (\_v151 -> (case _v151 of {T.TStruct _val152 -> (to_SearchCapability (T.TStruct _val152)); _ -> P.error "wrong type"})) _val150); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCapabilities_result_ex = P.maybe (P.Nothing) (\(_,_val149) -> P.Just (case _val149 of {T.TStruct _val153 -> (Services_Types.to_ServicesException (T.TStruct _val153)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_result _ = P.error "not a struct"+read_GetCapabilities_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_result+read_GetCapabilities_result iprot = to_GetCapabilities_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_result)+decode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_result+decode_GetCapabilities_result iprot bs = to_GetCapabilities_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_result) bs+typemap_GetCapabilities_result :: T.TypeMap+typemap_GetCapabilities_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT typemap_SearchCapability)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCapabilities_result :: GetCapabilities_result+default_GetCapabilities_result = GetCapabilities_result{+ getCapabilities_result_success = Vector.empty,+ getCapabilities_result_ex = P.Nothing}+data GetCorpora_args = GetCorpora_args { getCorpora_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getCorpora_args_provider record +instance QC.Arbitrary GetCorpora_args where + arbitrary = M.liftM GetCorpora_args (QC.arbitrary)+ shrink obj | obj == default_GetCorpora_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCorpora_args{getCorpora_args_provider = getCorpora_args_provider obj} then P.Nothing else P.Just $ default_GetCorpora_args{getCorpora_args_provider = getCorpora_args_provider obj}+ ]+from_GetCorpora_args :: GetCorpora_args -> T.ThriftVal+from_GetCorpora_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v156 -> P.Just (1, ("provider",T.TString $ E.encodeUtf8 _v156))) $ getCorpora_args_provider record+ ]+write_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> P.IO ()+write_GetCorpora_args oprot record = T.writeVal oprot $ from_GetCorpora_args record+encode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> LBS.ByteString+encode_GetCorpora_args oprot record = T.serializeVal oprot $ from_GetCorpora_args record+to_GetCorpora_args :: T.ThriftVal -> GetCorpora_args+to_GetCorpora_args (T.TStruct fields) = GetCorpora_args{+ getCorpora_args_provider = P.maybe (getCorpora_args_provider default_GetCorpora_args) (\(_,_val158) -> (case _val158 of {T.TString _val159 -> E.decodeUtf8 _val159; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCorpora_args _ = P.error "not a struct"+read_GetCorpora_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_args+read_GetCorpora_args iprot = to_GetCorpora_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_args)+decode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_args+decode_GetCorpora_args iprot bs = to_GetCorpora_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_args) bs+typemap_GetCorpora_args :: T.TypeMap+typemap_GetCorpora_args = Map.fromList [(1,("provider",T.T_STRING))]+default_GetCorpora_args :: GetCorpora_args+default_GetCorpora_args = GetCorpora_args{+ getCorpora_args_provider = ""}+data GetCorpora_result = GetCorpora_result { getCorpora_result_success :: (Vector.Vector LT.Text)+ , getCorpora_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCorpora_result_success record `H.hashWithSalt` getCorpora_result_ex record +instance QC.Arbitrary GetCorpora_result where + arbitrary = M.liftM GetCorpora_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCorpora_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj}+ , if obj == default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj}+ ]+from_GetCorpora_result :: GetCorpora_result -> T.ThriftVal+from_GetCorpora_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v162 -> (1, ("ex",Services_Types.from_ServicesException _v162))) <$> getCorpora_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v162 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v164 -> T.TString $ E.encodeUtf8 _v164) $ Vector.toList _v162))) $ getCorpora_result_success record+ , (\_v162 -> (1, ("ex",Services_Types.from_ServicesException _v162))) <$> getCorpora_result_ex record+ ]+ )+write_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> P.IO ()+write_GetCorpora_result oprot record = T.writeVal oprot $ from_GetCorpora_result record+encode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> LBS.ByteString+encode_GetCorpora_result oprot record = T.serializeVal oprot $ from_GetCorpora_result record+to_GetCorpora_result :: T.ThriftVal -> GetCorpora_result+to_GetCorpora_result (T.TStruct fields) = GetCorpora_result{+ getCorpora_result_success = P.maybe (getCorpora_result_success default_GetCorpora_result) (\(_,_val166) -> (case _val166 of {T.TList _ _val167 -> (Vector.fromList $ P.map (\_v168 -> (case _v168 of {T.TString _val169 -> E.decodeUtf8 _val169; _ -> P.error "wrong type"})) _val167); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCorpora_result_ex = P.maybe (P.Nothing) (\(_,_val166) -> P.Just (case _val166 of {T.TStruct _val170 -> (Services_Types.to_ServicesException (T.TStruct _val170)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCorpora_result _ = P.error "not a struct"+read_GetCorpora_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_result+read_GetCorpora_result iprot = to_GetCorpora_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_result)+decode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_result+decode_GetCorpora_result iprot bs = to_GetCorpora_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_result) bs+typemap_GetCorpora_result :: T.TypeMap+typemap_GetCorpora_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCorpora_result :: GetCorpora_result+default_GetCorpora_result = GetCorpora_result{+ getCorpora_result_success = Vector.empty,+ getCorpora_result_ex = P.Nothing}+process_search (seqid, iprot, oprot, handler) = do+ args <- read_Search_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.search handler (search_args_query args) (search_args_provider args)+ let res = default_Search_result{search_result_success = val}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Search_result{search_result_ex = P.Just e}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("search", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getProviders (seqid, iprot, oprot, handler) = do+ args <- read_GetProviders_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getProviders handler+ let res = default_GetProviders_result{getProviders_result_success = val}+ T.writeMessageBegin oprot ("getProviders", T.M_REPLY, seqid)+ write_GetProviders_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetProviders_result{getProviders_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getProviders", T.M_REPLY, seqid)+ write_GetProviders_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getProviders", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCapabilities (seqid, iprot, oprot, handler) = do+ args <- read_GetCapabilities_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCapabilities handler (getCapabilities_args_provider args)+ let res = default_GetCapabilities_result{getCapabilities_result_success = val}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCapabilities_result{getCapabilities_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCapabilities", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCorpora (seqid, iprot, oprot, handler) = do+ args <- read_GetCorpora_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCorpora handler (getCorpora_args_provider args)+ let res = default_GetCorpora_result{getCorpora_result_success = val}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCorpora_result{getCorpora_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCorpora", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "search" -> process_search (seqid,iprot,oprot,handler)+ "getProviders" -> process_getProviders (seqid,iprot,oprot,handler)+ "getCapabilities" -> process_getCapabilities (seqid,iprot,oprot,handler)+ "getCorpora" -> process_getCorpora (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/SearchProxyService_Client.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchProxyService_Client(search,getProviders,getCapabilities,getCorpora) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types+import SearchProxyService+seqid = R.newIORef 0+search (ip,op) arg_query arg_provider = do+ send_search op arg_query arg_provider+ recv_search ip+send_search op arg_query arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("search", T.M_CALL, seqn)+ write_Search_args op (Search_args{search_args_query=arg_query,search_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_search ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Search_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (search_result_ex res)+ P.return $ search_result_success res+getProviders (ip,op) = do+ send_getProviders op+ recv_getProviders ip+send_getProviders op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getProviders", T.M_CALL, seqn)+ write_GetProviders_args op (GetProviders_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getProviders ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetProviders_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getProviders_result_ex res)+ P.return $ getProviders_result_success res+getCapabilities (ip,op) arg_provider = do+ send_getCapabilities op arg_provider+ recv_getCapabilities ip+send_getCapabilities op arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCapabilities", T.M_CALL, seqn)+ write_GetCapabilities_args op (GetCapabilities_args{getCapabilities_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCapabilities ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCapabilities_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCapabilities_result_ex res)+ P.return $ getCapabilities_result_success res+getCorpora (ip,op) arg_provider = do+ send_getCorpora op arg_provider+ recv_getCorpora ip+send_getCorpora op arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCorpora", T.M_CALL, seqn)+ write_GetCorpora_args op (GetCorpora_args{getCorpora_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCorpora ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCorpora_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCorpora_result_ex res)+ P.return $ getCorpora_result_success res
+ src/Data/Concrete/Services/SearchProxyService_Iface.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchProxyService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types++import Service_Iface+class Service_Iface a => SearchProxyService_Iface a where+ search :: a -> SearchQuery -> LT.Text -> P.IO SearchResult+ getProviders :: a -> P.IO (Vector.Vector LT.Text)+ getCapabilities :: a -> LT.Text -> P.IO (Vector.Vector SearchCapability)+ getCorpora :: a -> LT.Text -> P.IO (Vector.Vector LT.Text)
+ src/Data/Concrete/Services/SearchService.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import qualified Service+import Search_Types+import qualified SearchService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Search_args = Search_args { search_args_query :: SearchQuery+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_args where+ hashWithSalt salt record = salt `H.hashWithSalt` search_args_query record +instance QC.Arbitrary Search_args where + arbitrary = M.liftM Search_args (QC.arbitrary)+ shrink obj | obj == default_Search_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_args{search_args_query = search_args_query obj} then P.Nothing else P.Just $ default_Search_args{search_args_query = search_args_query obj}+ ]+from_Search_args :: Search_args -> T.ThriftVal+from_Search_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v64 -> P.Just (1, ("query",from_SearchQuery _v64))) $ search_args_query record+ ]+write_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> P.IO ()+write_Search_args oprot record = T.writeVal oprot $ from_Search_args record+encode_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> LBS.ByteString+encode_Search_args oprot record = T.serializeVal oprot $ from_Search_args record+to_Search_args :: T.ThriftVal -> Search_args+to_Search_args (T.TStruct fields) = Search_args{+ search_args_query = P.maybe (search_args_query default_Search_args) (\(_,_val66) -> (case _val66 of {T.TStruct _val67 -> (to_SearchQuery (T.TStruct _val67)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Search_args _ = P.error "not a struct"+read_Search_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_args+read_Search_args iprot = to_Search_args <$> T.readVal iprot (T.T_STRUCT typemap_Search_args)+decode_Search_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_args+decode_Search_args iprot bs = to_Search_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_args) bs+typemap_Search_args :: T.TypeMap+typemap_Search_args = Map.fromList [(1,("query",(T.T_STRUCT typemap_SearchQuery)))]+default_Search_args :: Search_args+default_Search_args = Search_args{+ search_args_query = default_SearchQuery}+data Search_result = Search_result { search_result_success :: SearchResult+ , search_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_result where+ hashWithSalt salt record = salt `H.hashWithSalt` search_result_success record `H.hashWithSalt` search_result_ex record +instance QC.Arbitrary Search_result where + arbitrary = M.liftM Search_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Search_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_result{search_result_success = search_result_success obj} then P.Nothing else P.Just $ default_Search_result{search_result_success = search_result_success obj}+ , if obj == default_Search_result{search_result_ex = search_result_ex obj} then P.Nothing else P.Just $ default_Search_result{search_result_ex = search_result_ex obj}+ ]+from_Search_result :: Search_result -> T.ThriftVal+from_Search_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v70 -> (1, ("ex",Services_Types.from_ServicesException _v70))) <$> search_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v70 -> P.Just (0, ("success",from_SearchResult _v70))) $ search_result_success record+ , (\_v70 -> (1, ("ex",Services_Types.from_ServicesException _v70))) <$> search_result_ex record+ ]+ )+write_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> P.IO ()+write_Search_result oprot record = T.writeVal oprot $ from_Search_result record+encode_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> LBS.ByteString+encode_Search_result oprot record = T.serializeVal oprot $ from_Search_result record+to_Search_result :: T.ThriftVal -> Search_result+to_Search_result (T.TStruct fields) = Search_result{+ search_result_success = P.maybe (search_result_success default_Search_result) (\(_,_val72) -> (case _val72 of {T.TStruct _val73 -> (to_SearchResult (T.TStruct _val73)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ search_result_ex = P.maybe (P.Nothing) (\(_,_val72) -> P.Just (case _val72 of {T.TStruct _val74 -> (Services_Types.to_ServicesException (T.TStruct _val74)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Search_result _ = P.error "not a struct"+read_Search_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_result+read_Search_result iprot = to_Search_result <$> T.readVal iprot (T.T_STRUCT typemap_Search_result)+decode_Search_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_result+decode_Search_result iprot bs = to_Search_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_result) bs+typemap_Search_result :: T.TypeMap+typemap_Search_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Search_result :: Search_result+default_Search_result = Search_result{+ search_result_success = default_SearchResult,+ search_result_ex = P.Nothing}+data GetCapabilities_args = GetCapabilities_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetCapabilities_args where + arbitrary = QC.elements [GetCapabilities_args]+from_GetCapabilities_args :: GetCapabilities_args -> T.ThriftVal+from_GetCapabilities_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> P.IO ()+write_GetCapabilities_args oprot record = T.writeVal oprot $ from_GetCapabilities_args record+encode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> LBS.ByteString+encode_GetCapabilities_args oprot record = T.serializeVal oprot $ from_GetCapabilities_args record+to_GetCapabilities_args :: T.ThriftVal -> GetCapabilities_args+to_GetCapabilities_args (T.TStruct fields) = GetCapabilities_args{++ }+to_GetCapabilities_args _ = P.error "not a struct"+read_GetCapabilities_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_args+read_GetCapabilities_args iprot = to_GetCapabilities_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_args)+decode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_args+decode_GetCapabilities_args iprot bs = to_GetCapabilities_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_args) bs+typemap_GetCapabilities_args :: T.TypeMap+typemap_GetCapabilities_args = Map.fromList []+default_GetCapabilities_args :: GetCapabilities_args+default_GetCapabilities_args = GetCapabilities_args{+}+data GetCapabilities_result = GetCapabilities_result { getCapabilities_result_success :: (Vector.Vector SearchCapability)+ , getCapabilities_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_result_success record `H.hashWithSalt` getCapabilities_result_ex record +instance QC.Arbitrary GetCapabilities_result where + arbitrary = M.liftM GetCapabilities_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj}+ , if obj == default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj}+ ]+from_GetCapabilities_result :: GetCapabilities_result -> T.ThriftVal+from_GetCapabilities_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v82 -> (1, ("ex",Services_Types.from_ServicesException _v82))) <$> getCapabilities_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v82 -> P.Just (0, ("success",T.TList (T.T_STRUCT typemap_SearchCapability) $ P.map (\_v84 -> from_SearchCapability _v84) $ Vector.toList _v82))) $ getCapabilities_result_success record+ , (\_v82 -> (1, ("ex",Services_Types.from_ServicesException _v82))) <$> getCapabilities_result_ex record+ ]+ )+write_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> P.IO ()+write_GetCapabilities_result oprot record = T.writeVal oprot $ from_GetCapabilities_result record+encode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> LBS.ByteString+encode_GetCapabilities_result oprot record = T.serializeVal oprot $ from_GetCapabilities_result record+to_GetCapabilities_result :: T.ThriftVal -> GetCapabilities_result+to_GetCapabilities_result (T.TStruct fields) = GetCapabilities_result{+ getCapabilities_result_success = P.maybe (getCapabilities_result_success default_GetCapabilities_result) (\(_,_val86) -> (case _val86 of {T.TList _ _val87 -> (Vector.fromList $ P.map (\_v88 -> (case _v88 of {T.TStruct _val89 -> (to_SearchCapability (T.TStruct _val89)); _ -> P.error "wrong type"})) _val87); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCapabilities_result_ex = P.maybe (P.Nothing) (\(_,_val86) -> P.Just (case _val86 of {T.TStruct _val90 -> (Services_Types.to_ServicesException (T.TStruct _val90)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_result _ = P.error "not a struct"+read_GetCapabilities_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_result+read_GetCapabilities_result iprot = to_GetCapabilities_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_result)+decode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_result+decode_GetCapabilities_result iprot bs = to_GetCapabilities_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_result) bs+typemap_GetCapabilities_result :: T.TypeMap+typemap_GetCapabilities_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT typemap_SearchCapability)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCapabilities_result :: GetCapabilities_result+default_GetCapabilities_result = GetCapabilities_result{+ getCapabilities_result_success = Vector.empty,+ getCapabilities_result_ex = P.Nothing}+data GetCorpora_args = GetCorpora_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetCorpora_args where + arbitrary = QC.elements [GetCorpora_args]+from_GetCorpora_args :: GetCorpora_args -> T.ThriftVal+from_GetCorpora_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> P.IO ()+write_GetCorpora_args oprot record = T.writeVal oprot $ from_GetCorpora_args record+encode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> LBS.ByteString+encode_GetCorpora_args oprot record = T.serializeVal oprot $ from_GetCorpora_args record+to_GetCorpora_args :: T.ThriftVal -> GetCorpora_args+to_GetCorpora_args (T.TStruct fields) = GetCorpora_args{++ }+to_GetCorpora_args _ = P.error "not a struct"+read_GetCorpora_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_args+read_GetCorpora_args iprot = to_GetCorpora_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_args)+decode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_args+decode_GetCorpora_args iprot bs = to_GetCorpora_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_args) bs+typemap_GetCorpora_args :: T.TypeMap+typemap_GetCorpora_args = Map.fromList []+default_GetCorpora_args :: GetCorpora_args+default_GetCorpora_args = GetCorpora_args{+}+data GetCorpora_result = GetCorpora_result { getCorpora_result_success :: (Vector.Vector LT.Text)+ , getCorpora_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCorpora_result_success record `H.hashWithSalt` getCorpora_result_ex record +instance QC.Arbitrary GetCorpora_result where + arbitrary = M.liftM GetCorpora_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCorpora_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj}+ , if obj == default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj}+ ]+from_GetCorpora_result :: GetCorpora_result -> T.ThriftVal+from_GetCorpora_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> getCorpora_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v98 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v100 -> T.TString $ E.encodeUtf8 _v100) $ Vector.toList _v98))) $ getCorpora_result_success record+ , (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> getCorpora_result_ex record+ ]+ )+write_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> P.IO ()+write_GetCorpora_result oprot record = T.writeVal oprot $ from_GetCorpora_result record+encode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> LBS.ByteString+encode_GetCorpora_result oprot record = T.serializeVal oprot $ from_GetCorpora_result record+to_GetCorpora_result :: T.ThriftVal -> GetCorpora_result+to_GetCorpora_result (T.TStruct fields) = GetCorpora_result{+ getCorpora_result_success = P.maybe (getCorpora_result_success default_GetCorpora_result) (\(_,_val102) -> (case _val102 of {T.TList _ _val103 -> (Vector.fromList $ P.map (\_v104 -> (case _v104 of {T.TString _val105 -> E.decodeUtf8 _val105; _ -> P.error "wrong type"})) _val103); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCorpora_result_ex = P.maybe (P.Nothing) (\(_,_val102) -> P.Just (case _val102 of {T.TStruct _val106 -> (Services_Types.to_ServicesException (T.TStruct _val106)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCorpora_result _ = P.error "not a struct"+read_GetCorpora_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_result+read_GetCorpora_result iprot = to_GetCorpora_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_result)+decode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_result+decode_GetCorpora_result iprot bs = to_GetCorpora_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_result) bs+typemap_GetCorpora_result :: T.TypeMap+typemap_GetCorpora_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCorpora_result :: GetCorpora_result+default_GetCorpora_result = GetCorpora_result{+ getCorpora_result_success = Vector.empty,+ getCorpora_result_ex = P.Nothing}+process_search (seqid, iprot, oprot, handler) = do+ args <- read_Search_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.search handler (search_args_query args)+ let res = default_Search_result{search_result_success = val}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Search_result{search_result_ex = P.Just e}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("search", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCapabilities (seqid, iprot, oprot, handler) = do+ args <- read_GetCapabilities_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCapabilities handler+ let res = default_GetCapabilities_result{getCapabilities_result_success = val}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCapabilities_result{getCapabilities_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCapabilities", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCorpora (seqid, iprot, oprot, handler) = do+ args <- read_GetCorpora_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCorpora handler+ let res = default_GetCorpora_result{getCorpora_result_success = val}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCorpora_result{getCorpora_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCorpora", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "search" -> process_search (seqid,iprot,oprot,handler)+ "getCapabilities" -> process_getCapabilities (seqid,iprot,oprot,handler)+ "getCorpora" -> process_getCorpora (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/SearchService_Client.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchService_Client(search,getCapabilities,getCorpora) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types+import SearchService+seqid = R.newIORef 0+search (ip,op) arg_query = do+ send_search op arg_query+ recv_search ip+send_search op arg_query = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("search", T.M_CALL, seqn)+ write_Search_args op (Search_args{search_args_query=arg_query})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_search ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Search_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (search_result_ex res)+ P.return $ search_result_success res+getCapabilities (ip,op) = do+ send_getCapabilities op+ recv_getCapabilities ip+send_getCapabilities op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCapabilities", T.M_CALL, seqn)+ write_GetCapabilities_args op (GetCapabilities_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCapabilities ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCapabilities_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCapabilities_result_ex res)+ P.return $ getCapabilities_result_success res+getCorpora (ip,op) = do+ send_getCorpora op+ recv_getCorpora ip+send_getCorpora op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCorpora", T.M_CALL, seqn)+ write_GetCorpora_args op (GetCorpora_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCorpora ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCorpora_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCorpora_result_ex res)+ P.return $ getCorpora_result_success res
+ src/Data/Concrete/Services/SearchService_Iface.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SearchService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types++import Service_Iface+class Service_Iface a => SearchService_Iface a where+ search :: a -> SearchQuery -> P.IO SearchResult+ getCapabilities :: a -> P.IO (Vector.Vector SearchCapability)+ getCorpora :: a -> P.IO (Vector.Vector LT.Text)
+ src/Data/Concrete/Services/Service.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.Service where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+++import Services_Types+import qualified Service_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data About_args = About_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable About_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary About_args where + arbitrary = QC.elements [About_args]+from_About_args :: About_args -> T.ThriftVal+from_About_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_About_args :: (T.Protocol p, T.Transport t) => p t -> About_args -> P.IO ()+write_About_args oprot record = T.writeVal oprot $ from_About_args record+encode_About_args :: (T.Protocol p, T.Transport t) => p t -> About_args -> LBS.ByteString+encode_About_args oprot record = T.serializeVal oprot $ from_About_args record+to_About_args :: T.ThriftVal -> About_args+to_About_args (T.TStruct fields) = About_args{++ }+to_About_args _ = P.error "not a struct"+read_About_args :: (T.Transport t, T.Protocol p) => p t -> P.IO About_args+read_About_args iprot = to_About_args <$> T.readVal iprot (T.T_STRUCT typemap_About_args)+decode_About_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> About_args+decode_About_args iprot bs = to_About_args $ T.deserializeVal iprot (T.T_STRUCT typemap_About_args) bs+typemap_About_args :: T.TypeMap+typemap_About_args = Map.fromList []+default_About_args :: About_args+default_About_args = About_args{+}+data About_result = About_result { about_result_success :: ServiceInfo+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable About_result where+ hashWithSalt salt record = salt `H.hashWithSalt` about_result_success record +instance QC.Arbitrary About_result where + arbitrary = M.liftM About_result (QC.arbitrary)+ shrink obj | obj == default_About_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_About_result{about_result_success = about_result_success obj} then P.Nothing else P.Just $ default_About_result{about_result_success = about_result_success obj}+ ]+from_About_result :: About_result -> T.ThriftVal+from_About_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v43 -> P.Just (0, ("success",from_ServiceInfo _v43))) $ about_result_success record+ ]+write_About_result :: (T.Protocol p, T.Transport t) => p t -> About_result -> P.IO ()+write_About_result oprot record = T.writeVal oprot $ from_About_result record+encode_About_result :: (T.Protocol p, T.Transport t) => p t -> About_result -> LBS.ByteString+encode_About_result oprot record = T.serializeVal oprot $ from_About_result record+to_About_result :: T.ThriftVal -> About_result+to_About_result (T.TStruct fields) = About_result{+ about_result_success = P.maybe (about_result_success default_About_result) (\(_,_val45) -> (case _val45 of {T.TStruct _val46 -> (to_ServiceInfo (T.TStruct _val46)); _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_About_result _ = P.error "not a struct"+read_About_result :: (T.Transport t, T.Protocol p) => p t -> P.IO About_result+read_About_result iprot = to_About_result <$> T.readVal iprot (T.T_STRUCT typemap_About_result)+decode_About_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> About_result+decode_About_result iprot bs = to_About_result $ T.deserializeVal iprot (T.T_STRUCT typemap_About_result) bs+typemap_About_result :: T.TypeMap+typemap_About_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_ServiceInfo)))]+default_About_result :: About_result+default_About_result = About_result{+ about_result_success = default_ServiceInfo}+data Alive_args = Alive_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Alive_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary Alive_args where + arbitrary = QC.elements [Alive_args]+from_Alive_args :: Alive_args -> T.ThriftVal+from_Alive_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_Alive_args :: (T.Protocol p, T.Transport t) => p t -> Alive_args -> P.IO ()+write_Alive_args oprot record = T.writeVal oprot $ from_Alive_args record+encode_Alive_args :: (T.Protocol p, T.Transport t) => p t -> Alive_args -> LBS.ByteString+encode_Alive_args oprot record = T.serializeVal oprot $ from_Alive_args record+to_Alive_args :: T.ThriftVal -> Alive_args+to_Alive_args (T.TStruct fields) = Alive_args{++ }+to_Alive_args _ = P.error "not a struct"+read_Alive_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Alive_args+read_Alive_args iprot = to_Alive_args <$> T.readVal iprot (T.T_STRUCT typemap_Alive_args)+decode_Alive_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Alive_args+decode_Alive_args iprot bs = to_Alive_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Alive_args) bs+typemap_Alive_args :: T.TypeMap+typemap_Alive_args = Map.fromList []+default_Alive_args :: Alive_args+default_Alive_args = Alive_args{+}+data Alive_result = Alive_result { alive_result_success :: P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Alive_result where+ hashWithSalt salt record = salt `H.hashWithSalt` alive_result_success record +instance QC.Arbitrary Alive_result where + arbitrary = M.liftM Alive_result (QC.arbitrary)+ shrink obj | obj == default_Alive_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Alive_result{alive_result_success = alive_result_success obj} then P.Nothing else P.Just $ default_Alive_result{alive_result_success = alive_result_success obj}+ ]+from_Alive_result :: Alive_result -> T.ThriftVal+from_Alive_result record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v54 -> P.Just (0, ("success",T.TBool _v54))) $ alive_result_success record+ ]+write_Alive_result :: (T.Protocol p, T.Transport t) => p t -> Alive_result -> P.IO ()+write_Alive_result oprot record = T.writeVal oprot $ from_Alive_result record+encode_Alive_result :: (T.Protocol p, T.Transport t) => p t -> Alive_result -> LBS.ByteString+encode_Alive_result oprot record = T.serializeVal oprot $ from_Alive_result record+to_Alive_result :: T.ThriftVal -> Alive_result+to_Alive_result (T.TStruct fields) = Alive_result{+ alive_result_success = P.maybe (alive_result_success default_Alive_result) (\(_,_val56) -> (case _val56 of {T.TBool _val57 -> _val57; _ -> P.error "wrong type"})) (Map.lookup (0) fields)+ }+to_Alive_result _ = P.error "not a struct"+read_Alive_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Alive_result+read_Alive_result iprot = to_Alive_result <$> T.readVal iprot (T.T_STRUCT typemap_Alive_result)+decode_Alive_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Alive_result+decode_Alive_result iprot bs = to_Alive_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Alive_result) bs+typemap_Alive_result :: T.TypeMap+typemap_Alive_result = Map.fromList [(0,("success",T.T_BOOL))]+default_Alive_result :: Alive_result+default_Alive_result = Alive_result{+ alive_result_success = P.False}+process_about (seqid, iprot, oprot, handler) = do+ args <- read_About_args iprot+ (X.catch+ (do+ val <- Iface.about handler+ let res = default_About_result{about_result_success = val}+ T.writeMessageBegin oprot ("about", T.M_REPLY, seqid)+ write_About_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("about", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_alive (seqid, iprot, oprot, handler) = do+ args <- read_Alive_args iprot+ (X.catch+ (do+ val <- Iface.alive handler+ let res = default_Alive_result{alive_result_success = val}+ T.writeMessageBegin oprot ("alive", T.M_REPLY, seqid)+ write_Alive_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ ((\_ -> do+ T.writeMessageBegin oprot ("alive", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "about" -> process_about (seqid,iprot,oprot,handler)+ "alive" -> process_alive (seqid,iprot,oprot,handler)+ _ -> do+ _ <- T.readVal iprot (T.T_STRUCT Map.empty)+ T.writeMessageBegin oprot (name,T.M_EXCEPTION,seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD ("Unknown function " ++ LT.unpack name))+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/Service_Client.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.Service_Client(about,alive) where+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+++import Services_Types+import Service+seqid = R.newIORef 0+about (ip,op) = do+ send_about op+ recv_about ip+send_about op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("about", T.M_CALL, seqn)+ write_About_args op (About_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_about ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_About_result ip+ T.readMessageEnd ip+ P.return $ about_result_success res+alive (ip,op) = do+ send_alive op+ recv_alive ip+send_alive op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("alive", T.M_CALL, seqn)+ write_Alive_args op (Alive_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_alive ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Alive_result ip+ T.readMessageEnd ip+ P.return $ alive_result_success res
+ src/Data/Concrete/Services/Service_Iface.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.Service_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+++import Services_Types++class Service_Iface a where+ about :: a -> P.IO ServiceInfo+ alive :: a -> P.IO P.Bool
+ src/Data/Concrete/Services/StoreCommunicationService.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.StoreCommunicationService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import qualified Service+import Access_Types+import qualified StoreCommunicationService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Store_args = Store_args { store_args_communication :: Communication_Types.Communication+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Store_args where+ hashWithSalt salt record = salt `H.hashWithSalt` store_args_communication record +instance QC.Arbitrary Store_args where + arbitrary = M.liftM Store_args (QC.arbitrary)+ shrink obj | obj == default_Store_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Store_args{store_args_communication = store_args_communication obj} then P.Nothing else P.Just $ default_Store_args{store_args_communication = store_args_communication obj}+ ]+from_Store_args :: Store_args -> T.ThriftVal+from_Store_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v66 -> P.Just (1, ("communication",Communication_Types.from_Communication _v66))) $ store_args_communication record+ ]+write_Store_args :: (T.Protocol p, T.Transport t) => p t -> Store_args -> P.IO ()+write_Store_args oprot record = T.writeVal oprot $ from_Store_args record+encode_Store_args :: (T.Protocol p, T.Transport t) => p t -> Store_args -> LBS.ByteString+encode_Store_args oprot record = T.serializeVal oprot $ from_Store_args record+to_Store_args :: T.ThriftVal -> Store_args+to_Store_args (T.TStruct fields) = Store_args{+ store_args_communication = P.maybe (store_args_communication default_Store_args) (\(_,_val68) -> (case _val68 of {T.TStruct _val69 -> (Communication_Types.to_Communication (T.TStruct _val69)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Store_args _ = P.error "not a struct"+read_Store_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Store_args+read_Store_args iprot = to_Store_args <$> T.readVal iprot (T.T_STRUCT typemap_Store_args)+decode_Store_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Store_args+decode_Store_args iprot bs = to_Store_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Store_args) bs+typemap_Store_args :: T.TypeMap+typemap_Store_args = Map.fromList [(1,("communication",(T.T_STRUCT Communication_Types.typemap_Communication)))]+default_Store_args :: Store_args+default_Store_args = Store_args{+ store_args_communication = Communication_Types.default_Communication}+data Store_result = Store_result { store_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Store_result where+ hashWithSalt salt record = salt `H.hashWithSalt` store_result_ex record +instance QC.Arbitrary Store_result where + arbitrary = M.liftM Store_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Store_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Store_result{store_result_ex = store_result_ex obj} then P.Nothing else P.Just $ default_Store_result{store_result_ex = store_result_ex obj}+ ]+from_Store_result :: Store_result -> T.ThriftVal+from_Store_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v72 -> (1, ("ex",Services_Types.from_ServicesException _v72))) <$> store_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v72 -> (1, ("ex",Services_Types.from_ServicesException _v72))) <$> store_result_ex record+ ]+ )+write_Store_result :: (T.Protocol p, T.Transport t) => p t -> Store_result -> P.IO ()+write_Store_result oprot record = T.writeVal oprot $ from_Store_result record+encode_Store_result :: (T.Protocol p, T.Transport t) => p t -> Store_result -> LBS.ByteString+encode_Store_result oprot record = T.serializeVal oprot $ from_Store_result record+to_Store_result :: T.ThriftVal -> Store_result+to_Store_result (T.TStruct fields) = Store_result{+ store_result_ex = P.maybe (P.Nothing) (\(_,_val74) -> P.Just (case _val74 of {T.TStruct _val75 -> (Services_Types.to_ServicesException (T.TStruct _val75)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Store_result _ = P.error "not a struct"+read_Store_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Store_result+read_Store_result iprot = to_Store_result <$> T.readVal iprot (T.T_STRUCT typemap_Store_result)+decode_Store_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Store_result+decode_Store_result iprot bs = to_Store_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Store_result) bs+typemap_Store_result :: T.TypeMap+typemap_Store_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Store_result :: Store_result+default_Store_result = Store_result{+ store_result_ex = P.Nothing}+process_store (seqid, iprot, oprot, handler) = do+ args <- read_Store_args iprot+ (X.catch+ (X.catch+ (do+ Iface.store handler (store_args_communication args)+ let res = default_Store_result+ T.writeMessageBegin oprot ("store", T.M_REPLY, seqid)+ write_Store_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Store_result{store_result_ex = P.Just e}+ T.writeMessageBegin oprot ("store", T.M_REPLY, seqid)+ write_Store_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("store", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "store" -> process_store (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/StoreCommunicationService_Client.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.StoreCommunicationService_Client(store) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import Access_Types+import StoreCommunicationService+seqid = R.newIORef 0+store (ip,op) arg_communication = do+ send_store op arg_communication+ recv_store ip+send_store op arg_communication = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("store", T.M_CALL, seqn)+ write_Store_args op (Store_args{store_args_communication=arg_communication})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_store ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Store_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (store_result_ex res)+ P.return ()
+ src/Data/Concrete/Services/StoreCommunicationService_Iface.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.StoreCommunicationService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+++import Access_Types++import Service_Iface+class Service_Iface a => StoreCommunicationService_Iface a where+ store :: a -> Communication_Types.Communication -> P.IO ()
+ src/Data/Concrete/Services/SummarizationService.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SummarizationService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import qualified Service+import Summarization_Types+import qualified SummarizationService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Summarize_args = Summarize_args { summarize_args_query :: SummarizationRequest+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Summarize_args where+ hashWithSalt salt record = salt `H.hashWithSalt` summarize_args_query record +instance QC.Arbitrary Summarize_args where + arbitrary = M.liftM Summarize_args (QC.arbitrary)+ shrink obj | obj == default_Summarize_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Summarize_args{summarize_args_query = summarize_args_query obj} then P.Nothing else P.Just $ default_Summarize_args{summarize_args_query = summarize_args_query obj}+ ]+from_Summarize_args :: Summarize_args -> T.ThriftVal+from_Summarize_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v48 -> P.Just (1, ("query",from_SummarizationRequest _v48))) $ summarize_args_query record+ ]+write_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> Summarize_args -> P.IO ()+write_Summarize_args oprot record = T.writeVal oprot $ from_Summarize_args record+encode_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> Summarize_args -> LBS.ByteString+encode_Summarize_args oprot record = T.serializeVal oprot $ from_Summarize_args record+to_Summarize_args :: T.ThriftVal -> Summarize_args+to_Summarize_args (T.TStruct fields) = Summarize_args{+ summarize_args_query = P.maybe (summarize_args_query default_Summarize_args) (\(_,_val50) -> (case _val50 of {T.TStruct _val51 -> (to_SummarizationRequest (T.TStruct _val51)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Summarize_args _ = P.error "not a struct"+read_Summarize_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Summarize_args+read_Summarize_args iprot = to_Summarize_args <$> T.readVal iprot (T.T_STRUCT typemap_Summarize_args)+decode_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Summarize_args+decode_Summarize_args iprot bs = to_Summarize_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Summarize_args) bs+typemap_Summarize_args :: T.TypeMap+typemap_Summarize_args = Map.fromList [(1,("query",(T.T_STRUCT typemap_SummarizationRequest)))]+default_Summarize_args :: Summarize_args+default_Summarize_args = Summarize_args{+ summarize_args_query = default_SummarizationRequest}+data Summarize_result = Summarize_result { summarize_result_success :: Summary+ , summarize_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Summarize_result where+ hashWithSalt salt record = salt `H.hashWithSalt` summarize_result_success record `H.hashWithSalt` summarize_result_ex record +instance QC.Arbitrary Summarize_result where + arbitrary = M.liftM Summarize_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Summarize_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Summarize_result{summarize_result_success = summarize_result_success obj} then P.Nothing else P.Just $ default_Summarize_result{summarize_result_success = summarize_result_success obj}+ , if obj == default_Summarize_result{summarize_result_ex = summarize_result_ex obj} then P.Nothing else P.Just $ default_Summarize_result{summarize_result_ex = summarize_result_ex obj}+ ]+from_Summarize_result :: Summarize_result -> T.ThriftVal+from_Summarize_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v54 -> (1, ("ex",Services_Types.from_ServicesException _v54))) <$> summarize_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v54 -> P.Just (0, ("success",from_Summary _v54))) $ summarize_result_success record+ , (\_v54 -> (1, ("ex",Services_Types.from_ServicesException _v54))) <$> summarize_result_ex record+ ]+ )+write_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> Summarize_result -> P.IO ()+write_Summarize_result oprot record = T.writeVal oprot $ from_Summarize_result record+encode_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> Summarize_result -> LBS.ByteString+encode_Summarize_result oprot record = T.serializeVal oprot $ from_Summarize_result record+to_Summarize_result :: T.ThriftVal -> Summarize_result+to_Summarize_result (T.TStruct fields) = Summarize_result{+ summarize_result_success = P.maybe (summarize_result_success default_Summarize_result) (\(_,_val56) -> (case _val56 of {T.TStruct _val57 -> (to_Summary (T.TStruct _val57)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ summarize_result_ex = P.maybe (P.Nothing) (\(_,_val56) -> P.Just (case _val56 of {T.TStruct _val58 -> (Services_Types.to_ServicesException (T.TStruct _val58)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Summarize_result _ = P.error "not a struct"+read_Summarize_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Summarize_result+read_Summarize_result iprot = to_Summarize_result <$> T.readVal iprot (T.T_STRUCT typemap_Summarize_result)+decode_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Summarize_result+decode_Summarize_result iprot bs = to_Summarize_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Summarize_result) bs+typemap_Summarize_result :: T.TypeMap+typemap_Summarize_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_Summary))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Summarize_result :: Summarize_result+default_Summarize_result = Summarize_result{+ summarize_result_success = default_Summary,+ summarize_result_ex = P.Nothing}+data GetCapabilities_args = GetCapabilities_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetCapabilities_args where + arbitrary = QC.elements [GetCapabilities_args]+from_GetCapabilities_args :: GetCapabilities_args -> T.ThriftVal+from_GetCapabilities_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> P.IO ()+write_GetCapabilities_args oprot record = T.writeVal oprot $ from_GetCapabilities_args record+encode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> LBS.ByteString+encode_GetCapabilities_args oprot record = T.serializeVal oprot $ from_GetCapabilities_args record+to_GetCapabilities_args :: T.ThriftVal -> GetCapabilities_args+to_GetCapabilities_args (T.TStruct fields) = GetCapabilities_args{++ }+to_GetCapabilities_args _ = P.error "not a struct"+read_GetCapabilities_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_args+read_GetCapabilities_args iprot = to_GetCapabilities_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_args)+decode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_args+decode_GetCapabilities_args iprot bs = to_GetCapabilities_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_args) bs+typemap_GetCapabilities_args :: T.TypeMap+typemap_GetCapabilities_args = Map.fromList []+default_GetCapabilities_args :: GetCapabilities_args+default_GetCapabilities_args = GetCapabilities_args{+}+data GetCapabilities_result = GetCapabilities_result { getCapabilities_result_success :: (Vector.Vector SummarizationCapability)+ , getCapabilities_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_result_success record `H.hashWithSalt` getCapabilities_result_ex record +instance QC.Arbitrary GetCapabilities_result where + arbitrary = M.liftM GetCapabilities_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj}+ , if obj == default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj}+ ]+from_GetCapabilities_result :: GetCapabilities_result -> T.ThriftVal+from_GetCapabilities_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v66 -> (1, ("ex",Services_Types.from_ServicesException _v66))) <$> getCapabilities_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v66 -> P.Just (0, ("success",T.TList (T.T_STRUCT typemap_SummarizationCapability) $ P.map (\_v68 -> from_SummarizationCapability _v68) $ Vector.toList _v66))) $ getCapabilities_result_success record+ , (\_v66 -> (1, ("ex",Services_Types.from_ServicesException _v66))) <$> getCapabilities_result_ex record+ ]+ )+write_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> P.IO ()+write_GetCapabilities_result oprot record = T.writeVal oprot $ from_GetCapabilities_result record+encode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> LBS.ByteString+encode_GetCapabilities_result oprot record = T.serializeVal oprot $ from_GetCapabilities_result record+to_GetCapabilities_result :: T.ThriftVal -> GetCapabilities_result+to_GetCapabilities_result (T.TStruct fields) = GetCapabilities_result{+ getCapabilities_result_success = P.maybe (getCapabilities_result_success default_GetCapabilities_result) (\(_,_val70) -> (case _val70 of {T.TList _ _val71 -> (Vector.fromList $ P.map (\_v72 -> (case _v72 of {T.TStruct _val73 -> (to_SummarizationCapability (T.TStruct _val73)); _ -> P.error "wrong type"})) _val71); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCapabilities_result_ex = P.maybe (P.Nothing) (\(_,_val70) -> P.Just (case _val70 of {T.TStruct _val74 -> (Services_Types.to_ServicesException (T.TStruct _val74)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_result _ = P.error "not a struct"+read_GetCapabilities_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_result+read_GetCapabilities_result iprot = to_GetCapabilities_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_result)+decode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_result+decode_GetCapabilities_result iprot bs = to_GetCapabilities_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_result) bs+typemap_GetCapabilities_result :: T.TypeMap+typemap_GetCapabilities_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT typemap_SummarizationCapability)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCapabilities_result :: GetCapabilities_result+default_GetCapabilities_result = GetCapabilities_result{+ getCapabilities_result_success = Vector.empty,+ getCapabilities_result_ex = P.Nothing}+process_summarize (seqid, iprot, oprot, handler) = do+ args <- read_Summarize_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.summarize handler (summarize_args_query args)+ let res = default_Summarize_result{summarize_result_success = val}+ T.writeMessageBegin oprot ("summarize", T.M_REPLY, seqid)+ write_Summarize_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Summarize_result{summarize_result_ex = P.Just e}+ T.writeMessageBegin oprot ("summarize", T.M_REPLY, seqid)+ write_Summarize_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("summarize", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCapabilities (seqid, iprot, oprot, handler) = do+ args <- read_GetCapabilities_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCapabilities handler+ let res = default_GetCapabilities_result{getCapabilities_result_success = val}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCapabilities_result{getCapabilities_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCapabilities", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "summarize" -> process_summarize (seqid,iprot,oprot,handler)+ "getCapabilities" -> process_getCapabilities (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/Data/Concrete/Services/SummarizationService_Client.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SummarizationService_Client(summarize,getCapabilities) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import Summarization_Types+import SummarizationService+seqid = R.newIORef 0+summarize (ip,op) arg_query = do+ send_summarize op arg_query+ recv_summarize ip+send_summarize op arg_query = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("summarize", T.M_CALL, seqn)+ write_Summarize_args op (Summarize_args{summarize_args_query=arg_query})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_summarize ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Summarize_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (summarize_result_ex res)+ P.return $ summarize_result_success res+getCapabilities (ip,op) = do+ send_getCapabilities op+ recv_getCapabilities ip+send_getCapabilities op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCapabilities", T.M_CALL, seqn)+ write_GetCapabilities_args op (GetCapabilities_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCapabilities ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCapabilities_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCapabilities_result_ex res)+ P.return $ getCapabilities_result_success res
+ src/Data/Concrete/Services/SummarizationService_Iface.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Data.Concrete.Services.SummarizationService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import Summarization_Types++import Service_Iface+class Service_Iface a => SummarizationService_Iface a where+ summarize :: a -> SummarizationRequest -> P.IO Summary+ getCapabilities :: a -> P.IO (Vector.Vector SummarizationCapability)
src/Data/Concrete/Utils.hs view
@@ -4,16 +4,23 @@ getUUID , createAnnotationMetadata , readCommunicationsFromBytes+ , readCommunicationsFromTar+ , readCommunicationsFromZip , writeCommunications , writeCommunication+ , writeCommunicationToZip , showCommunication+ , sendCommunication+ , connectToService ) where import GHC.Generics import qualified Data.Concrete as C-import Data.Concrete (Communication(..), UUID(..), default_Communication, read_Communication)+import Path.IO (resolveFile')+import Data.Concrete (Communication(..), Section(..), UUID(..), default_Communication, read_Communication)+--import Data.Concrete (StoreCommunicationService_Client) import Data.Text-import Data.Maybe (fromJust, maybeToList)+import Data.Maybe (fromJust, maybeToList, fromMaybe) import Data.ByteString.Lazy import Data.Map import Data.UUID.V4 (nextRandom)@@ -24,28 +31,54 @@ import Thrift.Transport.Framed import Thrift.Transport.Empty import Thrift.Protocol.Compact-import Thrift.Protocol.JSON+import Thrift.Protocol import Thrift.Transport.IOBuffer import Thrift.Transport import qualified Data.List as L+import qualified Data.Map as Map import qualified Data.ByteString.Lazy as BS import qualified Codec.Compression.GZip as GZip+import qualified Codec.Compression.BZip as BZip import qualified Codec.Archive.Tar as Tar+import qualified Codec.Archive.Zip as Zip import qualified Codec.Archive.Tar.Entry as Tar import Data.Time import Data.Time.Clock.POSIX import System.FilePath (takeFileName, (</>), (<.>)) import Data.Either (rights)-import Control.Monad (liftM)+import Control.Monad (liftM, join) import Data.Foldable (foldr) import System.IO (Handle) import qualified Data.Vector as V+import qualified Network as Net getUUID :: IO UUID getUUID = do uuid <- (T.pack . toString) <$> nextRandom return $ UUID uuid +readCommunicationsFromTar :: ByteString -> IO [Communication]+readCommunicationsFromTar bs = do+ let es = Tar.read bs+ cs = Tar.foldEntries (\e x -> (Tar.entryContent e):x) [] (\e -> []) es+ sequence $ L.map (\ (Tar.NormalFile bs _) -> stringToComm bs) cs++writeCommunicationsToTar :: [Communication] -> ByteString+writeCommunicationsToTar cs = error "unimplemented"++readCommunicationsFromZip :: String -> IO [Communication]+readCommunicationsFromZip f = do+ f' <- resolveFile' f+ es <- Zip.withArchive f' ((Map.keys <$> Zip.getEntries))+ bss <- Zip.withArchive f' ((sequence . (L.map Zip.getEntry)) es)+ sequence $ L.map (stringToComm . fromStrict) bss+ +writeCommunicationsToZip :: String -> [Communication] -> IO ()+writeCommunicationsToZip f cs = return ()++writeCommunicationToZip :: String -> [Communication] -> IO ()+writeCommunicationToZip f cs = return ()+ writeCommunications :: Handle -> [Communication] -> IO () writeCommunications out cs = do let tarPath = "comms"@@ -58,15 +91,27 @@ writeCommunication :: Handle -> Communication -> IO () writeCommunication out c = do t <- commToString c- (BS.hPutStr out . GZip.compress) t+ BS.hPutStr out t+ -- +connectToService :: String -> Int -> IO (CompactProtocol (FramedTransport Handle), CompactProtocol (FramedTransport Handle))+connectToService h p = do+ transport <- hOpen (h, Net.PortNumber $ fromIntegral p)+ transport' <- openFramedTransport transport+ let protocol = CompactProtocol transport'+ return (protocol, protocol) +sendCommunication :: String -> Int -> Communication -> IO ()+sendCommunication h p c = do + return ()+ readCommunicationsFromBytes :: BS.ByteString -> IO [Communication] readCommunicationsFromBytes t = do- --t <- (liftM GZip.decompress . BS.readFile) f transport <- newTString fillBuf (getRead transport) t let iproto = CompactProtocol transport- readCommunication' iproto []+ c <- read_Communication iproto+ c' <- read_Communication iproto+ return [c'] where readCommunication' pr cs = do o <- tIsOpen $ getTransport pr @@ -106,7 +151,7 @@ tFlush (TString r w) = flushBuf w >> return () commToString :: Communication -> IO BS.ByteString-commToString c = do+commToString c = do otransport <- newTString let oproto = CompactProtocol otransport C.write_Communication oproto c@@ -132,9 +177,10 @@ } showSection :: T.Text -> C.Section -> T.Text-showSection t s = T.concat ["\t", ((fromJust . C.section_label) s), " ", (C.section_kind s), "--->", t']+showSection t s = T.concat [" ", ((fromMaybe "*NO LABEL*" . C.section_label) s), " == ", t'] where C.TextSpan s' e' = (fromJust . C.section_textSpan) s+ k = C.section_kind s t' = substr t (fromIntegral s') (fromIntegral e') substr :: T.Text -> Int -> Int -> T.Text@@ -144,9 +190,9 @@ res = T.take (fromIntegral $ e - s) start showCommunication :: Communication -> T.Text-showCommunication c = T.concat [C.communication_id c, " ", C.communication_type c, "\n", T.intercalate "\n" sects, "\n"]- where +showCommunication c = T.concat [C.communication_id c, " ", C.communication_type c, "\n", " Content:", "\n", T.intercalate "\n" sects, "\n"]+ where ss = L.concat $ L.map V.toList (maybeToList (C.communication_sectionList c)) t = (fromJust . C.communication_text) c- sects = L.map (showSection t) ss-+ sects = L.map (showSection t) ((L.filter (\x -> section_kind x == "content")) ss)+
+ src/Email_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Email_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Email_Types
+ src/Entities_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Entities_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Structure_Types+import qualified Metadata_Types+import qualified Uuid_Types+import qualified Linking_Types+++import Entities_Types
+ src/Ex_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Ex_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Ex_Types
+ src/FeedbackService.hs view
@@ -0,0 +1,359 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module FeedbackService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import qualified Service+import Search_Types+import qualified FeedbackService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data StartFeedback_args = StartFeedback_args { startFeedback_args_results :: SearchResult+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` startFeedback_args_results record +instance QC.Arbitrary StartFeedback_args where + arbitrary = M.liftM StartFeedback_args (QC.arbitrary)+ shrink obj | obj == default_StartFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartFeedback_args{startFeedback_args_results = startFeedback_args_results obj} then P.Nothing else P.Just $ default_StartFeedback_args{startFeedback_args_results = startFeedback_args_results obj}+ ]+from_StartFeedback_args :: StartFeedback_args -> T.ThriftVal+from_StartFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v173 -> P.Just (1, ("results",from_SearchResult _v173))) $ startFeedback_args_results record+ ]+write_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_args -> P.IO ()+write_StartFeedback_args oprot record = T.writeVal oprot $ from_StartFeedback_args record+encode_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_args -> LBS.ByteString+encode_StartFeedback_args oprot record = T.serializeVal oprot $ from_StartFeedback_args record+to_StartFeedback_args :: T.ThriftVal -> StartFeedback_args+to_StartFeedback_args (T.TStruct fields) = StartFeedback_args{+ startFeedback_args_results = P.maybe (startFeedback_args_results default_StartFeedback_args) (\(_,_val175) -> (case _val175 of {T.TStruct _val176 -> (to_SearchResult (T.TStruct _val176)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartFeedback_args _ = P.error "not a struct"+read_StartFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StartFeedback_args+read_StartFeedback_args iprot = to_StartFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_StartFeedback_args)+decode_StartFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartFeedback_args+decode_StartFeedback_args iprot bs = to_StartFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StartFeedback_args) bs+typemap_StartFeedback_args :: T.TypeMap+typemap_StartFeedback_args = Map.fromList [(1,("results",(T.T_STRUCT typemap_SearchResult)))]+default_StartFeedback_args :: StartFeedback_args+default_StartFeedback_args = StartFeedback_args{+ startFeedback_args_results = default_SearchResult}+data StartFeedback_result = StartFeedback_result { startFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` startFeedback_result_ex record +instance QC.Arbitrary StartFeedback_result where + arbitrary = M.liftM StartFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StartFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartFeedback_result{startFeedback_result_ex = startFeedback_result_ex obj} then P.Nothing else P.Just $ default_StartFeedback_result{startFeedback_result_ex = startFeedback_result_ex obj}+ ]+from_StartFeedback_result :: StartFeedback_result -> T.ThriftVal+from_StartFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v179 -> (1, ("ex",Services_Types.from_ServicesException _v179))) <$> startFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v179 -> (1, ("ex",Services_Types.from_ServicesException _v179))) <$> startFeedback_result_ex record+ ]+ )+write_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_result -> P.IO ()+write_StartFeedback_result oprot record = T.writeVal oprot $ from_StartFeedback_result record+encode_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> StartFeedback_result -> LBS.ByteString+encode_StartFeedback_result oprot record = T.serializeVal oprot $ from_StartFeedback_result record+to_StartFeedback_result :: T.ThriftVal -> StartFeedback_result+to_StartFeedback_result (T.TStruct fields) = StartFeedback_result{+ startFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val181) -> P.Just (case _val181 of {T.TStruct _val182 -> (Services_Types.to_ServicesException (T.TStruct _val182)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartFeedback_result _ = P.error "not a struct"+read_StartFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StartFeedback_result+read_StartFeedback_result iprot = to_StartFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_StartFeedback_result)+decode_StartFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartFeedback_result+decode_StartFeedback_result iprot bs = to_StartFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StartFeedback_result) bs+typemap_StartFeedback_result :: T.TypeMap+typemap_StartFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StartFeedback_result :: StartFeedback_result+default_StartFeedback_result = StartFeedback_result{+ startFeedback_result_ex = P.Nothing}+data AddCommunicationFeedback_args = AddCommunicationFeedback_args { addCommunicationFeedback_args_searchResultsId :: Uuid_Types.UUID+ , addCommunicationFeedback_args_communicationId :: LT.Text+ , addCommunicationFeedback_args_feedback :: SearchFeedback+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddCommunicationFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addCommunicationFeedback_args_searchResultsId record `H.hashWithSalt` addCommunicationFeedback_args_communicationId record `H.hashWithSalt` addCommunicationFeedback_args_feedback record +instance QC.Arbitrary AddCommunicationFeedback_args where + arbitrary = M.liftM AddCommunicationFeedback_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddCommunicationFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId = addCommunicationFeedback_args_searchResultsId obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId = addCommunicationFeedback_args_searchResultsId obj}+ , if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_communicationId = addCommunicationFeedback_args_communicationId obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_communicationId = addCommunicationFeedback_args_communicationId obj}+ , if obj == default_AddCommunicationFeedback_args{addCommunicationFeedback_args_feedback = addCommunicationFeedback_args_feedback obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_args{addCommunicationFeedback_args_feedback = addCommunicationFeedback_args_feedback obj}+ ]+from_AddCommunicationFeedback_args :: AddCommunicationFeedback_args -> T.ThriftVal+from_AddCommunicationFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v185 -> P.Just (1, ("searchResultsId",Uuid_Types.from_UUID _v185))) $ addCommunicationFeedback_args_searchResultsId record+ , (\_v185 -> P.Just (2, ("communicationId",T.TString $ E.encodeUtf8 _v185))) $ addCommunicationFeedback_args_communicationId record+ , (\_v185 -> P.Just (3, ("feedback",T.TI32 $ P.fromIntegral $ P.fromEnum _v185))) $ addCommunicationFeedback_args_feedback record+ ]+write_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_args -> P.IO ()+write_AddCommunicationFeedback_args oprot record = T.writeVal oprot $ from_AddCommunicationFeedback_args record+encode_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_args -> LBS.ByteString+encode_AddCommunicationFeedback_args oprot record = T.serializeVal oprot $ from_AddCommunicationFeedback_args record+to_AddCommunicationFeedback_args :: T.ThriftVal -> AddCommunicationFeedback_args+to_AddCommunicationFeedback_args (T.TStruct fields) = AddCommunicationFeedback_args{+ addCommunicationFeedback_args_searchResultsId = P.maybe (addCommunicationFeedback_args_searchResultsId default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TStruct _val188 -> (Uuid_Types.to_UUID (T.TStruct _val188)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addCommunicationFeedback_args_communicationId = P.maybe (addCommunicationFeedback_args_communicationId default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TString _val189 -> E.decodeUtf8 _val189; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ addCommunicationFeedback_args_feedback = P.maybe (addCommunicationFeedback_args_feedback default_AddCommunicationFeedback_args) (\(_,_val187) -> (case _val187 of {T.TI32 _val190 -> P.toEnum $ P.fromIntegral _val190; _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_AddCommunicationFeedback_args _ = P.error "not a struct"+read_AddCommunicationFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddCommunicationFeedback_args+read_AddCommunicationFeedback_args iprot = to_AddCommunicationFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_args)+decode_AddCommunicationFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddCommunicationFeedback_args+decode_AddCommunicationFeedback_args iprot bs = to_AddCommunicationFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_args) bs+typemap_AddCommunicationFeedback_args :: T.TypeMap+typemap_AddCommunicationFeedback_args = Map.fromList [(1,("searchResultsId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("communicationId",T.T_STRING)),(3,("feedback",T.T_I32))]+default_AddCommunicationFeedback_args :: AddCommunicationFeedback_args+default_AddCommunicationFeedback_args = AddCommunicationFeedback_args{+ addCommunicationFeedback_args_searchResultsId = Uuid_Types.default_UUID,+ addCommunicationFeedback_args_communicationId = "",+ addCommunicationFeedback_args_feedback = (P.toEnum 0)}+data AddCommunicationFeedback_result = AddCommunicationFeedback_result { addCommunicationFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddCommunicationFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` addCommunicationFeedback_result_ex record +instance QC.Arbitrary AddCommunicationFeedback_result where + arbitrary = M.liftM AddCommunicationFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_AddCommunicationFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = addCommunicationFeedback_result_ex obj} then P.Nothing else P.Just $ default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = addCommunicationFeedback_result_ex obj}+ ]+from_AddCommunicationFeedback_result :: AddCommunicationFeedback_result -> T.ThriftVal+from_AddCommunicationFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v193 -> (1, ("ex",Services_Types.from_ServicesException _v193))) <$> addCommunicationFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v193 -> (1, ("ex",Services_Types.from_ServicesException _v193))) <$> addCommunicationFeedback_result_ex record+ ]+ )+write_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_result -> P.IO ()+write_AddCommunicationFeedback_result oprot record = T.writeVal oprot $ from_AddCommunicationFeedback_result record+encode_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddCommunicationFeedback_result -> LBS.ByteString+encode_AddCommunicationFeedback_result oprot record = T.serializeVal oprot $ from_AddCommunicationFeedback_result record+to_AddCommunicationFeedback_result :: T.ThriftVal -> AddCommunicationFeedback_result+to_AddCommunicationFeedback_result (T.TStruct fields) = AddCommunicationFeedback_result{+ addCommunicationFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val195) -> P.Just (case _val195 of {T.TStruct _val196 -> (Services_Types.to_ServicesException (T.TStruct _val196)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_AddCommunicationFeedback_result _ = P.error "not a struct"+read_AddCommunicationFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddCommunicationFeedback_result+read_AddCommunicationFeedback_result iprot = to_AddCommunicationFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_result)+decode_AddCommunicationFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddCommunicationFeedback_result+decode_AddCommunicationFeedback_result iprot bs = to_AddCommunicationFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddCommunicationFeedback_result) bs+typemap_AddCommunicationFeedback_result :: T.TypeMap+typemap_AddCommunicationFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_AddCommunicationFeedback_result :: AddCommunicationFeedback_result+default_AddCommunicationFeedback_result = AddCommunicationFeedback_result{+ addCommunicationFeedback_result_ex = P.Nothing}+data AddSentenceFeedback_args = AddSentenceFeedback_args { addSentenceFeedback_args_searchResultsId :: Uuid_Types.UUID+ , addSentenceFeedback_args_communicationId :: LT.Text+ , addSentenceFeedback_args_sentenceId :: Uuid_Types.UUID+ , addSentenceFeedback_args_feedback :: SearchFeedback+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddSentenceFeedback_args where+ hashWithSalt salt record = salt `H.hashWithSalt` addSentenceFeedback_args_searchResultsId record `H.hashWithSalt` addSentenceFeedback_args_communicationId record `H.hashWithSalt` addSentenceFeedback_args_sentenceId record `H.hashWithSalt` addSentenceFeedback_args_feedback record +instance QC.Arbitrary AddSentenceFeedback_args where + arbitrary = M.liftM AddSentenceFeedback_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_AddSentenceFeedback_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId = addSentenceFeedback_args_searchResultsId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId = addSentenceFeedback_args_searchResultsId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_communicationId = addSentenceFeedback_args_communicationId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_communicationId = addSentenceFeedback_args_communicationId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_sentenceId = addSentenceFeedback_args_sentenceId obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_sentenceId = addSentenceFeedback_args_sentenceId obj}+ , if obj == default_AddSentenceFeedback_args{addSentenceFeedback_args_feedback = addSentenceFeedback_args_feedback obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_args{addSentenceFeedback_args_feedback = addSentenceFeedback_args_feedback obj}+ ]+from_AddSentenceFeedback_args :: AddSentenceFeedback_args -> T.ThriftVal+from_AddSentenceFeedback_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v199 -> P.Just (1, ("searchResultsId",Uuid_Types.from_UUID _v199))) $ addSentenceFeedback_args_searchResultsId record+ , (\_v199 -> P.Just (2, ("communicationId",T.TString $ E.encodeUtf8 _v199))) $ addSentenceFeedback_args_communicationId record+ , (\_v199 -> P.Just (3, ("sentenceId",Uuid_Types.from_UUID _v199))) $ addSentenceFeedback_args_sentenceId record+ , (\_v199 -> P.Just (4, ("feedback",T.TI32 $ P.fromIntegral $ P.fromEnum _v199))) $ addSentenceFeedback_args_feedback record+ ]+write_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_args -> P.IO ()+write_AddSentenceFeedback_args oprot record = T.writeVal oprot $ from_AddSentenceFeedback_args record+encode_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_args -> LBS.ByteString+encode_AddSentenceFeedback_args oprot record = T.serializeVal oprot $ from_AddSentenceFeedback_args record+to_AddSentenceFeedback_args :: T.ThriftVal -> AddSentenceFeedback_args+to_AddSentenceFeedback_args (T.TStruct fields) = AddSentenceFeedback_args{+ addSentenceFeedback_args_searchResultsId = P.maybe (addSentenceFeedback_args_searchResultsId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TStruct _val202 -> (Uuid_Types.to_UUID (T.TStruct _val202)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ addSentenceFeedback_args_communicationId = P.maybe (addSentenceFeedback_args_communicationId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TString _val203 -> E.decodeUtf8 _val203; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ addSentenceFeedback_args_sentenceId = P.maybe (addSentenceFeedback_args_sentenceId default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TStruct _val204 -> (Uuid_Types.to_UUID (T.TStruct _val204)); _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ addSentenceFeedback_args_feedback = P.maybe (addSentenceFeedback_args_feedback default_AddSentenceFeedback_args) (\(_,_val201) -> (case _val201 of {T.TI32 _val205 -> P.toEnum $ P.fromIntegral _val205; _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_AddSentenceFeedback_args _ = P.error "not a struct"+read_AddSentenceFeedback_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddSentenceFeedback_args+read_AddSentenceFeedback_args iprot = to_AddSentenceFeedback_args <$> T.readVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_args)+decode_AddSentenceFeedback_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddSentenceFeedback_args+decode_AddSentenceFeedback_args iprot bs = to_AddSentenceFeedback_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_args) bs+typemap_AddSentenceFeedback_args :: T.TypeMap+typemap_AddSentenceFeedback_args = Map.fromList [(1,("searchResultsId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("communicationId",T.T_STRING)),(3,("sentenceId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(4,("feedback",T.T_I32))]+default_AddSentenceFeedback_args :: AddSentenceFeedback_args+default_AddSentenceFeedback_args = AddSentenceFeedback_args{+ addSentenceFeedback_args_searchResultsId = Uuid_Types.default_UUID,+ addSentenceFeedback_args_communicationId = "",+ addSentenceFeedback_args_sentenceId = Uuid_Types.default_UUID,+ addSentenceFeedback_args_feedback = (P.toEnum 0)}+data AddSentenceFeedback_result = AddSentenceFeedback_result { addSentenceFeedback_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable AddSentenceFeedback_result where+ hashWithSalt salt record = salt `H.hashWithSalt` addSentenceFeedback_result_ex record +instance QC.Arbitrary AddSentenceFeedback_result where + arbitrary = M.liftM AddSentenceFeedback_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_AddSentenceFeedback_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = addSentenceFeedback_result_ex obj} then P.Nothing else P.Just $ default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = addSentenceFeedback_result_ex obj}+ ]+from_AddSentenceFeedback_result :: AddSentenceFeedback_result -> T.ThriftVal+from_AddSentenceFeedback_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v208 -> (1, ("ex",Services_Types.from_ServicesException _v208))) <$> addSentenceFeedback_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v208 -> (1, ("ex",Services_Types.from_ServicesException _v208))) <$> addSentenceFeedback_result_ex record+ ]+ )+write_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_result -> P.IO ()+write_AddSentenceFeedback_result oprot record = T.writeVal oprot $ from_AddSentenceFeedback_result record+encode_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> AddSentenceFeedback_result -> LBS.ByteString+encode_AddSentenceFeedback_result oprot record = T.serializeVal oprot $ from_AddSentenceFeedback_result record+to_AddSentenceFeedback_result :: T.ThriftVal -> AddSentenceFeedback_result+to_AddSentenceFeedback_result (T.TStruct fields) = AddSentenceFeedback_result{+ addSentenceFeedback_result_ex = P.maybe (P.Nothing) (\(_,_val210) -> P.Just (case _val210 of {T.TStruct _val211 -> (Services_Types.to_ServicesException (T.TStruct _val211)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_AddSentenceFeedback_result _ = P.error "not a struct"+read_AddSentenceFeedback_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddSentenceFeedback_result+read_AddSentenceFeedback_result iprot = to_AddSentenceFeedback_result <$> T.readVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_result)+decode_AddSentenceFeedback_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddSentenceFeedback_result+decode_AddSentenceFeedback_result iprot bs = to_AddSentenceFeedback_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddSentenceFeedback_result) bs+typemap_AddSentenceFeedback_result :: T.TypeMap+typemap_AddSentenceFeedback_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_AddSentenceFeedback_result :: AddSentenceFeedback_result+default_AddSentenceFeedback_result = AddSentenceFeedback_result{+ addSentenceFeedback_result_ex = P.Nothing}+process_startFeedback (seqid, iprot, oprot, handler) = do+ args <- read_StartFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.startFeedback handler (startFeedback_args_results args)+ let res = default_StartFeedback_result+ T.writeMessageBegin oprot ("startFeedback", T.M_REPLY, seqid)+ write_StartFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StartFeedback_result{startFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("startFeedback", T.M_REPLY, seqid)+ write_StartFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("startFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addCommunicationFeedback (seqid, iprot, oprot, handler) = do+ args <- read_AddCommunicationFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.addCommunicationFeedback handler (addCommunicationFeedback_args_searchResultsId args) (addCommunicationFeedback_args_communicationId args) (addCommunicationFeedback_args_feedback args)+ let res = default_AddCommunicationFeedback_result+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_REPLY, seqid)+ write_AddCommunicationFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_AddCommunicationFeedback_result{addCommunicationFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_REPLY, seqid)+ write_AddCommunicationFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("addCommunicationFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_addSentenceFeedback (seqid, iprot, oprot, handler) = do+ args <- read_AddSentenceFeedback_args iprot+ (X.catch+ (X.catch+ (do+ Iface.addSentenceFeedback handler (addSentenceFeedback_args_searchResultsId args) (addSentenceFeedback_args_communicationId args) (addSentenceFeedback_args_sentenceId args) (addSentenceFeedback_args_feedback args)+ let res = default_AddSentenceFeedback_result+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_REPLY, seqid)+ write_AddSentenceFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_AddSentenceFeedback_result{addSentenceFeedback_result_ex = P.Just e}+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_REPLY, seqid)+ write_AddSentenceFeedback_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("addSentenceFeedback", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "startFeedback" -> process_startFeedback (seqid,iprot,oprot,handler)+ "addCommunicationFeedback" -> process_addCommunicationFeedback (seqid,iprot,oprot,handler)+ "addSentenceFeedback" -> process_addSentenceFeedback (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/FeedbackService_Client.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module FeedbackService_Client(startFeedback,addCommunicationFeedback,addSentenceFeedback) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types+import FeedbackService+seqid = R.newIORef 0+startFeedback (ip,op) arg_results = do+ send_startFeedback op arg_results+ recv_startFeedback ip+send_startFeedback op arg_results = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("startFeedback", T.M_CALL, seqn)+ write_StartFeedback_args op (StartFeedback_args{startFeedback_args_results=arg_results})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_startFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StartFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (startFeedback_result_ex res)+ P.return ()+addCommunicationFeedback (ip,op) arg_searchResultsId arg_communicationId arg_feedback = do+ send_addCommunicationFeedback op arg_searchResultsId arg_communicationId arg_feedback+ recv_addCommunicationFeedback ip+send_addCommunicationFeedback op arg_searchResultsId arg_communicationId arg_feedback = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addCommunicationFeedback", T.M_CALL, seqn)+ write_AddCommunicationFeedback_args op (AddCommunicationFeedback_args{addCommunicationFeedback_args_searchResultsId=arg_searchResultsId,addCommunicationFeedback_args_communicationId=arg_communicationId,addCommunicationFeedback_args_feedback=arg_feedback})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addCommunicationFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddCommunicationFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (addCommunicationFeedback_result_ex res)+ P.return ()+addSentenceFeedback (ip,op) arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback = do+ send_addSentenceFeedback op arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback+ recv_addSentenceFeedback ip+send_addSentenceFeedback op arg_searchResultsId arg_communicationId arg_sentenceId arg_feedback = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("addSentenceFeedback", T.M_CALL, seqn)+ write_AddSentenceFeedback_args op (AddSentenceFeedback_args{addSentenceFeedback_args_searchResultsId=arg_searchResultsId,addSentenceFeedback_args_communicationId=arg_communicationId,addSentenceFeedback_args_sentenceId=arg_sentenceId,addSentenceFeedback_args_feedback=arg_feedback})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_addSentenceFeedback ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_AddSentenceFeedback_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (addSentenceFeedback_result_ex res)+ P.return ()
+ src/FeedbackService_Iface.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module FeedbackService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types++import Service_Iface+class Service_Iface a => FeedbackService_Iface a where+ startFeedback :: a -> SearchResult -> P.IO ()+ addCommunicationFeedback :: a -> Uuid_Types.UUID -> LT.Text -> SearchFeedback -> P.IO ()+ addSentenceFeedback :: a -> Uuid_Types.UUID -> LT.Text -> Uuid_Types.UUID -> SearchFeedback -> P.IO ()
+ src/Language_Consts.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Language_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Uuid_Types+++import Language_Types
+ src/Learn_Consts.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Learn_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Communication_Types+++import Learn_Types
+ src/Linking_Consts.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Linking_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+import qualified Metadata_Types+++import Linking_Types
+ src/Metadata_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Metadata_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+import qualified Twitter_Types+import qualified Email_Types+import qualified Nitf_Types+++import Metadata_Types
+ src/Nitf_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Nitf_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Nitf_Types
+ src/ResultsServerService.hs view
@@ -0,0 +1,945 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ResultsServerService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import qualified Service+import Results_Types+import qualified ResultsServerService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data RegisterSearchResult_args = RegisterSearchResult_args { registerSearchResult_args_result :: Search_Types.SearchResult+ , registerSearchResult_args_taskType :: Services_Types.AnnotationTaskType+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable RegisterSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` registerSearchResult_args_result record `H.hashWithSalt` registerSearchResult_args_taskType record +instance QC.Arbitrary RegisterSearchResult_args where + arbitrary = M.liftM RegisterSearchResult_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_RegisterSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_RegisterSearchResult_args{registerSearchResult_args_result = registerSearchResult_args_result obj} then P.Nothing else P.Just $ default_RegisterSearchResult_args{registerSearchResult_args_result = registerSearchResult_args_result obj}+ , if obj == default_RegisterSearchResult_args{registerSearchResult_args_taskType = registerSearchResult_args_taskType obj} then P.Nothing else P.Just $ default_RegisterSearchResult_args{registerSearchResult_args_taskType = registerSearchResult_args_taskType obj}+ ]+from_RegisterSearchResult_args :: RegisterSearchResult_args -> T.ThriftVal+from_RegisterSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("result",Search_Types.from_SearchResult _v2))) $ registerSearchResult_args_result record+ , (\_v2 -> P.Just (2, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v2))) $ registerSearchResult_args_taskType record+ ]+write_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_args -> P.IO ()+write_RegisterSearchResult_args oprot record = T.writeVal oprot $ from_RegisterSearchResult_args record+encode_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_args -> LBS.ByteString+encode_RegisterSearchResult_args oprot record = T.serializeVal oprot $ from_RegisterSearchResult_args record+to_RegisterSearchResult_args :: T.ThriftVal -> RegisterSearchResult_args+to_RegisterSearchResult_args (T.TStruct fields) = RegisterSearchResult_args{+ registerSearchResult_args_result = P.maybe (registerSearchResult_args_result default_RegisterSearchResult_args) (\(_,_val4) -> (case _val4 of {T.TStruct _val5 -> (Search_Types.to_SearchResult (T.TStruct _val5)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ registerSearchResult_args_taskType = P.maybe (registerSearchResult_args_taskType default_RegisterSearchResult_args) (\(_,_val4) -> (case _val4 of {T.TI32 _val6 -> P.toEnum $ P.fromIntegral _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_RegisterSearchResult_args _ = P.error "not a struct"+read_RegisterSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO RegisterSearchResult_args+read_RegisterSearchResult_args iprot = to_RegisterSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_RegisterSearchResult_args)+decode_RegisterSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> RegisterSearchResult_args+decode_RegisterSearchResult_args iprot bs = to_RegisterSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_RegisterSearchResult_args) bs+typemap_RegisterSearchResult_args :: T.TypeMap+typemap_RegisterSearchResult_args = Map.fromList [(1,("result",(T.T_STRUCT Search_Types.typemap_SearchResult))),(2,("taskType",T.T_I32))]+default_RegisterSearchResult_args :: RegisterSearchResult_args+default_RegisterSearchResult_args = RegisterSearchResult_args{+ registerSearchResult_args_result = Search_Types.default_SearchResult,+ registerSearchResult_args_taskType = (P.toEnum 0)}+data RegisterSearchResult_result = RegisterSearchResult_result { registerSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable RegisterSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` registerSearchResult_result_ex record +instance QC.Arbitrary RegisterSearchResult_result where + arbitrary = M.liftM RegisterSearchResult_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_RegisterSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_RegisterSearchResult_result{registerSearchResult_result_ex = registerSearchResult_result_ex obj} then P.Nothing else P.Just $ default_RegisterSearchResult_result{registerSearchResult_result_ex = registerSearchResult_result_ex obj}+ ]+from_RegisterSearchResult_result :: RegisterSearchResult_result -> T.ThriftVal+from_RegisterSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v9 -> (1, ("ex",Services_Types.from_ServicesException _v9))) <$> registerSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v9 -> (1, ("ex",Services_Types.from_ServicesException _v9))) <$> registerSearchResult_result_ex record+ ]+ )+write_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_result -> P.IO ()+write_RegisterSearchResult_result oprot record = T.writeVal oprot $ from_RegisterSearchResult_result record+encode_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> RegisterSearchResult_result -> LBS.ByteString+encode_RegisterSearchResult_result oprot record = T.serializeVal oprot $ from_RegisterSearchResult_result record+to_RegisterSearchResult_result :: T.ThriftVal -> RegisterSearchResult_result+to_RegisterSearchResult_result (T.TStruct fields) = RegisterSearchResult_result{+ registerSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val11) -> P.Just (case _val11 of {T.TStruct _val12 -> (Services_Types.to_ServicesException (T.TStruct _val12)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_RegisterSearchResult_result _ = P.error "not a struct"+read_RegisterSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO RegisterSearchResult_result+read_RegisterSearchResult_result iprot = to_RegisterSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_RegisterSearchResult_result)+decode_RegisterSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> RegisterSearchResult_result+decode_RegisterSearchResult_result iprot bs = to_RegisterSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_RegisterSearchResult_result) bs+typemap_RegisterSearchResult_result :: T.TypeMap+typemap_RegisterSearchResult_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_RegisterSearchResult_result :: RegisterSearchResult_result+default_RegisterSearchResult_result = RegisterSearchResult_result{+ registerSearchResult_result_ex = P.Nothing}+data GetSearchResults_args = GetSearchResults_args { getSearchResults_args_taskType :: Services_Types.AnnotationTaskType+ , getSearchResults_args_limit :: I.Int32+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResults_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResults_args_taskType record `H.hashWithSalt` getSearchResults_args_limit record +instance QC.Arbitrary GetSearchResults_args where + arbitrary = M.liftM GetSearchResults_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_GetSearchResults_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResults_args{getSearchResults_args_taskType = getSearchResults_args_taskType obj} then P.Nothing else P.Just $ default_GetSearchResults_args{getSearchResults_args_taskType = getSearchResults_args_taskType obj}+ , if obj == default_GetSearchResults_args{getSearchResults_args_limit = getSearchResults_args_limit obj} then P.Nothing else P.Just $ default_GetSearchResults_args{getSearchResults_args_limit = getSearchResults_args_limit obj}+ ]+from_GetSearchResults_args :: GetSearchResults_args -> T.ThriftVal+from_GetSearchResults_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v15 -> P.Just (1, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v15))) $ getSearchResults_args_taskType record+ , (\_v15 -> P.Just (2, ("limit",T.TI32 _v15))) $ getSearchResults_args_limit record+ ]+write_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_args -> P.IO ()+write_GetSearchResults_args oprot record = T.writeVal oprot $ from_GetSearchResults_args record+encode_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_args -> LBS.ByteString+encode_GetSearchResults_args oprot record = T.serializeVal oprot $ from_GetSearchResults_args record+to_GetSearchResults_args :: T.ThriftVal -> GetSearchResults_args+to_GetSearchResults_args (T.TStruct fields) = GetSearchResults_args{+ getSearchResults_args_taskType = P.maybe (getSearchResults_args_taskType default_GetSearchResults_args) (\(_,_val17) -> (case _val17 of {T.TI32 _val18 -> P.toEnum $ P.fromIntegral _val18; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ getSearchResults_args_limit = P.maybe (getSearchResults_args_limit default_GetSearchResults_args) (\(_,_val17) -> (case _val17 of {T.TI32 _val19 -> _val19; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_GetSearchResults_args _ = P.error "not a struct"+read_GetSearchResults_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResults_args+read_GetSearchResults_args iprot = to_GetSearchResults_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResults_args)+decode_GetSearchResults_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResults_args+decode_GetSearchResults_args iprot bs = to_GetSearchResults_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResults_args) bs+typemap_GetSearchResults_args :: T.TypeMap+typemap_GetSearchResults_args = Map.fromList [(1,("taskType",T.T_I32)),(2,("limit",T.T_I32))]+default_GetSearchResults_args :: GetSearchResults_args+default_GetSearchResults_args = GetSearchResults_args{+ getSearchResults_args_taskType = (P.toEnum 0),+ getSearchResults_args_limit = 0}+data GetSearchResults_result = GetSearchResults_result { getSearchResults_result_success :: (Vector.Vector Search_Types.SearchResult)+ , getSearchResults_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResults_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResults_result_success record `H.hashWithSalt` getSearchResults_result_ex record +instance QC.Arbitrary GetSearchResults_result where + arbitrary = M.liftM GetSearchResults_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResults_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResults_result{getSearchResults_result_success = getSearchResults_result_success obj} then P.Nothing else P.Just $ default_GetSearchResults_result{getSearchResults_result_success = getSearchResults_result_success obj}+ , if obj == default_GetSearchResults_result{getSearchResults_result_ex = getSearchResults_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResults_result{getSearchResults_result_ex = getSearchResults_result_ex obj}+ ]+from_GetSearchResults_result :: GetSearchResults_result -> T.ThriftVal+from_GetSearchResults_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v22 -> (1, ("ex",Services_Types.from_ServicesException _v22))) <$> getSearchResults_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v22 -> P.Just (0, ("success",T.TList (T.T_STRUCT Search_Types.typemap_SearchResult) $ P.map (\_v24 -> Search_Types.from_SearchResult _v24) $ Vector.toList _v22))) $ getSearchResults_result_success record+ , (\_v22 -> (1, ("ex",Services_Types.from_ServicesException _v22))) <$> getSearchResults_result_ex record+ ]+ )+write_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_result -> P.IO ()+write_GetSearchResults_result oprot record = T.writeVal oprot $ from_GetSearchResults_result record+encode_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResults_result -> LBS.ByteString+encode_GetSearchResults_result oprot record = T.serializeVal oprot $ from_GetSearchResults_result record+to_GetSearchResults_result :: T.ThriftVal -> GetSearchResults_result+to_GetSearchResults_result (T.TStruct fields) = GetSearchResults_result{+ getSearchResults_result_success = P.maybe (getSearchResults_result_success default_GetSearchResults_result) (\(_,_val26) -> (case _val26 of {T.TList _ _val27 -> (Vector.fromList $ P.map (\_v28 -> (case _v28 of {T.TStruct _val29 -> (Search_Types.to_SearchResult (T.TStruct _val29)); _ -> P.error "wrong type"})) _val27); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResults_result_ex = P.maybe (P.Nothing) (\(_,_val26) -> P.Just (case _val26 of {T.TStruct _val30 -> (Services_Types.to_ServicesException (T.TStruct _val30)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResults_result _ = P.error "not a struct"+read_GetSearchResults_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResults_result+read_GetSearchResults_result iprot = to_GetSearchResults_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResults_result)+decode_GetSearchResults_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResults_result+decode_GetSearchResults_result iprot bs = to_GetSearchResults_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResults_result) bs+typemap_GetSearchResults_result :: T.TypeMap+typemap_GetSearchResults_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Search_Types.typemap_SearchResult)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResults_result :: GetSearchResults_result+default_GetSearchResults_result = GetSearchResults_result{+ getSearchResults_result_success = Vector.empty,+ getSearchResults_result_ex = P.Nothing}+data GetSearchResultsByUser_args = GetSearchResultsByUser_args { getSearchResultsByUser_args_taskType :: Services_Types.AnnotationTaskType+ , getSearchResultsByUser_args_userId :: LT.Text+ , getSearchResultsByUser_args_limit :: I.Int32+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResultsByUser_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResultsByUser_args_taskType record `H.hashWithSalt` getSearchResultsByUser_args_userId record `H.hashWithSalt` getSearchResultsByUser_args_limit record +instance QC.Arbitrary GetSearchResultsByUser_args where + arbitrary = M.liftM GetSearchResultsByUser_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_GetSearchResultsByUser_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType = getSearchResultsByUser_args_taskType obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType = getSearchResultsByUser_args_taskType obj}+ , if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_userId = getSearchResultsByUser_args_userId obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_userId = getSearchResultsByUser_args_userId obj}+ , if obj == default_GetSearchResultsByUser_args{getSearchResultsByUser_args_limit = getSearchResultsByUser_args_limit obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_args{getSearchResultsByUser_args_limit = getSearchResultsByUser_args_limit obj}+ ]+from_GetSearchResultsByUser_args :: GetSearchResultsByUser_args -> T.ThriftVal+from_GetSearchResultsByUser_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v33 -> P.Just (1, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v33))) $ getSearchResultsByUser_args_taskType record+ , (\_v33 -> P.Just (2, ("userId",T.TString $ E.encodeUtf8 _v33))) $ getSearchResultsByUser_args_userId record+ , (\_v33 -> P.Just (3, ("limit",T.TI32 _v33))) $ getSearchResultsByUser_args_limit record+ ]+write_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_args -> P.IO ()+write_GetSearchResultsByUser_args oprot record = T.writeVal oprot $ from_GetSearchResultsByUser_args record+encode_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_args -> LBS.ByteString+encode_GetSearchResultsByUser_args oprot record = T.serializeVal oprot $ from_GetSearchResultsByUser_args record+to_GetSearchResultsByUser_args :: T.ThriftVal -> GetSearchResultsByUser_args+to_GetSearchResultsByUser_args (T.TStruct fields) = GetSearchResultsByUser_args{+ getSearchResultsByUser_args_taskType = P.maybe (getSearchResultsByUser_args_taskType default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TI32 _val36 -> P.toEnum $ P.fromIntegral _val36; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ getSearchResultsByUser_args_userId = P.maybe (getSearchResultsByUser_args_userId default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TString _val37 -> E.decodeUtf8 _val37; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ getSearchResultsByUser_args_limit = P.maybe (getSearchResultsByUser_args_limit default_GetSearchResultsByUser_args) (\(_,_val35) -> (case _val35 of {T.TI32 _val38 -> _val38; _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_GetSearchResultsByUser_args _ = P.error "not a struct"+read_GetSearchResultsByUser_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResultsByUser_args+read_GetSearchResultsByUser_args iprot = to_GetSearchResultsByUser_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_args)+decode_GetSearchResultsByUser_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResultsByUser_args+decode_GetSearchResultsByUser_args iprot bs = to_GetSearchResultsByUser_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_args) bs+typemap_GetSearchResultsByUser_args :: T.TypeMap+typemap_GetSearchResultsByUser_args = Map.fromList [(1,("taskType",T.T_I32)),(2,("userId",T.T_STRING)),(3,("limit",T.T_I32))]+default_GetSearchResultsByUser_args :: GetSearchResultsByUser_args+default_GetSearchResultsByUser_args = GetSearchResultsByUser_args{+ getSearchResultsByUser_args_taskType = (P.toEnum 0),+ getSearchResultsByUser_args_userId = "",+ getSearchResultsByUser_args_limit = 0}+data GetSearchResultsByUser_result = GetSearchResultsByUser_result { getSearchResultsByUser_result_success :: (Vector.Vector Search_Types.SearchResult)+ , getSearchResultsByUser_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResultsByUser_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResultsByUser_result_success record `H.hashWithSalt` getSearchResultsByUser_result_ex record +instance QC.Arbitrary GetSearchResultsByUser_result where + arbitrary = M.liftM GetSearchResultsByUser_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResultsByUser_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = getSearchResultsByUser_result_success obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = getSearchResultsByUser_result_success obj}+ , if obj == default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = getSearchResultsByUser_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = getSearchResultsByUser_result_ex obj}+ ]+from_GetSearchResultsByUser_result :: GetSearchResultsByUser_result -> T.ThriftVal+from_GetSearchResultsByUser_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v41 -> (1, ("ex",Services_Types.from_ServicesException _v41))) <$> getSearchResultsByUser_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v41 -> P.Just (0, ("success",T.TList (T.T_STRUCT Search_Types.typemap_SearchResult) $ P.map (\_v43 -> Search_Types.from_SearchResult _v43) $ Vector.toList _v41))) $ getSearchResultsByUser_result_success record+ , (\_v41 -> (1, ("ex",Services_Types.from_ServicesException _v41))) <$> getSearchResultsByUser_result_ex record+ ]+ )+write_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_result -> P.IO ()+write_GetSearchResultsByUser_result oprot record = T.writeVal oprot $ from_GetSearchResultsByUser_result record+encode_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResultsByUser_result -> LBS.ByteString+encode_GetSearchResultsByUser_result oprot record = T.serializeVal oprot $ from_GetSearchResultsByUser_result record+to_GetSearchResultsByUser_result :: T.ThriftVal -> GetSearchResultsByUser_result+to_GetSearchResultsByUser_result (T.TStruct fields) = GetSearchResultsByUser_result{+ getSearchResultsByUser_result_success = P.maybe (getSearchResultsByUser_result_success default_GetSearchResultsByUser_result) (\(_,_val45) -> (case _val45 of {T.TList _ _val46 -> (Vector.fromList $ P.map (\_v47 -> (case _v47 of {T.TStruct _val48 -> (Search_Types.to_SearchResult (T.TStruct _val48)); _ -> P.error "wrong type"})) _val46); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResultsByUser_result_ex = P.maybe (P.Nothing) (\(_,_val45) -> P.Just (case _val45 of {T.TStruct _val49 -> (Services_Types.to_ServicesException (T.TStruct _val49)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResultsByUser_result _ = P.error "not a struct"+read_GetSearchResultsByUser_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResultsByUser_result+read_GetSearchResultsByUser_result iprot = to_GetSearchResultsByUser_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_result)+decode_GetSearchResultsByUser_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResultsByUser_result+decode_GetSearchResultsByUser_result iprot bs = to_GetSearchResultsByUser_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResultsByUser_result) bs+typemap_GetSearchResultsByUser_result :: T.TypeMap+typemap_GetSearchResultsByUser_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Search_Types.typemap_SearchResult)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResultsByUser_result :: GetSearchResultsByUser_result+default_GetSearchResultsByUser_result = GetSearchResultsByUser_result{+ getSearchResultsByUser_result_success = Vector.empty,+ getSearchResultsByUser_result_ex = P.Nothing}+data GetLatestSearchResult_args = GetLatestSearchResult_args { getLatestSearchResult_args_userId :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetLatestSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getLatestSearchResult_args_userId record +instance QC.Arbitrary GetLatestSearchResult_args where + arbitrary = M.liftM GetLatestSearchResult_args (QC.arbitrary)+ shrink obj | obj == default_GetLatestSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetLatestSearchResult_args{getLatestSearchResult_args_userId = getLatestSearchResult_args_userId obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_args{getLatestSearchResult_args_userId = getLatestSearchResult_args_userId obj}+ ]+from_GetLatestSearchResult_args :: GetLatestSearchResult_args -> T.ThriftVal+from_GetLatestSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v52 -> P.Just (1, ("userId",T.TString $ E.encodeUtf8 _v52))) $ getLatestSearchResult_args_userId record+ ]+write_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_args -> P.IO ()+write_GetLatestSearchResult_args oprot record = T.writeVal oprot $ from_GetLatestSearchResult_args record+encode_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_args -> LBS.ByteString+encode_GetLatestSearchResult_args oprot record = T.serializeVal oprot $ from_GetLatestSearchResult_args record+to_GetLatestSearchResult_args :: T.ThriftVal -> GetLatestSearchResult_args+to_GetLatestSearchResult_args (T.TStruct fields) = GetLatestSearchResult_args{+ getLatestSearchResult_args_userId = P.maybe (getLatestSearchResult_args_userId default_GetLatestSearchResult_args) (\(_,_val54) -> (case _val54 of {T.TString _val55 -> E.decodeUtf8 _val55; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetLatestSearchResult_args _ = P.error "not a struct"+read_GetLatestSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetLatestSearchResult_args+read_GetLatestSearchResult_args iprot = to_GetLatestSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_args)+decode_GetLatestSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetLatestSearchResult_args+decode_GetLatestSearchResult_args iprot bs = to_GetLatestSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_args) bs+typemap_GetLatestSearchResult_args :: T.TypeMap+typemap_GetLatestSearchResult_args = Map.fromList [(1,("userId",T.T_STRING))]+default_GetLatestSearchResult_args :: GetLatestSearchResult_args+default_GetLatestSearchResult_args = GetLatestSearchResult_args{+ getLatestSearchResult_args_userId = ""}+data GetLatestSearchResult_result = GetLatestSearchResult_result { getLatestSearchResult_result_success :: Search_Types.SearchResult+ , getLatestSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetLatestSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getLatestSearchResult_result_success record `H.hashWithSalt` getLatestSearchResult_result_ex record +instance QC.Arbitrary GetLatestSearchResult_result where + arbitrary = M.liftM GetLatestSearchResult_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetLatestSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetLatestSearchResult_result{getLatestSearchResult_result_success = getLatestSearchResult_result_success obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_result{getLatestSearchResult_result_success = getLatestSearchResult_result_success obj}+ , if obj == default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = getLatestSearchResult_result_ex obj} then P.Nothing else P.Just $ default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = getLatestSearchResult_result_ex obj}+ ]+from_GetLatestSearchResult_result :: GetLatestSearchResult_result -> T.ThriftVal+from_GetLatestSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v58 -> (1, ("ex",Services_Types.from_ServicesException _v58))) <$> getLatestSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v58 -> P.Just (0, ("success",Search_Types.from_SearchResult _v58))) $ getLatestSearchResult_result_success record+ , (\_v58 -> (1, ("ex",Services_Types.from_ServicesException _v58))) <$> getLatestSearchResult_result_ex record+ ]+ )+write_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_result -> P.IO ()+write_GetLatestSearchResult_result oprot record = T.writeVal oprot $ from_GetLatestSearchResult_result record+encode_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetLatestSearchResult_result -> LBS.ByteString+encode_GetLatestSearchResult_result oprot record = T.serializeVal oprot $ from_GetLatestSearchResult_result record+to_GetLatestSearchResult_result :: T.ThriftVal -> GetLatestSearchResult_result+to_GetLatestSearchResult_result (T.TStruct fields) = GetLatestSearchResult_result{+ getLatestSearchResult_result_success = P.maybe (getLatestSearchResult_result_success default_GetLatestSearchResult_result) (\(_,_val60) -> (case _val60 of {T.TStruct _val61 -> (Search_Types.to_SearchResult (T.TStruct _val61)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getLatestSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val60) -> P.Just (case _val60 of {T.TStruct _val62 -> (Services_Types.to_ServicesException (T.TStruct _val62)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetLatestSearchResult_result _ = P.error "not a struct"+read_GetLatestSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetLatestSearchResult_result+read_GetLatestSearchResult_result iprot = to_GetLatestSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_result)+decode_GetLatestSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetLatestSearchResult_result+decode_GetLatestSearchResult_result iprot bs = to_GetLatestSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetLatestSearchResult_result) bs+typemap_GetLatestSearchResult_result :: T.TypeMap+typemap_GetLatestSearchResult_result = Map.fromList [(0,("success",(T.T_STRUCT Search_Types.typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetLatestSearchResult_result :: GetLatestSearchResult_result+default_GetLatestSearchResult_result = GetLatestSearchResult_result{+ getLatestSearchResult_result_success = Search_Types.default_SearchResult,+ getLatestSearchResult_result_ex = P.Nothing}+data GetSearchResult_args = GetSearchResult_args { getSearchResult_args_searchResultId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResult_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResult_args_searchResultId record +instance QC.Arbitrary GetSearchResult_args where + arbitrary = M.liftM GetSearchResult_args (QC.arbitrary)+ shrink obj | obj == default_GetSearchResult_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResult_args{getSearchResult_args_searchResultId = getSearchResult_args_searchResultId obj} then P.Nothing else P.Just $ default_GetSearchResult_args{getSearchResult_args_searchResultId = getSearchResult_args_searchResultId obj}+ ]+from_GetSearchResult_args :: GetSearchResult_args -> T.ThriftVal+from_GetSearchResult_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v65 -> P.Just (1, ("searchResultId",Uuid_Types.from_UUID _v65))) $ getSearchResult_args_searchResultId record+ ]+write_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_args -> P.IO ()+write_GetSearchResult_args oprot record = T.writeVal oprot $ from_GetSearchResult_args record+encode_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_args -> LBS.ByteString+encode_GetSearchResult_args oprot record = T.serializeVal oprot $ from_GetSearchResult_args record+to_GetSearchResult_args :: T.ThriftVal -> GetSearchResult_args+to_GetSearchResult_args (T.TStruct fields) = GetSearchResult_args{+ getSearchResult_args_searchResultId = P.maybe (getSearchResult_args_searchResultId default_GetSearchResult_args) (\(_,_val67) -> (case _val67 of {T.TStruct _val68 -> (Uuid_Types.to_UUID (T.TStruct _val68)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResult_args _ = P.error "not a struct"+read_GetSearchResult_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResult_args+read_GetSearchResult_args iprot = to_GetSearchResult_args <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResult_args)+decode_GetSearchResult_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResult_args+decode_GetSearchResult_args iprot bs = to_GetSearchResult_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResult_args) bs+typemap_GetSearchResult_args :: T.TypeMap+typemap_GetSearchResult_args = Map.fromList [(1,("searchResultId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_GetSearchResult_args :: GetSearchResult_args+default_GetSearchResult_args = GetSearchResult_args{+ getSearchResult_args_searchResultId = Uuid_Types.default_UUID}+data GetSearchResult_result = GetSearchResult_result { getSearchResult_result_success :: Search_Types.SearchResult+ , getSearchResult_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetSearchResult_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getSearchResult_result_success record `H.hashWithSalt` getSearchResult_result_ex record +instance QC.Arbitrary GetSearchResult_result where + arbitrary = M.liftM GetSearchResult_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetSearchResult_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetSearchResult_result{getSearchResult_result_success = getSearchResult_result_success obj} then P.Nothing else P.Just $ default_GetSearchResult_result{getSearchResult_result_success = getSearchResult_result_success obj}+ , if obj == default_GetSearchResult_result{getSearchResult_result_ex = getSearchResult_result_ex obj} then P.Nothing else P.Just $ default_GetSearchResult_result{getSearchResult_result_ex = getSearchResult_result_ex obj}+ ]+from_GetSearchResult_result :: GetSearchResult_result -> T.ThriftVal+from_GetSearchResult_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v71 -> (1, ("ex",Services_Types.from_ServicesException _v71))) <$> getSearchResult_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v71 -> P.Just (0, ("success",Search_Types.from_SearchResult _v71))) $ getSearchResult_result_success record+ , (\_v71 -> (1, ("ex",Services_Types.from_ServicesException _v71))) <$> getSearchResult_result_ex record+ ]+ )+write_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_result -> P.IO ()+write_GetSearchResult_result oprot record = T.writeVal oprot $ from_GetSearchResult_result record+encode_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> GetSearchResult_result -> LBS.ByteString+encode_GetSearchResult_result oprot record = T.serializeVal oprot $ from_GetSearchResult_result record+to_GetSearchResult_result :: T.ThriftVal -> GetSearchResult_result+to_GetSearchResult_result (T.TStruct fields) = GetSearchResult_result{+ getSearchResult_result_success = P.maybe (getSearchResult_result_success default_GetSearchResult_result) (\(_,_val73) -> (case _val73 of {T.TStruct _val74 -> (Search_Types.to_SearchResult (T.TStruct _val74)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getSearchResult_result_ex = P.maybe (P.Nothing) (\(_,_val73) -> P.Just (case _val73 of {T.TStruct _val75 -> (Services_Types.to_ServicesException (T.TStruct _val75)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetSearchResult_result _ = P.error "not a struct"+read_GetSearchResult_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetSearchResult_result+read_GetSearchResult_result iprot = to_GetSearchResult_result <$> T.readVal iprot (T.T_STRUCT typemap_GetSearchResult_result)+decode_GetSearchResult_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetSearchResult_result+decode_GetSearchResult_result iprot bs = to_GetSearchResult_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetSearchResult_result) bs+typemap_GetSearchResult_result :: T.TypeMap+typemap_GetSearchResult_result = Map.fromList [(0,("success",(T.T_STRUCT Search_Types.typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetSearchResult_result :: GetSearchResult_result+default_GetSearchResult_result = GetSearchResult_result{+ getSearchResult_result_success = Search_Types.default_SearchResult,+ getSearchResult_result_ex = P.Nothing}+data StartSession_args = StartSession_args { startSession_args_searchResultId :: Uuid_Types.UUID+ , startSession_args_taskType :: Services_Types.AnnotationTaskType+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartSession_args where+ hashWithSalt salt record = salt `H.hashWithSalt` startSession_args_searchResultId record `H.hashWithSalt` startSession_args_taskType record +instance QC.Arbitrary StartSession_args where + arbitrary = M.liftM StartSession_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_StartSession_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartSession_args{startSession_args_searchResultId = startSession_args_searchResultId obj} then P.Nothing else P.Just $ default_StartSession_args{startSession_args_searchResultId = startSession_args_searchResultId obj}+ , if obj == default_StartSession_args{startSession_args_taskType = startSession_args_taskType obj} then P.Nothing else P.Just $ default_StartSession_args{startSession_args_taskType = startSession_args_taskType obj}+ ]+from_StartSession_args :: StartSession_args -> T.ThriftVal+from_StartSession_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v78 -> P.Just (1, ("searchResultId",Uuid_Types.from_UUID _v78))) $ startSession_args_searchResultId record+ , (\_v78 -> P.Just (2, ("taskType",T.TI32 $ P.fromIntegral $ P.fromEnum _v78))) $ startSession_args_taskType record+ ]+write_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> StartSession_args -> P.IO ()+write_StartSession_args oprot record = T.writeVal oprot $ from_StartSession_args record+encode_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> StartSession_args -> LBS.ByteString+encode_StartSession_args oprot record = T.serializeVal oprot $ from_StartSession_args record+to_StartSession_args :: T.ThriftVal -> StartSession_args+to_StartSession_args (T.TStruct fields) = StartSession_args{+ startSession_args_searchResultId = P.maybe (startSession_args_searchResultId default_StartSession_args) (\(_,_val80) -> (case _val80 of {T.TStruct _val81 -> (Uuid_Types.to_UUID (T.TStruct _val81)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ startSession_args_taskType = P.maybe (startSession_args_taskType default_StartSession_args) (\(_,_val80) -> (case _val80 of {T.TI32 _val82 -> P.toEnum $ P.fromIntegral _val82; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_StartSession_args _ = P.error "not a struct"+read_StartSession_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StartSession_args+read_StartSession_args iprot = to_StartSession_args <$> T.readVal iprot (T.T_STRUCT typemap_StartSession_args)+decode_StartSession_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartSession_args+decode_StartSession_args iprot bs = to_StartSession_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StartSession_args) bs+typemap_StartSession_args :: T.TypeMap+typemap_StartSession_args = Map.fromList [(1,("searchResultId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("taskType",T.T_I32))]+default_StartSession_args :: StartSession_args+default_StartSession_args = StartSession_args{+ startSession_args_searchResultId = Uuid_Types.default_UUID,+ startSession_args_taskType = (P.toEnum 0)}+data StartSession_result = StartSession_result { startSession_result_success :: Uuid_Types.UUID+ , startSession_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StartSession_result where+ hashWithSalt salt record = salt `H.hashWithSalt` startSession_result_success record `H.hashWithSalt` startSession_result_ex record +instance QC.Arbitrary StartSession_result where + arbitrary = M.liftM StartSession_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StartSession_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StartSession_result{startSession_result_success = startSession_result_success obj} then P.Nothing else P.Just $ default_StartSession_result{startSession_result_success = startSession_result_success obj}+ , if obj == default_StartSession_result{startSession_result_ex = startSession_result_ex obj} then P.Nothing else P.Just $ default_StartSession_result{startSession_result_ex = startSession_result_ex obj}+ ]+from_StartSession_result :: StartSession_result -> T.ThriftVal+from_StartSession_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v85 -> (1, ("ex",Services_Types.from_ServicesException _v85))) <$> startSession_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v85 -> P.Just (0, ("success",Uuid_Types.from_UUID _v85))) $ startSession_result_success record+ , (\_v85 -> (1, ("ex",Services_Types.from_ServicesException _v85))) <$> startSession_result_ex record+ ]+ )+write_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> StartSession_result -> P.IO ()+write_StartSession_result oprot record = T.writeVal oprot $ from_StartSession_result record+encode_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> StartSession_result -> LBS.ByteString+encode_StartSession_result oprot record = T.serializeVal oprot $ from_StartSession_result record+to_StartSession_result :: T.ThriftVal -> StartSession_result+to_StartSession_result (T.TStruct fields) = StartSession_result{+ startSession_result_success = P.maybe (startSession_result_success default_StartSession_result) (\(_,_val87) -> (case _val87 of {T.TStruct _val88 -> (Uuid_Types.to_UUID (T.TStruct _val88)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ startSession_result_ex = P.maybe (P.Nothing) (\(_,_val87) -> P.Just (case _val87 of {T.TStruct _val89 -> (Services_Types.to_ServicesException (T.TStruct _val89)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StartSession_result _ = P.error "not a struct"+read_StartSession_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StartSession_result+read_StartSession_result iprot = to_StartSession_result <$> T.readVal iprot (T.T_STRUCT typemap_StartSession_result)+decode_StartSession_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StartSession_result+decode_StartSession_result iprot bs = to_StartSession_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StartSession_result) bs+typemap_StartSession_result :: T.TypeMap+typemap_StartSession_result = Map.fromList [(0,("success",(T.T_STRUCT Uuid_Types.typemap_UUID))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StartSession_result :: StartSession_result+default_StartSession_result = StartSession_result{+ startSession_result_success = Uuid_Types.default_UUID,+ startSession_result_ex = P.Nothing}+data StopSession_args = StopSession_args { stopSession_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StopSession_args where+ hashWithSalt salt record = salt `H.hashWithSalt` stopSession_args_sessionId record +instance QC.Arbitrary StopSession_args where + arbitrary = M.liftM StopSession_args (QC.arbitrary)+ shrink obj | obj == default_StopSession_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StopSession_args{stopSession_args_sessionId = stopSession_args_sessionId obj} then P.Nothing else P.Just $ default_StopSession_args{stopSession_args_sessionId = stopSession_args_sessionId obj}+ ]+from_StopSession_args :: StopSession_args -> T.ThriftVal+from_StopSession_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v92 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v92))) $ stopSession_args_sessionId record+ ]+write_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> StopSession_args -> P.IO ()+write_StopSession_args oprot record = T.writeVal oprot $ from_StopSession_args record+encode_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> StopSession_args -> LBS.ByteString+encode_StopSession_args oprot record = T.serializeVal oprot $ from_StopSession_args record+to_StopSession_args :: T.ThriftVal -> StopSession_args+to_StopSession_args (T.TStruct fields) = StopSession_args{+ stopSession_args_sessionId = P.maybe (stopSession_args_sessionId default_StopSession_args) (\(_,_val94) -> (case _val94 of {T.TStruct _val95 -> (Uuid_Types.to_UUID (T.TStruct _val95)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StopSession_args _ = P.error "not a struct"+read_StopSession_args :: (T.Transport t, T.Protocol p) => p t -> P.IO StopSession_args+read_StopSession_args iprot = to_StopSession_args <$> T.readVal iprot (T.T_STRUCT typemap_StopSession_args)+decode_StopSession_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StopSession_args+decode_StopSession_args iprot bs = to_StopSession_args $ T.deserializeVal iprot (T.T_STRUCT typemap_StopSession_args) bs+typemap_StopSession_args :: T.TypeMap+typemap_StopSession_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_StopSession_args :: StopSession_args+default_StopSession_args = StopSession_args{+ stopSession_args_sessionId = Uuid_Types.default_UUID}+data StopSession_result = StopSession_result { stopSession_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable StopSession_result where+ hashWithSalt salt record = salt `H.hashWithSalt` stopSession_result_ex record +instance QC.Arbitrary StopSession_result where + arbitrary = M.liftM StopSession_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_StopSession_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_StopSession_result{stopSession_result_ex = stopSession_result_ex obj} then P.Nothing else P.Just $ default_StopSession_result{stopSession_result_ex = stopSession_result_ex obj}+ ]+from_StopSession_result :: StopSession_result -> T.ThriftVal+from_StopSession_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> stopSession_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v98 -> (1, ("ex",Services_Types.from_ServicesException _v98))) <$> stopSession_result_ex record+ ]+ )+write_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> StopSession_result -> P.IO ()+write_StopSession_result oprot record = T.writeVal oprot $ from_StopSession_result record+encode_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> StopSession_result -> LBS.ByteString+encode_StopSession_result oprot record = T.serializeVal oprot $ from_StopSession_result record+to_StopSession_result :: T.ThriftVal -> StopSession_result+to_StopSession_result (T.TStruct fields) = StopSession_result{+ stopSession_result_ex = P.maybe (P.Nothing) (\(_,_val100) -> P.Just (case _val100 of {T.TStruct _val101 -> (Services_Types.to_ServicesException (T.TStruct _val101)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_StopSession_result _ = P.error "not a struct"+read_StopSession_result :: (T.Transport t, T.Protocol p) => p t -> P.IO StopSession_result+read_StopSession_result iprot = to_StopSession_result <$> T.readVal iprot (T.T_STRUCT typemap_StopSession_result)+decode_StopSession_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> StopSession_result+decode_StopSession_result iprot bs = to_StopSession_result $ T.deserializeVal iprot (T.T_STRUCT typemap_StopSession_result) bs+typemap_StopSession_result :: T.TypeMap+typemap_StopSession_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_StopSession_result :: StopSession_result+default_StopSession_result = StopSession_result{+ stopSession_result_ex = P.Nothing}+data GetNextChunk_args = GetNextChunk_args { getNextChunk_args_sessionId :: Uuid_Types.UUID+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetNextChunk_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getNextChunk_args_sessionId record +instance QC.Arbitrary GetNextChunk_args where + arbitrary = M.liftM GetNextChunk_args (QC.arbitrary)+ shrink obj | obj == default_GetNextChunk_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetNextChunk_args{getNextChunk_args_sessionId = getNextChunk_args_sessionId obj} then P.Nothing else P.Just $ default_GetNextChunk_args{getNextChunk_args_sessionId = getNextChunk_args_sessionId obj}+ ]+from_GetNextChunk_args :: GetNextChunk_args -> T.ThriftVal+from_GetNextChunk_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v104 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v104))) $ getNextChunk_args_sessionId record+ ]+write_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_args -> P.IO ()+write_GetNextChunk_args oprot record = T.writeVal oprot $ from_GetNextChunk_args record+encode_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_args -> LBS.ByteString+encode_GetNextChunk_args oprot record = T.serializeVal oprot $ from_GetNextChunk_args record+to_GetNextChunk_args :: T.ThriftVal -> GetNextChunk_args+to_GetNextChunk_args (T.TStruct fields) = GetNextChunk_args{+ getNextChunk_args_sessionId = P.maybe (getNextChunk_args_sessionId default_GetNextChunk_args) (\(_,_val106) -> (case _val106 of {T.TStruct _val107 -> (Uuid_Types.to_UUID (T.TStruct _val107)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetNextChunk_args _ = P.error "not a struct"+read_GetNextChunk_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetNextChunk_args+read_GetNextChunk_args iprot = to_GetNextChunk_args <$> T.readVal iprot (T.T_STRUCT typemap_GetNextChunk_args)+decode_GetNextChunk_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetNextChunk_args+decode_GetNextChunk_args iprot bs = to_GetNextChunk_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetNextChunk_args) bs+typemap_GetNextChunk_args :: T.TypeMap+typemap_GetNextChunk_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]+default_GetNextChunk_args :: GetNextChunk_args+default_GetNextChunk_args = GetNextChunk_args{+ getNextChunk_args_sessionId = Uuid_Types.default_UUID}+data GetNextChunk_result = GetNextChunk_result { getNextChunk_result_success :: (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ , getNextChunk_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetNextChunk_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getNextChunk_result_success record `H.hashWithSalt` getNextChunk_result_ex record +instance QC.Arbitrary GetNextChunk_result where + arbitrary = M.liftM GetNextChunk_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetNextChunk_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetNextChunk_result{getNextChunk_result_success = getNextChunk_result_success obj} then P.Nothing else P.Just $ default_GetNextChunk_result{getNextChunk_result_success = getNextChunk_result_success obj}+ , if obj == default_GetNextChunk_result{getNextChunk_result_ex = getNextChunk_result_ex obj} then P.Nothing else P.Just $ default_GetNextChunk_result{getNextChunk_result_ex = getNextChunk_result_ex obj}+ ]+from_GetNextChunk_result :: GetNextChunk_result -> T.ThriftVal+from_GetNextChunk_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v110 -> (1, ("ex",Services_Types.from_ServicesException _v110))) <$> getNextChunk_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v110 -> P.Just (0, ("success",T.TList (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier) $ P.map (\_v112 -> Services_Types.from_AnnotationUnitIdentifier _v112) $ Vector.toList _v110))) $ getNextChunk_result_success record+ , (\_v110 -> (1, ("ex",Services_Types.from_ServicesException _v110))) <$> getNextChunk_result_ex record+ ]+ )+write_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_result -> P.IO ()+write_GetNextChunk_result oprot record = T.writeVal oprot $ from_GetNextChunk_result record+encode_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> GetNextChunk_result -> LBS.ByteString+encode_GetNextChunk_result oprot record = T.serializeVal oprot $ from_GetNextChunk_result record+to_GetNextChunk_result :: T.ThriftVal -> GetNextChunk_result+to_GetNextChunk_result (T.TStruct fields) = GetNextChunk_result{+ getNextChunk_result_success = P.maybe (getNextChunk_result_success default_GetNextChunk_result) (\(_,_val114) -> (case _val114 of {T.TList _ _val115 -> (Vector.fromList $ P.map (\_v116 -> (case _v116 of {T.TStruct _val117 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val117)); _ -> P.error "wrong type"})) _val115); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getNextChunk_result_ex = P.maybe (P.Nothing) (\(_,_val114) -> P.Just (case _val114 of {T.TStruct _val118 -> (Services_Types.to_ServicesException (T.TStruct _val118)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetNextChunk_result _ = P.error "not a struct"+read_GetNextChunk_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetNextChunk_result+read_GetNextChunk_result iprot = to_GetNextChunk_result <$> T.readVal iprot (T.T_STRUCT typemap_GetNextChunk_result)+decode_GetNextChunk_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetNextChunk_result+decode_GetNextChunk_result iprot bs = to_GetNextChunk_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetNextChunk_result) bs+typemap_GetNextChunk_result :: T.TypeMap+typemap_GetNextChunk_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetNextChunk_result :: GetNextChunk_result+default_GetNextChunk_result = GetNextChunk_result{+ getNextChunk_result_success = Vector.empty,+ getNextChunk_result_ex = P.Nothing}+data SubmitAnnotation_args = SubmitAnnotation_args { submitAnnotation_args_sessionId :: Uuid_Types.UUID+ , submitAnnotation_args_unitId :: Services_Types.AnnotationUnitIdentifier+ , submitAnnotation_args_communication :: Communication_Types.Communication+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitAnnotation_args where+ hashWithSalt salt record = salt `H.hashWithSalt` submitAnnotation_args_sessionId record `H.hashWithSalt` submitAnnotation_args_unitId record `H.hashWithSalt` submitAnnotation_args_communication record +instance QC.Arbitrary SubmitAnnotation_args where + arbitrary = M.liftM SubmitAnnotation_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SubmitAnnotation_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitAnnotation_args{submitAnnotation_args_sessionId = submitAnnotation_args_sessionId obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_sessionId = submitAnnotation_args_sessionId obj}+ , if obj == default_SubmitAnnotation_args{submitAnnotation_args_unitId = submitAnnotation_args_unitId obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_unitId = submitAnnotation_args_unitId obj}+ , if obj == default_SubmitAnnotation_args{submitAnnotation_args_communication = submitAnnotation_args_communication obj} then P.Nothing else P.Just $ default_SubmitAnnotation_args{submitAnnotation_args_communication = submitAnnotation_args_communication obj}+ ]+from_SubmitAnnotation_args :: SubmitAnnotation_args -> T.ThriftVal+from_SubmitAnnotation_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v121 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v121))) $ submitAnnotation_args_sessionId record+ , (\_v121 -> P.Just (2, ("unitId",Services_Types.from_AnnotationUnitIdentifier _v121))) $ submitAnnotation_args_unitId record+ , (\_v121 -> P.Just (3, ("communication",Communication_Types.from_Communication _v121))) $ submitAnnotation_args_communication record+ ]+write_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_args -> P.IO ()+write_SubmitAnnotation_args oprot record = T.writeVal oprot $ from_SubmitAnnotation_args record+encode_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_args -> LBS.ByteString+encode_SubmitAnnotation_args oprot record = T.serializeVal oprot $ from_SubmitAnnotation_args record+to_SubmitAnnotation_args :: T.ThriftVal -> SubmitAnnotation_args+to_SubmitAnnotation_args (T.TStruct fields) = SubmitAnnotation_args{+ submitAnnotation_args_sessionId = P.maybe (submitAnnotation_args_sessionId default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val124 -> (Uuid_Types.to_UUID (T.TStruct _val124)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ submitAnnotation_args_unitId = P.maybe (submitAnnotation_args_unitId default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val125 -> (Services_Types.to_AnnotationUnitIdentifier (T.TStruct _val125)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ submitAnnotation_args_communication = P.maybe (submitAnnotation_args_communication default_SubmitAnnotation_args) (\(_,_val123) -> (case _val123 of {T.TStruct _val126 -> (Communication_Types.to_Communication (T.TStruct _val126)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_SubmitAnnotation_args _ = P.error "not a struct"+read_SubmitAnnotation_args :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitAnnotation_args+read_SubmitAnnotation_args iprot = to_SubmitAnnotation_args <$> T.readVal iprot (T.T_STRUCT typemap_SubmitAnnotation_args)+decode_SubmitAnnotation_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitAnnotation_args+decode_SubmitAnnotation_args iprot bs = to_SubmitAnnotation_args $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitAnnotation_args) bs+typemap_SubmitAnnotation_args :: T.TypeMap+typemap_SubmitAnnotation_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("unitId",(T.T_STRUCT Services_Types.typemap_AnnotationUnitIdentifier))),(3,("communication",(T.T_STRUCT Communication_Types.typemap_Communication)))]+default_SubmitAnnotation_args :: SubmitAnnotation_args+default_SubmitAnnotation_args = SubmitAnnotation_args{+ submitAnnotation_args_sessionId = Uuid_Types.default_UUID,+ submitAnnotation_args_unitId = Services_Types.default_AnnotationUnitIdentifier,+ submitAnnotation_args_communication = Communication_Types.default_Communication}+data SubmitAnnotation_result = SubmitAnnotation_result { submitAnnotation_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SubmitAnnotation_result where+ hashWithSalt salt record = salt `H.hashWithSalt` submitAnnotation_result_ex record +instance QC.Arbitrary SubmitAnnotation_result where + arbitrary = M.liftM SubmitAnnotation_result (M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_SubmitAnnotation_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SubmitAnnotation_result{submitAnnotation_result_ex = submitAnnotation_result_ex obj} then P.Nothing else P.Just $ default_SubmitAnnotation_result{submitAnnotation_result_ex = submitAnnotation_result_ex obj}+ ]+from_SubmitAnnotation_result :: SubmitAnnotation_result -> T.ThriftVal+from_SubmitAnnotation_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v129 -> (1, ("ex",Services_Types.from_ServicesException _v129))) <$> submitAnnotation_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v129 -> (1, ("ex",Services_Types.from_ServicesException _v129))) <$> submitAnnotation_result_ex record+ ]+ )+write_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_result -> P.IO ()+write_SubmitAnnotation_result oprot record = T.writeVal oprot $ from_SubmitAnnotation_result record+encode_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> SubmitAnnotation_result -> LBS.ByteString+encode_SubmitAnnotation_result oprot record = T.serializeVal oprot $ from_SubmitAnnotation_result record+to_SubmitAnnotation_result :: T.ThriftVal -> SubmitAnnotation_result+to_SubmitAnnotation_result (T.TStruct fields) = SubmitAnnotation_result{+ submitAnnotation_result_ex = P.maybe (P.Nothing) (\(_,_val131) -> P.Just (case _val131 of {T.TStruct _val132 -> (Services_Types.to_ServicesException (T.TStruct _val132)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_SubmitAnnotation_result _ = P.error "not a struct"+read_SubmitAnnotation_result :: (T.Transport t, T.Protocol p) => p t -> P.IO SubmitAnnotation_result+read_SubmitAnnotation_result iprot = to_SubmitAnnotation_result <$> T.readVal iprot (T.T_STRUCT typemap_SubmitAnnotation_result)+decode_SubmitAnnotation_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SubmitAnnotation_result+decode_SubmitAnnotation_result iprot bs = to_SubmitAnnotation_result $ T.deserializeVal iprot (T.T_STRUCT typemap_SubmitAnnotation_result) bs+typemap_SubmitAnnotation_result :: T.TypeMap+typemap_SubmitAnnotation_result = Map.fromList [(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_SubmitAnnotation_result :: SubmitAnnotation_result+default_SubmitAnnotation_result = SubmitAnnotation_result{+ submitAnnotation_result_ex = P.Nothing}+process_registerSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_RegisterSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ Iface.registerSearchResult handler (registerSearchResult_args_result args) (registerSearchResult_args_taskType args)+ let res = default_RegisterSearchResult_result+ T.writeMessageBegin oprot ("registerSearchResult", T.M_REPLY, seqid)+ write_RegisterSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_RegisterSearchResult_result{registerSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("registerSearchResult", T.M_REPLY, seqid)+ write_RegisterSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("registerSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResults (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResults_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResults handler (getSearchResults_args_taskType args) (getSearchResults_args_limit args)+ let res = default_GetSearchResults_result{getSearchResults_result_success = val}+ T.writeMessageBegin oprot ("getSearchResults", T.M_REPLY, seqid)+ write_GetSearchResults_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResults_result{getSearchResults_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResults", T.M_REPLY, seqid)+ write_GetSearchResults_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResults", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResultsByUser (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResultsByUser_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResultsByUser handler (getSearchResultsByUser_args_taskType args) (getSearchResultsByUser_args_userId args) (getSearchResultsByUser_args_limit args)+ let res = default_GetSearchResultsByUser_result{getSearchResultsByUser_result_success = val}+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_REPLY, seqid)+ write_GetSearchResultsByUser_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResultsByUser_result{getSearchResultsByUser_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_REPLY, seqid)+ write_GetSearchResultsByUser_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResultsByUser", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getLatestSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_GetLatestSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getLatestSearchResult handler (getLatestSearchResult_args_userId args)+ let res = default_GetLatestSearchResult_result{getLatestSearchResult_result_success = val}+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_REPLY, seqid)+ write_GetLatestSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetLatestSearchResult_result{getLatestSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_REPLY, seqid)+ write_GetLatestSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getLatestSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getSearchResult (seqid, iprot, oprot, handler) = do+ args <- read_GetSearchResult_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getSearchResult handler (getSearchResult_args_searchResultId args)+ let res = default_GetSearchResult_result{getSearchResult_result_success = val}+ T.writeMessageBegin oprot ("getSearchResult", T.M_REPLY, seqid)+ write_GetSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetSearchResult_result{getSearchResult_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getSearchResult", T.M_REPLY, seqid)+ write_GetSearchResult_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getSearchResult", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_startSession (seqid, iprot, oprot, handler) = do+ args <- read_StartSession_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.startSession handler (startSession_args_searchResultId args) (startSession_args_taskType args)+ let res = default_StartSession_result{startSession_result_success = val}+ T.writeMessageBegin oprot ("startSession", T.M_REPLY, seqid)+ write_StartSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StartSession_result{startSession_result_ex = P.Just e}+ T.writeMessageBegin oprot ("startSession", T.M_REPLY, seqid)+ write_StartSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("startSession", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_stopSession (seqid, iprot, oprot, handler) = do+ args <- read_StopSession_args iprot+ (X.catch+ (X.catch+ (do+ Iface.stopSession handler (stopSession_args_sessionId args)+ let res = default_StopSession_result+ T.writeMessageBegin oprot ("stopSession", T.M_REPLY, seqid)+ write_StopSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_StopSession_result{stopSession_result_ex = P.Just e}+ T.writeMessageBegin oprot ("stopSession", T.M_REPLY, seqid)+ write_StopSession_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("stopSession", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getNextChunk (seqid, iprot, oprot, handler) = do+ args <- read_GetNextChunk_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getNextChunk handler (getNextChunk_args_sessionId args)+ let res = default_GetNextChunk_result{getNextChunk_result_success = val}+ T.writeMessageBegin oprot ("getNextChunk", T.M_REPLY, seqid)+ write_GetNextChunk_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetNextChunk_result{getNextChunk_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getNextChunk", T.M_REPLY, seqid)+ write_GetNextChunk_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getNextChunk", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_submitAnnotation (seqid, iprot, oprot, handler) = do+ args <- read_SubmitAnnotation_args iprot+ (X.catch+ (X.catch+ (do+ Iface.submitAnnotation handler (submitAnnotation_args_sessionId args) (submitAnnotation_args_unitId args) (submitAnnotation_args_communication args)+ let res = default_SubmitAnnotation_result+ T.writeMessageBegin oprot ("submitAnnotation", T.M_REPLY, seqid)+ write_SubmitAnnotation_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_SubmitAnnotation_result{submitAnnotation_result_ex = P.Just e}+ T.writeMessageBegin oprot ("submitAnnotation", T.M_REPLY, seqid)+ write_SubmitAnnotation_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("submitAnnotation", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "registerSearchResult" -> process_registerSearchResult (seqid,iprot,oprot,handler)+ "getSearchResults" -> process_getSearchResults (seqid,iprot,oprot,handler)+ "getSearchResultsByUser" -> process_getSearchResultsByUser (seqid,iprot,oprot,handler)+ "getLatestSearchResult" -> process_getLatestSearchResult (seqid,iprot,oprot,handler)+ "getSearchResult" -> process_getSearchResult (seqid,iprot,oprot,handler)+ "startSession" -> process_startSession (seqid,iprot,oprot,handler)+ "stopSession" -> process_stopSession (seqid,iprot,oprot,handler)+ "getNextChunk" -> process_getNextChunk (seqid,iprot,oprot,handler)+ "submitAnnotation" -> process_submitAnnotation (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/ResultsServerService_Client.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ResultsServerService_Client(registerSearchResult,getSearchResults,getSearchResultsByUser,getLatestSearchResult,getSearchResult,startSession,stopSession,getNextChunk,submitAnnotation) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import Results_Types+import ResultsServerService+seqid = R.newIORef 0+registerSearchResult (ip,op) arg_result arg_taskType = do+ send_registerSearchResult op arg_result arg_taskType+ recv_registerSearchResult ip+send_registerSearchResult op arg_result arg_taskType = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("registerSearchResult", T.M_CALL, seqn)+ write_RegisterSearchResult_args op (RegisterSearchResult_args{registerSearchResult_args_result=arg_result,registerSearchResult_args_taskType=arg_taskType})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_registerSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_RegisterSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (registerSearchResult_result_ex res)+ P.return ()+getSearchResults (ip,op) arg_taskType arg_limit = do+ send_getSearchResults op arg_taskType arg_limit+ recv_getSearchResults ip+send_getSearchResults op arg_taskType arg_limit = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResults", T.M_CALL, seqn)+ write_GetSearchResults_args op (GetSearchResults_args{getSearchResults_args_taskType=arg_taskType,getSearchResults_args_limit=arg_limit})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResults ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResults_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResults_result_ex res)+ P.return $ getSearchResults_result_success res+getSearchResultsByUser (ip,op) arg_taskType arg_userId arg_limit = do+ send_getSearchResultsByUser op arg_taskType arg_userId arg_limit+ recv_getSearchResultsByUser ip+send_getSearchResultsByUser op arg_taskType arg_userId arg_limit = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResultsByUser", T.M_CALL, seqn)+ write_GetSearchResultsByUser_args op (GetSearchResultsByUser_args{getSearchResultsByUser_args_taskType=arg_taskType,getSearchResultsByUser_args_userId=arg_userId,getSearchResultsByUser_args_limit=arg_limit})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResultsByUser ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResultsByUser_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResultsByUser_result_ex res)+ P.return $ getSearchResultsByUser_result_success res+getLatestSearchResult (ip,op) arg_userId = do+ send_getLatestSearchResult op arg_userId+ recv_getLatestSearchResult ip+send_getLatestSearchResult op arg_userId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getLatestSearchResult", T.M_CALL, seqn)+ write_GetLatestSearchResult_args op (GetLatestSearchResult_args{getLatestSearchResult_args_userId=arg_userId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getLatestSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetLatestSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getLatestSearchResult_result_ex res)+ P.return $ getLatestSearchResult_result_success res+getSearchResult (ip,op) arg_searchResultId = do+ send_getSearchResult op arg_searchResultId+ recv_getSearchResult ip+send_getSearchResult op arg_searchResultId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getSearchResult", T.M_CALL, seqn)+ write_GetSearchResult_args op (GetSearchResult_args{getSearchResult_args_searchResultId=arg_searchResultId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getSearchResult ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetSearchResult_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getSearchResult_result_ex res)+ P.return $ getSearchResult_result_success res+startSession (ip,op) arg_searchResultId arg_taskType = do+ send_startSession op arg_searchResultId arg_taskType+ recv_startSession ip+send_startSession op arg_searchResultId arg_taskType = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("startSession", T.M_CALL, seqn)+ write_StartSession_args op (StartSession_args{startSession_args_searchResultId=arg_searchResultId,startSession_args_taskType=arg_taskType})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_startSession ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StartSession_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (startSession_result_ex res)+ P.return $ startSession_result_success res+stopSession (ip,op) arg_sessionId = do+ send_stopSession op arg_sessionId+ recv_stopSession ip+send_stopSession op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("stopSession", T.M_CALL, seqn)+ write_StopSession_args op (StopSession_args{stopSession_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_stopSession ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_StopSession_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (stopSession_result_ex res)+ P.return ()+getNextChunk (ip,op) arg_sessionId = do+ send_getNextChunk op arg_sessionId+ recv_getNextChunk ip+send_getNextChunk op arg_sessionId = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getNextChunk", T.M_CALL, seqn)+ write_GetNextChunk_args op (GetNextChunk_args{getNextChunk_args_sessionId=arg_sessionId})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getNextChunk ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetNextChunk_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getNextChunk_result_ex res)+ P.return $ getNextChunk_result_success res+submitAnnotation (ip,op) arg_sessionId arg_unitId arg_communication = do+ send_submitAnnotation op arg_sessionId arg_unitId arg_communication+ recv_submitAnnotation ip+send_submitAnnotation op arg_sessionId arg_unitId arg_communication = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("submitAnnotation", T.M_CALL, seqn)+ write_SubmitAnnotation_args op (SubmitAnnotation_args{submitAnnotation_args_sessionId=arg_sessionId,submitAnnotation_args_unitId=arg_unitId,submitAnnotation_args_communication=arg_communication})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_submitAnnotation ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_SubmitAnnotation_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (submitAnnotation_result_ex res)+ P.return ()
+ src/ResultsServerService_Iface.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module ResultsServerService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import Results_Types++import Service_Iface+class Service_Iface a => ResultsServerService_Iface a where+ registerSearchResult :: a -> Search_Types.SearchResult -> Services_Types.AnnotationTaskType -> P.IO ()+ getSearchResults :: a -> Services_Types.AnnotationTaskType -> I.Int32 -> P.IO (Vector.Vector Search_Types.SearchResult)+ getSearchResultsByUser :: a -> Services_Types.AnnotationTaskType -> LT.Text -> I.Int32 -> P.IO (Vector.Vector Search_Types.SearchResult)+ getLatestSearchResult :: a -> LT.Text -> P.IO Search_Types.SearchResult+ getSearchResult :: a -> Uuid_Types.UUID -> P.IO Search_Types.SearchResult+ startSession :: a -> Uuid_Types.UUID -> Services_Types.AnnotationTaskType -> P.IO Uuid_Types.UUID+ stopSession :: a -> Uuid_Types.UUID -> P.IO ()+ getNextChunk :: a -> Uuid_Types.UUID -> P.IO (Vector.Vector Services_Types.AnnotationUnitIdentifier)+ submitAnnotation :: a -> Uuid_Types.UUID -> Services_Types.AnnotationUnitIdentifier -> Communication_Types.Communication -> P.IO ()
+ src/Results_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Results_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Services_Types+import qualified Uuid_Types+import qualified Search_Types+import qualified Communication_Types+++import Results_Types
+ src/SearchProxyService.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SearchProxyService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import qualified Service+import Search_Types+import qualified SearchProxyService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Search_args = Search_args { search_args_query :: SearchQuery+ , search_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_args where+ hashWithSalt salt record = salt `H.hashWithSalt` search_args_query record `H.hashWithSalt` search_args_provider record +instance QC.Arbitrary Search_args where + arbitrary = M.liftM Search_args (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Search_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_args{search_args_query = search_args_query obj} then P.Nothing else P.Just $ default_Search_args{search_args_query = search_args_query obj}+ , if obj == default_Search_args{search_args_provider = search_args_provider obj} then P.Nothing else P.Just $ default_Search_args{search_args_provider = search_args_provider obj}+ ]+from_Search_args :: Search_args -> T.ThriftVal+from_Search_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v109 -> P.Just (1, ("query",from_SearchQuery _v109))) $ search_args_query record+ , (\_v109 -> P.Just (2, ("provider",T.TString $ E.encodeUtf8 _v109))) $ search_args_provider record+ ]+write_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> P.IO ()+write_Search_args oprot record = T.writeVal oprot $ from_Search_args record+encode_Search_args :: (T.Protocol p, T.Transport t) => p t -> Search_args -> LBS.ByteString+encode_Search_args oprot record = T.serializeVal oprot $ from_Search_args record+to_Search_args :: T.ThriftVal -> Search_args+to_Search_args (T.TStruct fields) = Search_args{+ search_args_query = P.maybe (search_args_query default_Search_args) (\(_,_val111) -> (case _val111 of {T.TStruct _val112 -> (to_SearchQuery (T.TStruct _val112)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ search_args_provider = P.maybe (search_args_provider default_Search_args) (\(_,_val111) -> (case _val111 of {T.TString _val113 -> E.decodeUtf8 _val113; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Search_args _ = P.error "not a struct"+read_Search_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_args+read_Search_args iprot = to_Search_args <$> T.readVal iprot (T.T_STRUCT typemap_Search_args)+decode_Search_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_args+decode_Search_args iprot bs = to_Search_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_args) bs+typemap_Search_args :: T.TypeMap+typemap_Search_args = Map.fromList [(1,("query",(T.T_STRUCT typemap_SearchQuery))),(2,("provider",T.T_STRING))]+default_Search_args :: Search_args+default_Search_args = Search_args{+ search_args_query = default_SearchQuery,+ search_args_provider = ""}+data Search_result = Search_result { search_result_success :: SearchResult+ , search_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Search_result where+ hashWithSalt salt record = salt `H.hashWithSalt` search_result_success record `H.hashWithSalt` search_result_ex record +instance QC.Arbitrary Search_result where + arbitrary = M.liftM Search_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Search_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Search_result{search_result_success = search_result_success obj} then P.Nothing else P.Just $ default_Search_result{search_result_success = search_result_success obj}+ , if obj == default_Search_result{search_result_ex = search_result_ex obj} then P.Nothing else P.Just $ default_Search_result{search_result_ex = search_result_ex obj}+ ]+from_Search_result :: Search_result -> T.ThriftVal+from_Search_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v116 -> (1, ("ex",Services_Types.from_ServicesException _v116))) <$> search_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v116 -> P.Just (0, ("success",from_SearchResult _v116))) $ search_result_success record+ , (\_v116 -> (1, ("ex",Services_Types.from_ServicesException _v116))) <$> search_result_ex record+ ]+ )+write_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> P.IO ()+write_Search_result oprot record = T.writeVal oprot $ from_Search_result record+encode_Search_result :: (T.Protocol p, T.Transport t) => p t -> Search_result -> LBS.ByteString+encode_Search_result oprot record = T.serializeVal oprot $ from_Search_result record+to_Search_result :: T.ThriftVal -> Search_result+to_Search_result (T.TStruct fields) = Search_result{+ search_result_success = P.maybe (search_result_success default_Search_result) (\(_,_val118) -> (case _val118 of {T.TStruct _val119 -> (to_SearchResult (T.TStruct _val119)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ search_result_ex = P.maybe (P.Nothing) (\(_,_val118) -> P.Just (case _val118 of {T.TStruct _val120 -> (Services_Types.to_ServicesException (T.TStruct _val120)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Search_result _ = P.error "not a struct"+read_Search_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Search_result+read_Search_result iprot = to_Search_result <$> T.readVal iprot (T.T_STRUCT typemap_Search_result)+decode_Search_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Search_result+decode_Search_result iprot bs = to_Search_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Search_result) bs+typemap_Search_result :: T.TypeMap+typemap_Search_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_SearchResult))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Search_result :: Search_result+default_Search_result = Search_result{+ search_result_success = default_SearchResult,+ search_result_ex = P.Nothing}+data GetProviders_args = GetProviders_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetProviders_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetProviders_args where + arbitrary = QC.elements [GetProviders_args]+from_GetProviders_args :: GetProviders_args -> T.ThriftVal+from_GetProviders_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> GetProviders_args -> P.IO ()+write_GetProviders_args oprot record = T.writeVal oprot $ from_GetProviders_args record+encode_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> GetProviders_args -> LBS.ByteString+encode_GetProviders_args oprot record = T.serializeVal oprot $ from_GetProviders_args record+to_GetProviders_args :: T.ThriftVal -> GetProviders_args+to_GetProviders_args (T.TStruct fields) = GetProviders_args{++ }+to_GetProviders_args _ = P.error "not a struct"+read_GetProviders_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetProviders_args+read_GetProviders_args iprot = to_GetProviders_args <$> T.readVal iprot (T.T_STRUCT typemap_GetProviders_args)+decode_GetProviders_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetProviders_args+decode_GetProviders_args iprot bs = to_GetProviders_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetProviders_args) bs+typemap_GetProviders_args :: T.TypeMap+typemap_GetProviders_args = Map.fromList []+default_GetProviders_args :: GetProviders_args+default_GetProviders_args = GetProviders_args{+}+data GetProviders_result = GetProviders_result { getProviders_result_success :: (Vector.Vector LT.Text)+ , getProviders_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetProviders_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getProviders_result_success record `H.hashWithSalt` getProviders_result_ex record +instance QC.Arbitrary GetProviders_result where + arbitrary = M.liftM GetProviders_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetProviders_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetProviders_result{getProviders_result_success = getProviders_result_success obj} then P.Nothing else P.Just $ default_GetProviders_result{getProviders_result_success = getProviders_result_success obj}+ , if obj == default_GetProviders_result{getProviders_result_ex = getProviders_result_ex obj} then P.Nothing else P.Just $ default_GetProviders_result{getProviders_result_ex = getProviders_result_ex obj}+ ]+from_GetProviders_result :: GetProviders_result -> T.ThriftVal+from_GetProviders_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v128 -> (1, ("ex",Services_Types.from_ServicesException _v128))) <$> getProviders_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v128 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v130 -> T.TString $ E.encodeUtf8 _v130) $ Vector.toList _v128))) $ getProviders_result_success record+ , (\_v128 -> (1, ("ex",Services_Types.from_ServicesException _v128))) <$> getProviders_result_ex record+ ]+ )+write_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> GetProviders_result -> P.IO ()+write_GetProviders_result oprot record = T.writeVal oprot $ from_GetProviders_result record+encode_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> GetProviders_result -> LBS.ByteString+encode_GetProviders_result oprot record = T.serializeVal oprot $ from_GetProviders_result record+to_GetProviders_result :: T.ThriftVal -> GetProviders_result+to_GetProviders_result (T.TStruct fields) = GetProviders_result{+ getProviders_result_success = P.maybe (getProviders_result_success default_GetProviders_result) (\(_,_val132) -> (case _val132 of {T.TList _ _val133 -> (Vector.fromList $ P.map (\_v134 -> (case _v134 of {T.TString _val135 -> E.decodeUtf8 _val135; _ -> P.error "wrong type"})) _val133); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getProviders_result_ex = P.maybe (P.Nothing) (\(_,_val132) -> P.Just (case _val132 of {T.TStruct _val136 -> (Services_Types.to_ServicesException (T.TStruct _val136)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetProviders_result _ = P.error "not a struct"+read_GetProviders_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetProviders_result+read_GetProviders_result iprot = to_GetProviders_result <$> T.readVal iprot (T.T_STRUCT typemap_GetProviders_result)+decode_GetProviders_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetProviders_result+decode_GetProviders_result iprot bs = to_GetProviders_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetProviders_result) bs+typemap_GetProviders_result :: T.TypeMap+typemap_GetProviders_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetProviders_result :: GetProviders_result+default_GetProviders_result = GetProviders_result{+ getProviders_result_success = Vector.empty,+ getProviders_result_ex = P.Nothing}+data GetCapabilities_args = GetCapabilities_args { getCapabilities_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_args_provider record +instance QC.Arbitrary GetCapabilities_args where + arbitrary = M.liftM GetCapabilities_args (QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_args{getCapabilities_args_provider = getCapabilities_args_provider obj} then P.Nothing else P.Just $ default_GetCapabilities_args{getCapabilities_args_provider = getCapabilities_args_provider obj}+ ]+from_GetCapabilities_args :: GetCapabilities_args -> T.ThriftVal+from_GetCapabilities_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v139 -> P.Just (1, ("provider",T.TString $ E.encodeUtf8 _v139))) $ getCapabilities_args_provider record+ ]+write_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> P.IO ()+write_GetCapabilities_args oprot record = T.writeVal oprot $ from_GetCapabilities_args record+encode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> LBS.ByteString+encode_GetCapabilities_args oprot record = T.serializeVal oprot $ from_GetCapabilities_args record+to_GetCapabilities_args :: T.ThriftVal -> GetCapabilities_args+to_GetCapabilities_args (T.TStruct fields) = GetCapabilities_args{+ getCapabilities_args_provider = P.maybe (getCapabilities_args_provider default_GetCapabilities_args) (\(_,_val141) -> (case _val141 of {T.TString _val142 -> E.decodeUtf8 _val142; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_args _ = P.error "not a struct"+read_GetCapabilities_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_args+read_GetCapabilities_args iprot = to_GetCapabilities_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_args)+decode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_args+decode_GetCapabilities_args iprot bs = to_GetCapabilities_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_args) bs+typemap_GetCapabilities_args :: T.TypeMap+typemap_GetCapabilities_args = Map.fromList [(1,("provider",T.T_STRING))]+default_GetCapabilities_args :: GetCapabilities_args+default_GetCapabilities_args = GetCapabilities_args{+ getCapabilities_args_provider = ""}+data GetCapabilities_result = GetCapabilities_result { getCapabilities_result_success :: (Vector.Vector SearchCapability)+ , getCapabilities_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_result_success record `H.hashWithSalt` getCapabilities_result_ex record +instance QC.Arbitrary GetCapabilities_result where + arbitrary = M.liftM GetCapabilities_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj}+ , if obj == default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj}+ ]+from_GetCapabilities_result :: GetCapabilities_result -> T.ThriftVal+from_GetCapabilities_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v145 -> (1, ("ex",Services_Types.from_ServicesException _v145))) <$> getCapabilities_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v145 -> P.Just (0, ("success",T.TList (T.T_STRUCT typemap_SearchCapability) $ P.map (\_v147 -> from_SearchCapability _v147) $ Vector.toList _v145))) $ getCapabilities_result_success record+ , (\_v145 -> (1, ("ex",Services_Types.from_ServicesException _v145))) <$> getCapabilities_result_ex record+ ]+ )+write_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> P.IO ()+write_GetCapabilities_result oprot record = T.writeVal oprot $ from_GetCapabilities_result record+encode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> LBS.ByteString+encode_GetCapabilities_result oprot record = T.serializeVal oprot $ from_GetCapabilities_result record+to_GetCapabilities_result :: T.ThriftVal -> GetCapabilities_result+to_GetCapabilities_result (T.TStruct fields) = GetCapabilities_result{+ getCapabilities_result_success = P.maybe (getCapabilities_result_success default_GetCapabilities_result) (\(_,_val149) -> (case _val149 of {T.TList _ _val150 -> (Vector.fromList $ P.map (\_v151 -> (case _v151 of {T.TStruct _val152 -> (to_SearchCapability (T.TStruct _val152)); _ -> P.error "wrong type"})) _val150); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCapabilities_result_ex = P.maybe (P.Nothing) (\(_,_val149) -> P.Just (case _val149 of {T.TStruct _val153 -> (Services_Types.to_ServicesException (T.TStruct _val153)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_result _ = P.error "not a struct"+read_GetCapabilities_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_result+read_GetCapabilities_result iprot = to_GetCapabilities_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_result)+decode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_result+decode_GetCapabilities_result iprot bs = to_GetCapabilities_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_result) bs+typemap_GetCapabilities_result :: T.TypeMap+typemap_GetCapabilities_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT typemap_SearchCapability)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCapabilities_result :: GetCapabilities_result+default_GetCapabilities_result = GetCapabilities_result{+ getCapabilities_result_success = Vector.empty,+ getCapabilities_result_ex = P.Nothing}+data GetCorpora_args = GetCorpora_args { getCorpora_args_provider :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_args where+ hashWithSalt salt record = salt `H.hashWithSalt` getCorpora_args_provider record +instance QC.Arbitrary GetCorpora_args where + arbitrary = M.liftM GetCorpora_args (QC.arbitrary)+ shrink obj | obj == default_GetCorpora_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCorpora_args{getCorpora_args_provider = getCorpora_args_provider obj} then P.Nothing else P.Just $ default_GetCorpora_args{getCorpora_args_provider = getCorpora_args_provider obj}+ ]+from_GetCorpora_args :: GetCorpora_args -> T.ThriftVal+from_GetCorpora_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v156 -> P.Just (1, ("provider",T.TString $ E.encodeUtf8 _v156))) $ getCorpora_args_provider record+ ]+write_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> P.IO ()+write_GetCorpora_args oprot record = T.writeVal oprot $ from_GetCorpora_args record+encode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_args -> LBS.ByteString+encode_GetCorpora_args oprot record = T.serializeVal oprot $ from_GetCorpora_args record+to_GetCorpora_args :: T.ThriftVal -> GetCorpora_args+to_GetCorpora_args (T.TStruct fields) = GetCorpora_args{+ getCorpora_args_provider = P.maybe (getCorpora_args_provider default_GetCorpora_args) (\(_,_val158) -> (case _val158 of {T.TString _val159 -> E.decodeUtf8 _val159; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCorpora_args _ = P.error "not a struct"+read_GetCorpora_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_args+read_GetCorpora_args iprot = to_GetCorpora_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_args)+decode_GetCorpora_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_args+decode_GetCorpora_args iprot bs = to_GetCorpora_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_args) bs+typemap_GetCorpora_args :: T.TypeMap+typemap_GetCorpora_args = Map.fromList [(1,("provider",T.T_STRING))]+default_GetCorpora_args :: GetCorpora_args+default_GetCorpora_args = GetCorpora_args{+ getCorpora_args_provider = ""}+data GetCorpora_result = GetCorpora_result { getCorpora_result_success :: (Vector.Vector LT.Text)+ , getCorpora_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCorpora_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCorpora_result_success record `H.hashWithSalt` getCorpora_result_ex record +instance QC.Arbitrary GetCorpora_result where + arbitrary = M.liftM GetCorpora_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCorpora_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_success = getCorpora_result_success obj}+ , if obj == default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj} then P.Nothing else P.Just $ default_GetCorpora_result{getCorpora_result_ex = getCorpora_result_ex obj}+ ]+from_GetCorpora_result :: GetCorpora_result -> T.ThriftVal+from_GetCorpora_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v162 -> (1, ("ex",Services_Types.from_ServicesException _v162))) <$> getCorpora_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v162 -> P.Just (0, ("success",T.TList T.T_STRING $ P.map (\_v164 -> T.TString $ E.encodeUtf8 _v164) $ Vector.toList _v162))) $ getCorpora_result_success record+ , (\_v162 -> (1, ("ex",Services_Types.from_ServicesException _v162))) <$> getCorpora_result_ex record+ ]+ )+write_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> P.IO ()+write_GetCorpora_result oprot record = T.writeVal oprot $ from_GetCorpora_result record+encode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> GetCorpora_result -> LBS.ByteString+encode_GetCorpora_result oprot record = T.serializeVal oprot $ from_GetCorpora_result record+to_GetCorpora_result :: T.ThriftVal -> GetCorpora_result+to_GetCorpora_result (T.TStruct fields) = GetCorpora_result{+ getCorpora_result_success = P.maybe (getCorpora_result_success default_GetCorpora_result) (\(_,_val166) -> (case _val166 of {T.TList _ _val167 -> (Vector.fromList $ P.map (\_v168 -> (case _v168 of {T.TString _val169 -> E.decodeUtf8 _val169; _ -> P.error "wrong type"})) _val167); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCorpora_result_ex = P.maybe (P.Nothing) (\(_,_val166) -> P.Just (case _val166 of {T.TStruct _val170 -> (Services_Types.to_ServicesException (T.TStruct _val170)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCorpora_result _ = P.error "not a struct"+read_GetCorpora_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCorpora_result+read_GetCorpora_result iprot = to_GetCorpora_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCorpora_result)+decode_GetCorpora_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCorpora_result+decode_GetCorpora_result iprot bs = to_GetCorpora_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCorpora_result) bs+typemap_GetCorpora_result :: T.TypeMap+typemap_GetCorpora_result = Map.fromList [(0,("success",(T.T_LIST T.T_STRING))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCorpora_result :: GetCorpora_result+default_GetCorpora_result = GetCorpora_result{+ getCorpora_result_success = Vector.empty,+ getCorpora_result_ex = P.Nothing}+process_search (seqid, iprot, oprot, handler) = do+ args <- read_Search_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.search handler (search_args_query args) (search_args_provider args)+ let res = default_Search_result{search_result_success = val}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Search_result{search_result_ex = P.Just e}+ T.writeMessageBegin oprot ("search", T.M_REPLY, seqid)+ write_Search_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("search", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getProviders (seqid, iprot, oprot, handler) = do+ args <- read_GetProviders_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getProviders handler+ let res = default_GetProviders_result{getProviders_result_success = val}+ T.writeMessageBegin oprot ("getProviders", T.M_REPLY, seqid)+ write_GetProviders_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetProviders_result{getProviders_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getProviders", T.M_REPLY, seqid)+ write_GetProviders_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getProviders", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCapabilities (seqid, iprot, oprot, handler) = do+ args <- read_GetCapabilities_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCapabilities handler (getCapabilities_args_provider args)+ let res = default_GetCapabilities_result{getCapabilities_result_success = val}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCapabilities_result{getCapabilities_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCapabilities", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCorpora (seqid, iprot, oprot, handler) = do+ args <- read_GetCorpora_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCorpora handler (getCorpora_args_provider args)+ let res = default_GetCorpora_result{getCorpora_result_success = val}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCorpora_result{getCorpora_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCorpora", T.M_REPLY, seqid)+ write_GetCorpora_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCorpora", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "search" -> process_search (seqid,iprot,oprot,handler)+ "getProviders" -> process_getProviders (seqid,iprot,oprot,handler)+ "getCapabilities" -> process_getCapabilities (seqid,iprot,oprot,handler)+ "getCorpora" -> process_getCorpora (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/SearchProxyService_Client.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SearchProxyService_Client(search,getProviders,getCapabilities,getCorpora) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types+import SearchProxyService+seqid = R.newIORef 0+search (ip,op) arg_query arg_provider = do+ send_search op arg_query arg_provider+ recv_search ip+send_search op arg_query arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("search", T.M_CALL, seqn)+ write_Search_args op (Search_args{search_args_query=arg_query,search_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_search ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Search_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (search_result_ex res)+ P.return $ search_result_success res+getProviders (ip,op) = do+ send_getProviders op+ recv_getProviders ip+send_getProviders op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getProviders", T.M_CALL, seqn)+ write_GetProviders_args op (GetProviders_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getProviders ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetProviders_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getProviders_result_ex res)+ P.return $ getProviders_result_success res+getCapabilities (ip,op) arg_provider = do+ send_getCapabilities op arg_provider+ recv_getCapabilities ip+send_getCapabilities op arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCapabilities", T.M_CALL, seqn)+ write_GetCapabilities_args op (GetCapabilities_args{getCapabilities_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCapabilities ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCapabilities_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCapabilities_result_ex res)+ P.return $ getCapabilities_result_success res+getCorpora (ip,op) arg_provider = do+ send_getCorpora op arg_provider+ recv_getCorpora ip+send_getCorpora op arg_provider = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCorpora", T.M_CALL, seqn)+ write_GetCorpora_args op (GetCorpora_args{getCorpora_args_provider=arg_provider})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCorpora ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCorpora_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCorpora_result_ex res)+ P.return $ getCorpora_result_success res
+ src/SearchProxyService_Iface.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SearchProxyService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types++import Service_Iface+class Service_Iface a => SearchProxyService_Iface a where+ search :: a -> SearchQuery -> LT.Text -> P.IO SearchResult+ getProviders :: a -> P.IO (Vector.Vector LT.Text)+ getCapabilities :: a -> LT.Text -> P.IO (Vector.Vector SearchCapability)+ getCorpora :: a -> LT.Text -> P.IO (Vector.Vector LT.Text)
+ src/Search_Consts.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Search_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+import qualified Metadata_Types+import qualified Entities_Types+++import Search_Types
+ src/Services_Consts.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Services_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Uuid_Types+++import Services_Types
+ src/Situations_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Situations_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Structure_Types+import qualified Metadata_Types+import qualified Uuid_Types+import qualified Linking_Types+++import Situations_Types
+ src/Spans_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Spans_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Spans_Types
+ src/Structure_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Structure_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Metadata_Types+import qualified Spans_Types+import qualified Uuid_Types+import qualified Language_Types+++import Structure_Types
+ src/SummarizationService.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SummarizationService where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import qualified Service+import Summarization_Types+import qualified SummarizationService_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data Summarize_args = Summarize_args { summarize_args_query :: SummarizationRequest+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Summarize_args where+ hashWithSalt salt record = salt `H.hashWithSalt` summarize_args_query record +instance QC.Arbitrary Summarize_args where + arbitrary = M.liftM Summarize_args (QC.arbitrary)+ shrink obj | obj == default_Summarize_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Summarize_args{summarize_args_query = summarize_args_query obj} then P.Nothing else P.Just $ default_Summarize_args{summarize_args_query = summarize_args_query obj}+ ]+from_Summarize_args :: Summarize_args -> T.ThriftVal+from_Summarize_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v48 -> P.Just (1, ("query",from_SummarizationRequest _v48))) $ summarize_args_query record+ ]+write_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> Summarize_args -> P.IO ()+write_Summarize_args oprot record = T.writeVal oprot $ from_Summarize_args record+encode_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> Summarize_args -> LBS.ByteString+encode_Summarize_args oprot record = T.serializeVal oprot $ from_Summarize_args record+to_Summarize_args :: T.ThriftVal -> Summarize_args+to_Summarize_args (T.TStruct fields) = Summarize_args{+ summarize_args_query = P.maybe (summarize_args_query default_Summarize_args) (\(_,_val50) -> (case _val50 of {T.TStruct _val51 -> (to_SummarizationRequest (T.TStruct _val51)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Summarize_args _ = P.error "not a struct"+read_Summarize_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Summarize_args+read_Summarize_args iprot = to_Summarize_args <$> T.readVal iprot (T.T_STRUCT typemap_Summarize_args)+decode_Summarize_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Summarize_args+decode_Summarize_args iprot bs = to_Summarize_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Summarize_args) bs+typemap_Summarize_args :: T.TypeMap+typemap_Summarize_args = Map.fromList [(1,("query",(T.T_STRUCT typemap_SummarizationRequest)))]+default_Summarize_args :: Summarize_args+default_Summarize_args = Summarize_args{+ summarize_args_query = default_SummarizationRequest}+data Summarize_result = Summarize_result { summarize_result_success :: Summary+ , summarize_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Summarize_result where+ hashWithSalt salt record = salt `H.hashWithSalt` summarize_result_success record `H.hashWithSalt` summarize_result_ex record +instance QC.Arbitrary Summarize_result where + arbitrary = M.liftM Summarize_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Summarize_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Summarize_result{summarize_result_success = summarize_result_success obj} then P.Nothing else P.Just $ default_Summarize_result{summarize_result_success = summarize_result_success obj}+ , if obj == default_Summarize_result{summarize_result_ex = summarize_result_ex obj} then P.Nothing else P.Just $ default_Summarize_result{summarize_result_ex = summarize_result_ex obj}+ ]+from_Summarize_result :: Summarize_result -> T.ThriftVal+from_Summarize_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v54 -> (1, ("ex",Services_Types.from_ServicesException _v54))) <$> summarize_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v54 -> P.Just (0, ("success",from_Summary _v54))) $ summarize_result_success record+ , (\_v54 -> (1, ("ex",Services_Types.from_ServicesException _v54))) <$> summarize_result_ex record+ ]+ )+write_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> Summarize_result -> P.IO ()+write_Summarize_result oprot record = T.writeVal oprot $ from_Summarize_result record+encode_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> Summarize_result -> LBS.ByteString+encode_Summarize_result oprot record = T.serializeVal oprot $ from_Summarize_result record+to_Summarize_result :: T.ThriftVal -> Summarize_result+to_Summarize_result (T.TStruct fields) = Summarize_result{+ summarize_result_success = P.maybe (summarize_result_success default_Summarize_result) (\(_,_val56) -> (case _val56 of {T.TStruct _val57 -> (to_Summary (T.TStruct _val57)); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ summarize_result_ex = P.maybe (P.Nothing) (\(_,_val56) -> P.Just (case _val56 of {T.TStruct _val58 -> (Services_Types.to_ServicesException (T.TStruct _val58)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Summarize_result _ = P.error "not a struct"+read_Summarize_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Summarize_result+read_Summarize_result iprot = to_Summarize_result <$> T.readVal iprot (T.T_STRUCT typemap_Summarize_result)+decode_Summarize_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Summarize_result+decode_Summarize_result iprot bs = to_Summarize_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Summarize_result) bs+typemap_Summarize_result :: T.TypeMap+typemap_Summarize_result = Map.fromList [(0,("success",(T.T_STRUCT typemap_Summary))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_Summarize_result :: Summarize_result+default_Summarize_result = Summarize_result{+ summarize_result_success = default_Summary,+ summarize_result_ex = P.Nothing}+data GetCapabilities_args = GetCapabilities_args deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_args where+ hashWithSalt salt record = salt +instance QC.Arbitrary GetCapabilities_args where + arbitrary = QC.elements [GetCapabilities_args]+from_GetCapabilities_args :: GetCapabilities_args -> T.ThriftVal+from_GetCapabilities_args record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> P.IO ()+write_GetCapabilities_args oprot record = T.writeVal oprot $ from_GetCapabilities_args record+encode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_args -> LBS.ByteString+encode_GetCapabilities_args oprot record = T.serializeVal oprot $ from_GetCapabilities_args record+to_GetCapabilities_args :: T.ThriftVal -> GetCapabilities_args+to_GetCapabilities_args (T.TStruct fields) = GetCapabilities_args{++ }+to_GetCapabilities_args _ = P.error "not a struct"+read_GetCapabilities_args :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_args+read_GetCapabilities_args iprot = to_GetCapabilities_args <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_args)+decode_GetCapabilities_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_args+decode_GetCapabilities_args iprot bs = to_GetCapabilities_args $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_args) bs+typemap_GetCapabilities_args :: T.TypeMap+typemap_GetCapabilities_args = Map.fromList []+default_GetCapabilities_args :: GetCapabilities_args+default_GetCapabilities_args = GetCapabilities_args{+}+data GetCapabilities_result = GetCapabilities_result { getCapabilities_result_success :: (Vector.Vector SummarizationCapability)+ , getCapabilities_result_ex :: P.Maybe Services_Types.ServicesException+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable GetCapabilities_result where+ hashWithSalt salt record = salt `H.hashWithSalt` getCapabilities_result_success record `H.hashWithSalt` getCapabilities_result_ex record +instance QC.Arbitrary GetCapabilities_result where + arbitrary = M.liftM GetCapabilities_result (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_GetCapabilities_result = []+ | P.otherwise = M.catMaybes+ [ if obj == default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_success = getCapabilities_result_success obj}+ , if obj == default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj} then P.Nothing else P.Just $ default_GetCapabilities_result{getCapabilities_result_ex = getCapabilities_result_ex obj}+ ]+from_GetCapabilities_result :: GetCapabilities_result -> T.ThriftVal+from_GetCapabilities_result record = T.TStruct $ Map.fromList + (let exns = M.catMaybes [ (\_v66 -> (1, ("ex",Services_Types.from_ServicesException _v66))) <$> getCapabilities_result_ex record]+ in if P.not (P.null exns) then exns else M.catMaybes+ [ (\_v66 -> P.Just (0, ("success",T.TList (T.T_STRUCT typemap_SummarizationCapability) $ P.map (\_v68 -> from_SummarizationCapability _v68) $ Vector.toList _v66))) $ getCapabilities_result_success record+ , (\_v66 -> (1, ("ex",Services_Types.from_ServicesException _v66))) <$> getCapabilities_result_ex record+ ]+ )+write_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> P.IO ()+write_GetCapabilities_result oprot record = T.writeVal oprot $ from_GetCapabilities_result record+encode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> GetCapabilities_result -> LBS.ByteString+encode_GetCapabilities_result oprot record = T.serializeVal oprot $ from_GetCapabilities_result record+to_GetCapabilities_result :: T.ThriftVal -> GetCapabilities_result+to_GetCapabilities_result (T.TStruct fields) = GetCapabilities_result{+ getCapabilities_result_success = P.maybe (getCapabilities_result_success default_GetCapabilities_result) (\(_,_val70) -> (case _val70 of {T.TList _ _val71 -> (Vector.fromList $ P.map (\_v72 -> (case _v72 of {T.TStruct _val73 -> (to_SummarizationCapability (T.TStruct _val73)); _ -> P.error "wrong type"})) _val71); _ -> P.error "wrong type"})) (Map.lookup (0) fields),+ getCapabilities_result_ex = P.maybe (P.Nothing) (\(_,_val70) -> P.Just (case _val70 of {T.TStruct _val74 -> (Services_Types.to_ServicesException (T.TStruct _val74)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_GetCapabilities_result _ = P.error "not a struct"+read_GetCapabilities_result :: (T.Transport t, T.Protocol p) => p t -> P.IO GetCapabilities_result+read_GetCapabilities_result iprot = to_GetCapabilities_result <$> T.readVal iprot (T.T_STRUCT typemap_GetCapabilities_result)+decode_GetCapabilities_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> GetCapabilities_result+decode_GetCapabilities_result iprot bs = to_GetCapabilities_result $ T.deserializeVal iprot (T.T_STRUCT typemap_GetCapabilities_result) bs+typemap_GetCapabilities_result :: T.TypeMap+typemap_GetCapabilities_result = Map.fromList [(0,("success",(T.T_LIST (T.T_STRUCT typemap_SummarizationCapability)))),(1,("ex",(T.T_STRUCT Services_Types.typemap_ServicesException)))]+default_GetCapabilities_result :: GetCapabilities_result+default_GetCapabilities_result = GetCapabilities_result{+ getCapabilities_result_success = Vector.empty,+ getCapabilities_result_ex = P.Nothing}+process_summarize (seqid, iprot, oprot, handler) = do+ args <- read_Summarize_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.summarize handler (summarize_args_query args)+ let res = default_Summarize_result{summarize_result_success = val}+ T.writeMessageBegin oprot ("summarize", T.M_REPLY, seqid)+ write_Summarize_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_Summarize_result{summarize_result_ex = P.Just e}+ T.writeMessageBegin oprot ("summarize", T.M_REPLY, seqid)+ write_Summarize_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("summarize", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+process_getCapabilities (seqid, iprot, oprot, handler) = do+ args <- read_GetCapabilities_args iprot+ (X.catch+ (X.catch+ (do+ val <- Iface.getCapabilities handler+ let res = default_GetCapabilities_result{getCapabilities_result_success = val}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot))+ (\e -> do+ let res = default_GetCapabilities_result{getCapabilities_result_ex = P.Just e}+ T.writeMessageBegin oprot ("getCapabilities", T.M_REPLY, seqid)+ write_GetCapabilities_result oprot res+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)))+ ((\_ -> do+ T.writeMessageBegin oprot ("getCapabilities", T.M_EXCEPTION, seqid)+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")+ T.writeMessageEnd oprot+ T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "summarize" -> process_summarize (seqid,iprot,oprot,handler)+ "getCapabilities" -> process_getCapabilities (seqid,iprot,oprot,handler)+ _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)+process handler (iprot, oprot) = do+ (name, typ, seqid) <- T.readMessageBegin iprot+ proc_ handler (iprot,oprot) (name,typ,seqid)+ T.readMessageEnd iprot+ P.return P.True
+ src/SummarizationService_Client.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SummarizationService_Client(summarize,getCapabilities) where+import Service_Client+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import Summarization_Types+import SummarizationService+seqid = R.newIORef 0+summarize (ip,op) arg_query = do+ send_summarize op arg_query+ recv_summarize ip+send_summarize op arg_query = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("summarize", T.M_CALL, seqn)+ write_Summarize_args op (Summarize_args{summarize_args_query=arg_query})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_summarize ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_Summarize_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (summarize_result_ex res)+ P.return $ summarize_result_success res+getCapabilities (ip,op) = do+ send_getCapabilities op+ recv_getCapabilities ip+send_getCapabilities op = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessageBegin op ("getCapabilities", T.M_CALL, seqn)+ write_GetCapabilities_args op (GetCapabilities_args{})+ T.writeMessageEnd op+ T.tFlush (T.getTransport op)+recv_getCapabilities ip = do+ (fname, mtype, rseqid) <- T.readMessageBegin ip+ M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }+ res <- read_GetCapabilities_result ip+ T.readMessageEnd ip+ P.maybe (P.return ()) X.throw (getCapabilities_result_ex res)+ P.return $ getCapabilities_result_success res
+ src/SummarizationService_Iface.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module SummarizationService_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import Summarization_Types++import Service_Iface+class Service_Iface a => SummarizationService_Iface a where+ summarize :: a -> SummarizationRequest -> P.IO Summary+ getCapabilities :: a -> P.IO (Vector.Vector SummarizationCapability)
+ src/Summarization_Consts.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Summarization_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Communication_Types+import qualified Services_Types+import qualified Structure_Types+import qualified Uuid_Types+++import Summarization_Types
+ src/Twitter_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Twitter_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Twitter_Types
+ src/Uuid_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.10.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Uuid_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Uuid_Types
+ tests/UnitTests.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BS+import Data.Map (toList, (!), keys)+import Data.Monoid ((<>))+import Data.List (intercalate)+import Control.Monad (void, join, liftM)+import Data.Text.Lazy (Text, unpack, take)+import Data.Text.Lazy.Encoding (decodeUtf8)+import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn)+import System.FilePath (takeExtension)+import qualified Codec.Compression.GZip as GZip+import Data.Concrete.Utils (writeCommunication, showCommunication)+import Data.Concrete.Parsers.Types (CommunicationParser)+import Data.Concrete.Parsers (communicationParsers, ingest)+import Data.Concrete (Communication(..))+import Text.Printf (printf)++testFormat :: (String, (desc, CommunicationParser (), [String], String)) -> IO ()+testFormat (f, (d, p, c, i)) = do+ let fname = printf "tests/data/example.%s.gz" f :: String+ ih <- (liftM GZip.decompress . BS.readFile) fname+ putStrLn fname+ ingest (\x -> putStrLn $ unpack $ showCommunication x) p (decodeUtf8 ih) c i "concrete-haskell unit test data"+ --["catchphrase", "name", "age", "relatives.0.name", "favorites.friend.name"] "test_id_${name}_${}" "test_comm" + return ()++main = putStrLn "\nTesting parsers:" >> (sequence $ map testFormat (communicationParsers))
utils/IngestCommunications.hs view
@@ -1,98 +1,64 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}+ module Main (main) where +import qualified Network as Net import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS-import Data.Map (toList, (!), keys)+import Data.Map (Map, toList, (!), keys)+import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.List (intercalate) import Control.Monad (void, join, liftM) import Data.Text.Lazy (Text, unpack, take) import Data.Text.Lazy.Encoding (decodeUtf8)-import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn)+import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn, hClose) import System.FilePath (takeExtension) import qualified Codec.Compression.GZip as GZip-import Data.Concrete.Utils (writeCommunication)+import Data.Concrete.Utils (writeCommunication, sendCommunication, connectToService)+import Data.Concrete (default_Communication)+import qualified Data.Concrete.Utils as CU import Data.Concrete.Parsers.Types (CommunicationParser) import Data.Concrete.Parsers (communicationParsers, ingest)-import Options.Applicative ( Parser(..)- , option- , auto- , short- , long- , metavar- , strOption- , help- , execParser- , info- , helper- , fullDesc- , progDesc- , many- , switch- , optional- )+import qualified Data.Concrete.Services.StoreCommunicationService_Client as StoreService+import qualified Data.Concrete.Services.Service_Client as Service+import Options.Generic -data Parameters = Parameters { inputFile :: Maybe String- , outputFile :: Maybe String- , commType :: String- , commId :: String- , contentSectionTypes :: [String]- , format :: String- } deriving (Show)+data Parameters w = Parameters { inputFile :: w ::: Maybe String <?> "Input file, possibly compressed (.bz2 or .gz)"+ , commType :: w ::: String <?> "Value for the 'type' field of each Communication"+ , commId :: w ::: String <?> "Template for the 'id' field of each Communication"+ , contentSectionTypes :: w ::: [String] <?> "Section types that should count as 'content' rather than 'metadata'"+ , format :: w ::: String <?> "Input format: (JSON, CSV, PTB)"+ , outputFile :: w ::: Maybe String <?> "An output file (.txt, .gz, .bz2, .tgz, .tbz2, .zip)"+ , host :: w ::: Maybe String <?> "Host name for a StoreCommunicationService"+ , port :: w ::: Maybe Int <?> "Port for a StoreCommunicationService"+ } deriving (Generic) -parameters :: Parser Parameters-parameters = Parameters- <$> (optional $ strOption (short 'i'- <> long "input"- <> metavar "INPUT_FILE"- <> help "Text file of JSON objects"- )- )- <*> (optional $ strOption (short 'o'- <> long "output"- <> metavar "OUTPUT_FILE"- <> help "Where to write the Concrete Communications"- )- )- <*> strOption (short 't'- <> long "commType"- <> metavar "COMMUNICATION_TYPE"- <> help "String describing the type of Communication(s)"- )- <*> strOption (short 'I'- <> long "commId"- <> metavar "COMMUNICATION_ID"- <> help "String describing the Communication ID"- )- <*> many (strOption (short 's'- <> long "contentSectionTypes"- <> metavar "CONTENT_SECTION_TYPES"- <> help "The names of sections to be considered \"content\" rather than \"metadata\""- ))- <*> strOption (short 'f'- <> long "format"- <> help ("Input format: (" ++ ((intercalate "|" . keys) communicationParsers) ++ ")")- )+instance ParseRecord (Parameters Wrapped)+deriving instance Show (Parameters Unwrapped) main = do- ps <- execParser opts- ofd <- case outputFile ps of- Just f -> openFile f WriteMode- Nothing -> return stdout+ ps <- unwrapRecord "Ingest Concrete Communications from various formats" ih <- case inputFile ps of Just f -> case takeExtension f of ".gz" -> (liftM GZip.decompress . BS.readFile) f _ -> BS.readFile f Nothing -> BS.hGetContents stdin- let (_, p) = communicationParsers ! (format ps)- oh <- case outputFile ps of- Just f -> openFile f WriteMode- Nothing -> return stdout- cs <- ingest (writeCommunication oh) p (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps)+ let (_, cp, _, _) = (Map.fromList communicationParsers) ! (format ps)+ cb <- case (outputFile ps, host ps, port ps) of+ (Just f, Nothing, Nothing) -> case takeExtension f of+ "gz" -> writeCommunication <$> openFile f WriteMode+ "bz2" -> writeCommunication <$> openFile f WriteMode+ _ -> writeCommunication <$> openFile f WriteMode+ (Nothing, Just h, Just p) -> do+ con <- connectToService h p+ return $ StoreService.store con+ (Nothing, Nothing, Nothing) -> return $ writeCommunication stdout+ _ -> error "Specify either an output file, a host and port, or nothing (for stdout)"+ cs <- ingest cb cp (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps) return ()- where- opts = info (helper <*> parameters)- ( fullDesc- <> progDesc "Ingest Concrete Communications from various formats"- )
utils/InspectCommunication.hs view
@@ -1,13 +1,18 @@-{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts, GADTs, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}+ module Main (main) where import Data.Monoid ((<>)) import qualified Data.ByteString.Lazy as BS import qualified Codec.Compression.GZip as GZip+import qualified Codec.Compression.BZip as BZip import qualified Data.Concrete.Utils as CU import qualified Data.Concrete as C-import qualified Options.Applicative as O-import Options.Applicative (option, auto, short, long, metavar, strOption, help, execParser, info, helper, fullDesc, progDesc, many) import qualified Data.Vector as V import Control.Monad (liftM, mapM, join) import Data.List (intercalate, concat)@@ -15,34 +20,24 @@ import Data.Maybe (fromJust, catMaybes, maybeToList) import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn) import System.FilePath (takeExtension)-data Parameters = Parameters { inputFile :: Maybe String- } deriving (Show)+import Options.Generic -parameters :: O.Parser Parameters-parameters = Parameters- <$> (O.optional $ strOption (short 'i'- <> long "input"- <> metavar "INPUT_FILE"- <> help "Communications to inspect, serialized with Compact protocol, where the file name is interpreted by ending (.zip, .gz, .tgz) backing off to uncompressed sequence of Communications. If ommitted, read uncompressed sequence of Communications from stdin."- )- )+data Parameters w = Parameters { inputFile :: w ::: Maybe String <?> "Input file, possibly compressed (.bz2 or .gz)"+ } deriving (Generic) +instance ParseRecord (Parameters Wrapped)+deriving instance Show (Parameters Unwrapped)+ main = do- ps <- execParser opts- cs <- case inputFile ps of+ ps <- unwrapRecord "Inspect Concrete Communications"+ cs <- join $ case inputFile ps of Just f -> case takeExtension f of- ".tar" -> error "tar not implemented yet"- ".tgz" -> error "compressed tar not implemented yet"- ".tbz2" -> error "compressed tar not implemented yet"- ".zip" -> error "zip not implemented yet"- ".bz2" -> error "bzip not implemented yet"- ".gz" -> CU.readCommunicationsFromBytes <$> ((liftM GZip.decompress . BS.readFile) f) + ".tar" -> CU.readCommunicationsFromTar <$> (BS.readFile f)+ ".tgz" -> CU.readCommunicationsFromTar <$> ((liftM GZip.decompress . BS.readFile) f)+ ".tbz2" -> CU.readCommunicationsFromTar <$> ((liftM BZip.decompress . BS.readFile) f)+ ".zip" -> return $ CU.readCommunicationsFromZip f+ ".bz2" -> CU.readCommunicationsFromBytes <$> ((liftM BZip.decompress . BS.readFile) f)+ ".gz" -> CU.readCommunicationsFromBytes <$> ((liftM GZip.decompress . BS.readFile) f) _ -> CU.readCommunicationsFromBytes <$> (BS.readFile f) Nothing -> CU.readCommunicationsFromBytes <$> (BS.hGetContents stdin)- cs' <- cs- putStr $ ((T.unpack . T.concat) $ map CU.showCommunication cs')- where- opts = info (helper <*> parameters)- ( fullDesc- <> progDesc "Inspect a tar file of serialized Communications"- )+ putStr $ ((T.unpack . T.concat) $ [CU.showCommunication (head cs)])