concrete-haskell 0.1.0.4 → 0.1.0.5
raw patch · 43 files changed
+2990/−115 lines, 43 filesdep +concrete-haskelldep +directorydep +filepathdep ~thriftnew-component:exe:ingest_jsonnew-component:exe:inspect_communications
Dependencies added: concrete-haskell, directory, filepath, megaparsec, mtl, optparse-applicative, process, tar, time, uuid, zlib
Dependency ranges changed: thrift
Files
- concrete-haskell.cabal +72/−3
- src/Access_Types.hs +1/−1
- src/AnnotateCommunicationService.hs +372/−0
- src/AnnotateCommunicationService_Client.hs +113/−0
- src/AnnotateCommunicationService_Iface.hs +58/−0
- src/Annotate_Types.hs +1/−1
- src/Audio_Types.hs +8/−8
- src/Cluster_Types.hs +1/−1
- src/Communication_Types.hs +1/−1
- src/Concrete_Types.hs +2/−1
- src/Data/Concrete.hs +2/−0
- src/Data/Concrete/Utils.hs +96/−2
- src/Email_Types.hs +1/−1
- src/Entities_Types.hs +53/−41
- src/Ex_Types.hs +4/−4
- src/FetchCommunicationService.hs +343/−0
- src/FetchCommunicationService_Client.hs +99/−0
- src/FetchCommunicationService_Iface.hs +50/−0
- src/Language_Types.hs +1/−1
- src/Learn_Types.hs +1/−1
- src/Linking_Types.hs +1/−1
- src/Metadata_Types.hs +5/−5
- src/Nitf_Types.hs +1/−1
- src/Results_Types.hs +1/−1
- src/SearchService.hs +335/−0
- src/SearchService_Client.hs +103/−0
- src/SearchService_Iface.hs +54/−0
- src/Search_Types.hs +46/−26
- src/Service.hs +206/−0
- src/Service_Client.hs +78/−0
- src/Service_Iface.hs +47/−0
- src/Services_Types.hs +10/−8
- src/Situations_Types.hs +1/−1
- src/Spans_Types.hs +1/−1
- src/StoreCommunicationService.hs +145/−0
- src/StoreCommunicationService_Client.hs +65/−0
- src/StoreCommunicationService_Iface.hs +48/−0
- src/Structure_Types.hs +3/−3
- src/Summarization_Types.hs +248/−0
- src/Twitter_Types.hs +1/−1
- src/Uuid_Types.hs +1/−1
- utils/IngestJson.hs +256/−0
- utils/InspectCommunication.hs +55/−0
concrete-haskell.cabal view
@@ -1,5 +1,5 @@ name: concrete-haskell-version: 0.1.0.4+version: 0.1.0.5 synopsis: Library for the Concrete data format. description: Library for the Concrete data format. homepage: https://github.com/hltcoe@@ -36,11 +36,31 @@ , 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++-- ResultsServer, ActiveLearnerClient, ActiveLearnerServer, Feedback, Summarization, SearchProxy+ + build-depends: base >= 4.6 && < 5- , thrift >= 0.9.3+ , thrift == 0.10.0 , text , unordered-containers , QuickCheck@@ -48,5 +68,54 @@ , hashable , bytestring , containers- + , uuid+ , tar+ , zlib+ , time+ , filepath+ , process+ , directory default-language: Haskell2010+ default-extensions: DuplicateRecordFields+ ghc-options: -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10+ +executable ingest_json+ main-is: IngestJson.hs+ hs-source-dirs: utils+ build-depends: base >= 4.6 && < 5+ , megaparsec+ , bytestring+ , text+ , concrete-haskell+ , optparse-applicative+ , containers+ , filepath+ , process+ , directory+ , vector+ , mtl+ , zlib + default-language: Haskell2010+ default-extensions: DuplicateRecordFields+ ghc-options: -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10+++executable inspect_communications+ main-is: InspectCommunication.hs+ hs-source-dirs: utils+ build-depends: base >= 4.6 && < 5+ , megaparsec+ , bytestring+ , text+ , concrete-haskell+ , optparse-applicative+ , containers+ , filepath+ , process+ , directory+ , vector+ , mtl+ , zlib + default-language: Haskell2010+ default-extensions: DuplicateRecordFields+ ghc-options: -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10
src/Access_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
+ src/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 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/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 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/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 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/Annotate_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Audio_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -59,9 +59,9 @@ ] from_Sound :: Sound -> T.ThriftVal from_Sound record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v2 -> (1, ("wav",T.TString _v2))) <$> sound_wav record- , (\_v2 -> (2, ("mp3",T.TString _v2))) <$> sound_mp3 record- , (\_v2 -> (3, ("sph",T.TString _v2))) <$> sound_sph record+ [ (\_v2 -> (1, ("wav",T.TBinary _v2))) <$> sound_wav record+ , (\_v2 -> (2, ("mp3",T.TBinary _v2))) <$> sound_mp3 record+ , (\_v2 -> (3, ("sph",T.TBinary _v2))) <$> sound_sph record , (\_v2 -> (4, ("path",T.TString $ E.encodeUtf8 _v2))) <$> sound_path record ] write_Sound :: (T.Protocol p, T.Transport t) => p t -> Sound -> P.IO ()@@ -70,9 +70,9 @@ encode_Sound oprot record = T.serializeVal oprot $ from_Sound record to_Sound :: T.ThriftVal -> Sound to_Sound (T.TStruct fields) = Sound{- sound_wav = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val5 -> _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),- sound_mp3 = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields),- sound_sph = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val7 -> _val7; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ sound_wav = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val5 -> _val5; T.TString _val5 -> _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ sound_mp3 = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val6 -> _val6; T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ sound_sph = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val7 -> _val7; T.TString _val7 -> _val7; _ -> P.error "wrong type"})) (Map.lookup (3) fields), sound_path = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val8 -> E.decodeUtf8 _val8; _ -> P.error "wrong type"})) (Map.lookup (4) fields) } to_Sound _ = P.error "not a struct"@@ -81,7 +81,7 @@ decode_Sound :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Sound decode_Sound iprot bs = to_Sound $ T.deserializeVal iprot (T.T_STRUCT typemap_Sound) bs typemap_Sound :: T.TypeMap-typemap_Sound = Map.fromList [(1,("wav",T.T_STRING)),(2,("mp3",T.T_STRING)),(3,("sph",T.T_STRING)),(4,("path",T.T_STRING))]+typemap_Sound = Map.fromList [(1,("wav",T.T_BINARY)),(2,("mp3",T.T_BINARY)),(3,("sph",T.T_BINARY)),(4,("path",T.T_STRING))] default_Sound :: Sound default_Sound = Sound{ sound_wav = P.Nothing,
src/Cluster_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Communication_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Concrete_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -56,6 +56,7 @@ import qualified Situations_Types import qualified Spans_Types import qualified Structure_Types+import qualified Summarization_Types import qualified Twitter_Types import qualified Uuid_Types
src/Data/Concrete.hs view
@@ -20,6 +20,7 @@ , module Situations_Types , module Spans_Types , module Structure_Types+ , module Summarization_Types , module Twitter_Types , module Uuid_Types ) where@@ -43,5 +44,6 @@ import Situations_Types import Spans_Types import Structure_Types+import Summarization_Types import Twitter_Types import Uuid_Types
src/Data/Concrete/Utils.hs view
@@ -1,11 +1,105 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Data.Concrete.Utils (+ getUUID+ , createAnnotationMetadata+ , readCommunications+ , writeCommunications ) where import GHC.Generics import qualified Data.Concrete as C-import Data.Concrete (Communication)+import Data.Concrete (Communication(..), UUID(..), default_Communication) import Data.Text import Data.ByteString.Lazy import Data.Map+import Data.UUID.V4 (nextRandom)+import Data.UUID (toString)+import qualified Data.Text.Lazy as T+import Thrift+import Thrift.Transport.Handle+import Thrift.Transport.Framed+import Thrift.Transport.Empty+import Thrift.Protocol.Compact+import Thrift.Protocol.JSON+import Thrift.Transport.IOBuffer+import Thrift.Transport+import qualified Data.List as L+import qualified Data.ByteString.Lazy as BS+import qualified Codec.Compression.GZip as GZip+import qualified Codec.Archive.Tar as Tar+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 Data.Foldable (foldr)++getUUID :: IO UUID+getUUID = do+ uuid <- (T.pack . toString) <$> nextRandom+ return $ UUID uuid++writeCommunications :: String -> [Communication] -> IO ()+writeCommunications out cs = do+ let tarPath = (dropTarSuffix . takeFileName) out+ texts <- sequence [commToString c | c <- cs]+ let names = rights [Tar.toTarPath False (tarPath </> ((T.unpack . C.communication_id) c) <.> "comm") | c <- cs]+ entries = [Tar.fileEntry n t|(n, t) <- L.zip names texts]+ t = Tar.write entries+ (BS.writeFile out . GZip.compress) t++readCommunications :: String -> IO [Communication]+readCommunications f = do+ t <- (liftM GZip.decompress . BS.readFile) f+ let es = Tar.read t+ Right cs = Tar.foldlEntries (\x y -> ((stringToComm . entryToString . Tar.entryContent) y):x) ([] :: [IO Communication]) es+ sequence cs++entryToString :: Tar.EntryContent -> BS.ByteString+entryToString (Tar.NormalFile s _) = s++data TString = TString ReadBuffer WriteBuffer++getWrite :: TString -> WriteBuffer+getWrite (TString r w) = w++newTString = do+ w <- newWriteBuffer+ r <- newReadBuffer+ return $ TString r w++instance Transport TString where+ tIsOpen = const $ return False+ tClose = const $ return ()+ tRead (TString r w) i = readBuf r i --return ""+ tPeek (TString r w) = peekBuf r --const $ return Nothing+ tWrite (TString r w) bs = writeBuf w bs --return ()+ tFlush (TString r w) = flushBuf w >> return () --const$ return ()+ +commToString :: Communication -> IO BS.ByteString+commToString c = do+ otransport <- newTString+ let oproto = CompactProtocol otransport+ C.write_Communication oproto c+ flushBuf (getWrite otransport)++stringToComm :: BS.ByteString -> IO Communication+stringToComm s = do+ otransport@(TString r w) <- newTString+ fillBuf r s+ let oproto = CompactProtocol otransport+ C.read_Communication oproto++dropTarSuffix :: String -> String+dropTarSuffix f = (L.reverse . L.drop n . L.reverse) f+ where+ n = if ".tgz" `L.isSuffixOf` f then 4 else if ".tar.gz" `L.isSuffixOf` f then 7 else 0++createAnnotationMetadata :: String -> IO C.AnnotationMetadata+createAnnotationMetadata s = do+ time <- round `fmap` getPOSIXTime+ return C.default_AnnotationMetadata { C.annotationMetadata_tool=T.pack s+ , C.annotationMetadata_timestamp=time+ }
src/Email_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Entities_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -44,23 +44,29 @@ data Entity = Entity { entity_uuid :: Uuid_Types.UUID+ , entity_id :: P.Maybe LT.Text , entity_mentionIdList :: (Vector.Vector Uuid_Types.UUID)+ , entity_rawMentionList :: P.Maybe (Vector.Vector Structure_Types.TokenRefSequence) , entity_type :: P.Maybe LT.Text , entity_confidence :: P.Maybe P.Double , entity_canonicalName :: P.Maybe LT.Text } deriving (P.Show,P.Eq,G.Generic,TY.Typeable) instance H.Hashable Entity where- hashWithSalt salt record = salt `H.hashWithSalt` entity_uuid record `H.hashWithSalt` entity_mentionIdList record `H.hashWithSalt` entity_type record `H.hashWithSalt` entity_confidence record `H.hashWithSalt` entity_canonicalName record + hashWithSalt salt record = salt `H.hashWithSalt` entity_uuid record `H.hashWithSalt` entity_id record `H.hashWithSalt` entity_mentionIdList record `H.hashWithSalt` entity_rawMentionList record `H.hashWithSalt` entity_type record `H.hashWithSalt` entity_confidence record `H.hashWithSalt` entity_canonicalName record instance QC.Arbitrary Entity where arbitrary = M.liftM Entity (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary) shrink obj | obj == default_Entity = [] | P.otherwise = M.catMaybes [ if obj == default_Entity{entity_uuid = entity_uuid obj} then P.Nothing else P.Just $ default_Entity{entity_uuid = entity_uuid obj}+ , if obj == default_Entity{entity_id = entity_id obj} then P.Nothing else P.Just $ default_Entity{entity_id = entity_id obj} , if obj == default_Entity{entity_mentionIdList = entity_mentionIdList obj} then P.Nothing else P.Just $ default_Entity{entity_mentionIdList = entity_mentionIdList obj}+ , if obj == default_Entity{entity_rawMentionList = entity_rawMentionList obj} then P.Nothing else P.Just $ default_Entity{entity_rawMentionList = entity_rawMentionList obj} , if obj == default_Entity{entity_type = entity_type obj} then P.Nothing else P.Just $ default_Entity{entity_type = entity_type obj} , if obj == default_Entity{entity_confidence = entity_confidence obj} then P.Nothing else P.Just $ default_Entity{entity_confidence = entity_confidence obj} , if obj == default_Entity{entity_canonicalName = entity_canonicalName obj} then P.Nothing else P.Just $ default_Entity{entity_canonicalName = entity_canonicalName obj}@@ -72,6 +78,8 @@ , (\_v2 -> (3, ("type",T.TString $ E.encodeUtf8 _v2))) <$> entity_type record , (\_v2 -> (4, ("confidence",T.TDouble _v2))) <$> entity_confidence record , (\_v2 -> (5, ("canonicalName",T.TString $ E.encodeUtf8 _v2))) <$> entity_canonicalName record+ , (\_v2 -> (6, ("id",T.TString $ E.encodeUtf8 _v2))) <$> entity_id record+ , (\_v2 -> (7, ("rawMentionList",T.TList (T.T_STRUCT Structure_Types.typemap_TokenRefSequence) $ P.map (\_v6 -> Structure_Types.from_TokenRefSequence _v6) $ Vector.toList _v2))) <$> entity_rawMentionList record ] write_Entity :: (T.Protocol p, T.Transport t) => p t -> Entity -> P.IO () write_Entity oprot record = T.writeVal oprot $ from_Entity record@@ -79,11 +87,13 @@ encode_Entity oprot record = T.serializeVal oprot $ from_Entity record to_Entity :: T.ThriftVal -> Entity to_Entity (T.TStruct fields) = Entity{- entity_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val6) -> (case _val6 of {T.TStruct _val7 -> (Uuid_Types.to_UUID (T.TStruct _val7)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),- entity_mentionIdList = P.maybe (P.error "Missing required field: mentionIdList") (\(_,_val6) -> (case _val6 of {T.TList _ _val8 -> (Vector.fromList $ P.map (\_v9 -> (case _v9 of {T.TStruct _val10 -> (Uuid_Types.to_UUID (T.TStruct _val10)); _ -> P.error "wrong type"})) _val8); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- entity_type = P.maybe (P.Nothing) (\(_,_val6) -> P.Just (case _val6 of {T.TString _val11 -> E.decodeUtf8 _val11; _ -> P.error "wrong type"})) (Map.lookup (3) fields),- entity_confidence = P.maybe (P.Nothing) (\(_,_val6) -> P.Just (case _val6 of {T.TDouble _val12 -> _val12; _ -> P.error "wrong type"})) (Map.lookup (4) fields),- entity_canonicalName = P.maybe (P.Nothing) (\(_,_val6) -> P.Just (case _val6 of {T.TString _val13 -> E.decodeUtf8 _val13; _ -> P.error "wrong type"})) (Map.lookup (5) fields)+ entity_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val8) -> (case _val8 of {T.TStruct _val9 -> (Uuid_Types.to_UUID (T.TStruct _val9)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ entity_id = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TString _val10 -> E.decodeUtf8 _val10; _ -> P.error "wrong type"})) (Map.lookup (6) fields),+ entity_mentionIdList = P.maybe (P.error "Missing required field: mentionIdList") (\(_,_val8) -> (case _val8 of {T.TList _ _val11 -> (Vector.fromList $ P.map (\_v12 -> (case _v12 of {T.TStruct _val13 -> (Uuid_Types.to_UUID (T.TStruct _val13)); _ -> P.error "wrong type"})) _val11); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ entity_rawMentionList = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TList _ _val14 -> (Vector.fromList $ P.map (\_v15 -> (case _v15 of {T.TStruct _val16 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val16)); _ -> P.error "wrong type"})) _val14); _ -> P.error "wrong type"})) (Map.lookup (7) fields),+ entity_type = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TString _val17 -> E.decodeUtf8 _val17; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ entity_confidence = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TDouble _val18 -> _val18; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ entity_canonicalName = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TString _val19 -> E.decodeUtf8 _val19; _ -> P.error "wrong type"})) (Map.lookup (5) fields) } to_Entity _ = P.error "not a struct" read_Entity :: (T.Transport t, T.Protocol p) => p t -> P.IO Entity@@ -91,14 +101,16 @@ decode_Entity :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Entity decode_Entity iprot bs = to_Entity $ T.deserializeVal iprot (T.T_STRUCT typemap_Entity) bs typemap_Entity :: T.TypeMap-typemap_Entity = Map.fromList [(1,("uuid",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("mentionIdList",(T.T_LIST (T.T_STRUCT Uuid_Types.typemap_UUID)))),(3,("type",T.T_STRING)),(4,("confidence",T.T_DOUBLE)),(5,("canonicalName",T.T_STRING))]+typemap_Entity = Map.fromList [(1,("uuid",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("mentionIdList",(T.T_LIST (T.T_STRUCT Uuid_Types.typemap_UUID)))),(3,("type",T.T_STRING)),(4,("confidence",T.T_DOUBLE)),(5,("canonicalName",T.T_STRING)),(6,("id",T.T_STRING)),(7,("rawMentionList",(T.T_LIST (T.T_STRUCT Structure_Types.typemap_TokenRefSequence))))] default_Entity :: Entity default_Entity = Entity{ entity_uuid = Uuid_Types.default_UUID, entity_mentionIdList = Vector.empty, entity_type = P.Nothing, entity_confidence = P.Nothing,- entity_canonicalName = P.Nothing}+ entity_canonicalName = P.Nothing,+ entity_id = P.Nothing,+ entity_rawMentionList = P.Nothing} data EntitySet = EntitySet { entitySet_uuid :: Uuid_Types.UUID , entitySet_metadata :: Metadata_Types.AnnotationMetadata , entitySet_entityList :: (Vector.Vector Entity)@@ -123,11 +135,11 @@ ] from_EntitySet :: EntitySet -> T.ThriftVal from_EntitySet record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v16 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v16))) $ entitySet_uuid record- , (\_v16 -> P.Just (2, ("metadata",Metadata_Types.from_AnnotationMetadata _v16))) $ entitySet_metadata record- , (\_v16 -> P.Just (3, ("entityList",T.TList (T.T_STRUCT typemap_Entity) $ P.map (\_v18 -> from_Entity _v18) $ Vector.toList _v16))) $ entitySet_entityList record- , (\_v16 -> (4, ("linkingList",T.TList (T.T_STRUCT Linking_Types.typemap_Linking) $ P.map (\_v20 -> Linking_Types.from_Linking _v20) $ Vector.toList _v16))) <$> entitySet_linkingList record- , (\_v16 -> (5, ("mentionSetId",Uuid_Types.from_UUID _v16))) <$> entitySet_mentionSetId record+ [ (\_v22 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v22))) $ entitySet_uuid record+ , (\_v22 -> P.Just (2, ("metadata",Metadata_Types.from_AnnotationMetadata _v22))) $ entitySet_metadata record+ , (\_v22 -> P.Just (3, ("entityList",T.TList (T.T_STRUCT typemap_Entity) $ P.map (\_v24 -> from_Entity _v24) $ Vector.toList _v22))) $ entitySet_entityList record+ , (\_v22 -> (4, ("linkingList",T.TList (T.T_STRUCT Linking_Types.typemap_Linking) $ P.map (\_v26 -> Linking_Types.from_Linking _v26) $ Vector.toList _v22))) <$> entitySet_linkingList record+ , (\_v22 -> (5, ("mentionSetId",Uuid_Types.from_UUID _v22))) <$> entitySet_mentionSetId record ] write_EntitySet :: (T.Protocol p, T.Transport t) => p t -> EntitySet -> P.IO () write_EntitySet oprot record = T.writeVal oprot $ from_EntitySet record@@ -135,11 +147,11 @@ encode_EntitySet oprot record = T.serializeVal oprot $ from_EntitySet record to_EntitySet :: T.ThriftVal -> EntitySet to_EntitySet (T.TStruct fields) = EntitySet{- entitySet_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val22) -> (case _val22 of {T.TStruct _val23 -> (Uuid_Types.to_UUID (T.TStruct _val23)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),- entitySet_metadata = P.maybe (P.error "Missing required field: metadata") (\(_,_val22) -> (case _val22 of {T.TStruct _val24 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val24)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- entitySet_entityList = P.maybe (P.error "Missing required field: entityList") (\(_,_val22) -> (case _val22 of {T.TList _ _val25 -> (Vector.fromList $ P.map (\_v26 -> (case _v26 of {T.TStruct _val27 -> (to_Entity (T.TStruct _val27)); _ -> P.error "wrong type"})) _val25); _ -> P.error "wrong type"})) (Map.lookup (3) fields),- entitySet_linkingList = P.maybe (P.Nothing) (\(_,_val22) -> P.Just (case _val22 of {T.TList _ _val28 -> (Vector.fromList $ P.map (\_v29 -> (case _v29 of {T.TStruct _val30 -> (Linking_Types.to_Linking (T.TStruct _val30)); _ -> P.error "wrong type"})) _val28); _ -> P.error "wrong type"})) (Map.lookup (4) fields),- entitySet_mentionSetId = P.maybe (P.Nothing) (\(_,_val22) -> P.Just (case _val22 of {T.TStruct _val31 -> (Uuid_Types.to_UUID (T.TStruct _val31)); _ -> P.error "wrong type"})) (Map.lookup (5) fields)+ entitySet_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val28) -> (case _val28 of {T.TStruct _val29 -> (Uuid_Types.to_UUID (T.TStruct _val29)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ entitySet_metadata = P.maybe (P.error "Missing required field: metadata") (\(_,_val28) -> (case _val28 of {T.TStruct _val30 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val30)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ entitySet_entityList = P.maybe (P.error "Missing required field: entityList") (\(_,_val28) -> (case _val28 of {T.TList _ _val31 -> (Vector.fromList $ P.map (\_v32 -> (case _v32 of {T.TStruct _val33 -> (to_Entity (T.TStruct _val33)); _ -> P.error "wrong type"})) _val31); _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ entitySet_linkingList = P.maybe (P.Nothing) (\(_,_val28) -> P.Just (case _val28 of {T.TList _ _val34 -> (Vector.fromList $ P.map (\_v35 -> (case _v35 of {T.TStruct _val36 -> (Linking_Types.to_Linking (T.TStruct _val36)); _ -> P.error "wrong type"})) _val34); _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ entitySet_mentionSetId = P.maybe (P.Nothing) (\(_,_val28) -> P.Just (case _val28 of {T.TStruct _val37 -> (Uuid_Types.to_UUID (T.TStruct _val37)); _ -> P.error "wrong type"})) (Map.lookup (5) fields) } to_EntitySet _ = P.error "not a struct" read_EntitySet :: (T.Transport t, T.Protocol p) => p t -> P.IO EntitySet@@ -185,13 +197,13 @@ ] from_EntityMention :: EntityMention -> T.ThriftVal from_EntityMention record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v34 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v34))) $ entityMention_uuid record- , (\_v34 -> P.Just (2, ("tokens",Structure_Types.from_TokenRefSequence _v34))) $ entityMention_tokens record- , (\_v34 -> (3, ("entityType",T.TString $ E.encodeUtf8 _v34))) <$> entityMention_entityType record- , (\_v34 -> (4, ("phraseType",T.TString $ E.encodeUtf8 _v34))) <$> entityMention_phraseType record- , (\_v34 -> (5, ("confidence",T.TDouble _v34))) <$> entityMention_confidence record- , (\_v34 -> (6, ("text",T.TString $ E.encodeUtf8 _v34))) <$> entityMention_text record- , (\_v34 -> (7, ("childMentionIdList",T.TList (T.T_STRUCT Uuid_Types.typemap_UUID) $ P.map (\_v36 -> Uuid_Types.from_UUID _v36) $ Vector.toList _v34))) <$> entityMention_childMentionIdList record+ [ (\_v40 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v40))) $ entityMention_uuid record+ , (\_v40 -> P.Just (2, ("tokens",Structure_Types.from_TokenRefSequence _v40))) $ entityMention_tokens record+ , (\_v40 -> (3, ("entityType",T.TString $ E.encodeUtf8 _v40))) <$> entityMention_entityType record+ , (\_v40 -> (4, ("phraseType",T.TString $ E.encodeUtf8 _v40))) <$> entityMention_phraseType record+ , (\_v40 -> (5, ("confidence",T.TDouble _v40))) <$> entityMention_confidence record+ , (\_v40 -> (6, ("text",T.TString $ E.encodeUtf8 _v40))) <$> entityMention_text record+ , (\_v40 -> (7, ("childMentionIdList",T.TList (T.T_STRUCT Uuid_Types.typemap_UUID) $ P.map (\_v42 -> Uuid_Types.from_UUID _v42) $ Vector.toList _v40))) <$> entityMention_childMentionIdList record ] write_EntityMention :: (T.Protocol p, T.Transport t) => p t -> EntityMention -> P.IO () write_EntityMention oprot record = T.writeVal oprot $ from_EntityMention record@@ -199,13 +211,13 @@ encode_EntityMention oprot record = T.serializeVal oprot $ from_EntityMention record to_EntityMention :: T.ThriftVal -> EntityMention to_EntityMention (T.TStruct fields) = EntityMention{- entityMention_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val38) -> (case _val38 of {T.TStruct _val39 -> (Uuid_Types.to_UUID (T.TStruct _val39)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),- entityMention_tokens = P.maybe (P.error "Missing required field: tokens") (\(_,_val38) -> (case _val38 of {T.TStruct _val40 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val40)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- entityMention_entityType = P.maybe (P.Nothing) (\(_,_val38) -> P.Just (case _val38 of {T.TString _val41 -> E.decodeUtf8 _val41; _ -> P.error "wrong type"})) (Map.lookup (3) fields),- entityMention_phraseType = P.maybe (P.Nothing) (\(_,_val38) -> P.Just (case _val38 of {T.TString _val42 -> E.decodeUtf8 _val42; _ -> P.error "wrong type"})) (Map.lookup (4) fields),- entityMention_confidence = P.maybe (P.Nothing) (\(_,_val38) -> P.Just (case _val38 of {T.TDouble _val43 -> _val43; _ -> P.error "wrong type"})) (Map.lookup (5) fields),- entityMention_text = P.maybe (P.Nothing) (\(_,_val38) -> P.Just (case _val38 of {T.TString _val44 -> E.decodeUtf8 _val44; _ -> P.error "wrong type"})) (Map.lookup (6) fields),- entityMention_childMentionIdList = P.maybe (P.Nothing) (\(_,_val38) -> P.Just (case _val38 of {T.TList _ _val45 -> (Vector.fromList $ P.map (\_v46 -> (case _v46 of {T.TStruct _val47 -> (Uuid_Types.to_UUID (T.TStruct _val47)); _ -> P.error "wrong type"})) _val45); _ -> P.error "wrong type"})) (Map.lookup (7) fields)+ entityMention_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val44) -> (case _val44 of {T.TStruct _val45 -> (Uuid_Types.to_UUID (T.TStruct _val45)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ entityMention_tokens = P.maybe (P.error "Missing required field: tokens") (\(_,_val44) -> (case _val44 of {T.TStruct _val46 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val46)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ entityMention_entityType = P.maybe (P.Nothing) (\(_,_val44) -> P.Just (case _val44 of {T.TString _val47 -> E.decodeUtf8 _val47; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ entityMention_phraseType = P.maybe (P.Nothing) (\(_,_val44) -> P.Just (case _val44 of {T.TString _val48 -> E.decodeUtf8 _val48; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ entityMention_confidence = P.maybe (P.Nothing) (\(_,_val44) -> P.Just (case _val44 of {T.TDouble _val49 -> _val49; _ -> P.error "wrong type"})) (Map.lookup (5) fields),+ entityMention_text = P.maybe (P.Nothing) (\(_,_val44) -> P.Just (case _val44 of {T.TString _val50 -> E.decodeUtf8 _val50; _ -> P.error "wrong type"})) (Map.lookup (6) fields),+ entityMention_childMentionIdList = P.maybe (P.Nothing) (\(_,_val44) -> P.Just (case _val44 of {T.TList _ _val51 -> (Vector.fromList $ P.map (\_v52 -> (case _v52 of {T.TStruct _val53 -> (Uuid_Types.to_UUID (T.TStruct _val53)); _ -> P.error "wrong type"})) _val51); _ -> P.error "wrong type"})) (Map.lookup (7) fields) } to_EntityMention _ = P.error "not a struct" read_EntityMention :: (T.Transport t, T.Protocol p) => p t -> P.IO EntityMention@@ -244,10 +256,10 @@ ] from_EntityMentionSet :: EntityMentionSet -> T.ThriftVal from_EntityMentionSet record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v50 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v50))) $ entityMentionSet_uuid record- , (\_v50 -> P.Just (2, ("metadata",Metadata_Types.from_AnnotationMetadata _v50))) $ entityMentionSet_metadata record- , (\_v50 -> P.Just (3, ("mentionList",T.TList (T.T_STRUCT typemap_EntityMention) $ P.map (\_v52 -> from_EntityMention _v52) $ Vector.toList _v50))) $ entityMentionSet_mentionList record- , (\_v50 -> (4, ("linkingList",T.TList (T.T_STRUCT Linking_Types.typemap_Linking) $ P.map (\_v54 -> Linking_Types.from_Linking _v54) $ Vector.toList _v50))) <$> entityMentionSet_linkingList record+ [ (\_v56 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v56))) $ entityMentionSet_uuid record+ , (\_v56 -> P.Just (2, ("metadata",Metadata_Types.from_AnnotationMetadata _v56))) $ entityMentionSet_metadata record+ , (\_v56 -> P.Just (3, ("mentionList",T.TList (T.T_STRUCT typemap_EntityMention) $ P.map (\_v58 -> from_EntityMention _v58) $ Vector.toList _v56))) $ entityMentionSet_mentionList record+ , (\_v56 -> (4, ("linkingList",T.TList (T.T_STRUCT Linking_Types.typemap_Linking) $ P.map (\_v60 -> Linking_Types.from_Linking _v60) $ Vector.toList _v56))) <$> entityMentionSet_linkingList record ] write_EntityMentionSet :: (T.Protocol p, T.Transport t) => p t -> EntityMentionSet -> P.IO () write_EntityMentionSet oprot record = T.writeVal oprot $ from_EntityMentionSet record@@ -255,10 +267,10 @@ encode_EntityMentionSet oprot record = T.serializeVal oprot $ from_EntityMentionSet record to_EntityMentionSet :: T.ThriftVal -> EntityMentionSet to_EntityMentionSet (T.TStruct fields) = EntityMentionSet{- entityMentionSet_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val56) -> (case _val56 of {T.TStruct _val57 -> (Uuid_Types.to_UUID (T.TStruct _val57)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),- entityMentionSet_metadata = P.maybe (P.error "Missing required field: metadata") (\(_,_val56) -> (case _val56 of {T.TStruct _val58 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val58)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- entityMentionSet_mentionList = P.maybe (P.error "Missing required field: mentionList") (\(_,_val56) -> (case _val56 of {T.TList _ _val59 -> (Vector.fromList $ P.map (\_v60 -> (case _v60 of {T.TStruct _val61 -> (to_EntityMention (T.TStruct _val61)); _ -> P.error "wrong type"})) _val59); _ -> P.error "wrong type"})) (Map.lookup (3) fields),- entityMentionSet_linkingList = P.maybe (P.Nothing) (\(_,_val56) -> P.Just (case _val56 of {T.TList _ _val62 -> (Vector.fromList $ P.map (\_v63 -> (case _v63 of {T.TStruct _val64 -> (Linking_Types.to_Linking (T.TStruct _val64)); _ -> P.error "wrong type"})) _val62); _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ entityMentionSet_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val62) -> (case _val62 of {T.TStruct _val63 -> (Uuid_Types.to_UUID (T.TStruct _val63)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ entityMentionSet_metadata = P.maybe (P.error "Missing required field: metadata") (\(_,_val62) -> (case _val62 of {T.TStruct _val64 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val64)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ entityMentionSet_mentionList = P.maybe (P.error "Missing required field: mentionList") (\(_,_val62) -> (case _val62 of {T.TList _ _val65 -> (Vector.fromList $ P.map (\_v66 -> (case _v66 of {T.TStruct _val67 -> (to_EntityMention (T.TStruct _val67)); _ -> P.error "wrong type"})) _val65); _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ entityMentionSet_linkingList = P.maybe (P.Nothing) (\(_,_val62) -> P.Just (case _val62 of {T.TList _ _val68 -> (Vector.fromList $ P.map (\_v69 -> (case _v69 of {T.TStruct _val70 -> (Linking_Types.to_Linking (T.TStruct _val70)); _ -> P.error "wrong type"})) _val68); _ -> P.error "wrong type"})) (Map.lookup (4) fields) } to_EntityMentionSet _ = P.error "not a struct" read_EntityMentionSet :: (T.Transport t, T.Protocol p) => p t -> P.IO EntityMentionSet
src/Ex_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -55,7 +55,7 @@ from_ConcreteThriftException :: ConcreteThriftException -> T.ThriftVal from_ConcreteThriftException record = T.TStruct $ Map.fromList $ M.catMaybes [ (\_v2 -> P.Just (1, ("message",T.TString $ E.encodeUtf8 _v2))) $ concreteThriftException_message record- , (\_v2 -> (2, ("serEx",T.TString _v2))) <$> concreteThriftException_serEx record+ , (\_v2 -> (2, ("serEx",T.TBinary _v2))) <$> concreteThriftException_serEx record ] write_ConcreteThriftException :: (T.Protocol p, T.Transport t) => p t -> ConcreteThriftException -> P.IO () write_ConcreteThriftException oprot record = T.writeVal oprot $ from_ConcreteThriftException record@@ -64,7 +64,7 @@ to_ConcreteThriftException :: T.ThriftVal -> ConcreteThriftException to_ConcreteThriftException (T.TStruct fields) = ConcreteThriftException{ concreteThriftException_message = P.maybe (P.error "Missing required field: message") (\(_,_val4) -> (case _val4 of {T.TString _val5 -> E.decodeUtf8 _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),- concreteThriftException_serEx = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ concreteThriftException_serEx = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val6 -> _val6; T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields) } to_ConcreteThriftException _ = P.error "not a struct" read_ConcreteThriftException :: (T.Transport t, T.Protocol p) => p t -> P.IO ConcreteThriftException@@ -72,7 +72,7 @@ decode_ConcreteThriftException :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> ConcreteThriftException decode_ConcreteThriftException iprot bs = to_ConcreteThriftException $ T.deserializeVal iprot (T.T_STRUCT typemap_ConcreteThriftException) bs typemap_ConcreteThriftException :: T.TypeMap-typemap_ConcreteThriftException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_STRING))]+typemap_ConcreteThriftException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_BINARY))] default_ConcreteThriftException :: ConcreteThriftException default_ConcreteThriftException = ConcreteThriftException{ concreteThriftException_message = "",
+ src/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 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/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 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/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 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/Language_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Learn_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Linking_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Metadata_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -189,7 +189,7 @@ ] from_Digest :: Digest -> T.ThriftVal from_Digest record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v82 -> (1, ("bytesValue",T.TString _v82))) <$> digest_bytesValue record+ [ (\_v82 -> (1, ("bytesValue",T.TBinary _v82))) <$> digest_bytesValue record , (\_v82 -> (2, ("int64Value",T.TI64 _v82))) <$> digest_int64Value record , (\_v82 -> (3, ("doubleValue",T.TDouble _v82))) <$> digest_doubleValue record , (\_v82 -> (4, ("stringValue",T.TString $ E.encodeUtf8 _v82))) <$> digest_stringValue record@@ -203,7 +203,7 @@ encode_Digest oprot record = T.serializeVal oprot $ from_Digest record to_Digest :: T.ThriftVal -> Digest to_Digest (T.TStruct fields) = Digest{- digest_bytesValue = P.maybe (P.Nothing) (\(_,_val90) -> P.Just (case _val90 of {T.TString _val91 -> _val91; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ digest_bytesValue = P.maybe (P.Nothing) (\(_,_val90) -> P.Just (case _val90 of {T.TBinary _val91 -> _val91; T.TString _val91 -> _val91; _ -> P.error "wrong type"})) (Map.lookup (1) fields), digest_int64Value = P.maybe (P.Nothing) (\(_,_val90) -> P.Just (case _val90 of {T.TI64 _val92 -> _val92; _ -> P.error "wrong type"})) (Map.lookup (2) fields), digest_doubleValue = P.maybe (P.Nothing) (\(_,_val90) -> P.Just (case _val90 of {T.TDouble _val93 -> _val93; _ -> P.error "wrong type"})) (Map.lookup (3) fields), digest_stringValue = P.maybe (P.Nothing) (\(_,_val90) -> P.Just (case _val90 of {T.TString _val94 -> E.decodeUtf8 _val94; _ -> P.error "wrong type"})) (Map.lookup (4) fields),@@ -217,7 +217,7 @@ decode_Digest :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Digest decode_Digest iprot bs = to_Digest $ T.deserializeVal iprot (T.T_STRUCT typemap_Digest) bs typemap_Digest :: T.TypeMap-typemap_Digest = Map.fromList [(1,("bytesValue",T.T_STRING)),(2,("int64Value",T.T_I64)),(3,("doubleValue",T.T_DOUBLE)),(4,("stringValue",T.T_STRING)),(5,("int64List",(T.T_LIST T.T_I64))),(6,("doubleList",(T.T_LIST T.T_DOUBLE))),(7,("stringList",(T.T_LIST T.T_STRING)))]+typemap_Digest = Map.fromList [(1,("bytesValue",T.T_BINARY)),(2,("int64Value",T.T_I64)),(3,("doubleValue",T.T_DOUBLE)),(4,("stringValue",T.T_STRING)),(5,("int64List",(T.T_LIST T.T_I64))),(6,("doubleList",(T.T_LIST T.T_DOUBLE))),(7,("stringList",(T.T_LIST T.T_STRING)))] default_Digest :: Digest default_Digest = Digest{ digest_bytesValue = P.Nothing,@@ -282,7 +282,7 @@ annotationMetadata_timestamp = 0, annotationMetadata_digest = P.Nothing, annotationMetadata_dependencies = P.Nothing,- annotationMetadata_kBest = 1}+ annotationMetadata_kBest = (1)} data CommunicationMetadata = CommunicationMetadata { communicationMetadata_tweetInfo :: P.Maybe Twitter_Types.TweetInfo , communicationMetadata_emailInfo :: P.Maybe Email_Types.EmailCommunicationInfo , communicationMetadata_nitfInfo :: P.Maybe Nitf_Types.NITFInfo
src/Nitf_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Results_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
+ src/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 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/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 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/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 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/Search_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -37,10 +37,12 @@ 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 data SearchType = COMMUNICATIONS|SECTIONS|SENTENCES|ENTITIES|ENTITY_MENTIONS|SITUATIONS|SITUATION_MENTIONS deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)@@ -131,9 +133,11 @@ , searchQuery_type :: SearchType , searchQuery_lang :: P.Maybe LT.Text , searchQuery_corpus :: P.Maybe LT.Text+ , searchQuery_k :: P.Maybe I.Int32+ , searchQuery_communication :: P.Maybe Communication_Types.Communication } deriving (P.Show,P.Eq,G.Generic,TY.Typeable) instance H.Hashable SearchQuery where- hashWithSalt salt record = salt `H.hashWithSalt` searchQuery_terms record `H.hashWithSalt` searchQuery_questions record `H.hashWithSalt` searchQuery_communicationId record `H.hashWithSalt` searchQuery_tokens record `H.hashWithSalt` searchQuery_rawQuery record `H.hashWithSalt` searchQuery_auths record `H.hashWithSalt` searchQuery_userId record `H.hashWithSalt` searchQuery_name record `H.hashWithSalt` searchQuery_labels record `H.hashWithSalt` searchQuery_type record `H.hashWithSalt` searchQuery_lang record `H.hashWithSalt` searchQuery_corpus record + hashWithSalt salt record = salt `H.hashWithSalt` searchQuery_terms record `H.hashWithSalt` searchQuery_questions record `H.hashWithSalt` searchQuery_communicationId record `H.hashWithSalt` searchQuery_tokens record `H.hashWithSalt` searchQuery_rawQuery record `H.hashWithSalt` searchQuery_auths record `H.hashWithSalt` searchQuery_userId record `H.hashWithSalt` searchQuery_name record `H.hashWithSalt` searchQuery_labels record `H.hashWithSalt` searchQuery_type record `H.hashWithSalt` searchQuery_lang record `H.hashWithSalt` searchQuery_corpus record `H.hashWithSalt` searchQuery_k record `H.hashWithSalt` searchQuery_communication record instance QC.Arbitrary SearchQuery where arbitrary = M.liftM SearchQuery (M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary)@@ -147,6 +151,8 @@ `M.ap`(QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary) shrink obj | obj == default_SearchQuery = [] | P.otherwise = M.catMaybes [ if obj == default_SearchQuery{searchQuery_terms = searchQuery_terms obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_terms = searchQuery_terms obj}@@ -161,6 +167,8 @@ , if obj == default_SearchQuery{searchQuery_type = searchQuery_type obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_type = searchQuery_type obj} , if obj == default_SearchQuery{searchQuery_lang = searchQuery_lang obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_lang = searchQuery_lang obj} , if obj == default_SearchQuery{searchQuery_corpus = searchQuery_corpus obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_corpus = searchQuery_corpus obj}+ , if obj == default_SearchQuery{searchQuery_k = searchQuery_k obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_k = searchQuery_k obj}+ , if obj == default_SearchQuery{searchQuery_communication = searchQuery_communication obj} then P.Nothing else P.Just $ default_SearchQuery{searchQuery_communication = searchQuery_communication obj} ] from_SearchQuery :: SearchQuery -> T.ThriftVal from_SearchQuery record = T.TStruct $ Map.fromList $ M.catMaybes@@ -176,6 +184,8 @@ , (\_v9 -> P.Just (10, ("type",T.TI32 $ P.fromIntegral $ P.fromEnum _v9))) $ searchQuery_type record , (\_v9 -> (11, ("lang",T.TString $ E.encodeUtf8 _v9))) <$> searchQuery_lang record , (\_v9 -> (12, ("corpus",T.TString $ E.encodeUtf8 _v9))) <$> searchQuery_corpus record+ , (\_v9 -> (13, ("k",T.TI32 _v9))) <$> searchQuery_k record+ , (\_v9 -> (14, ("communication",Communication_Types.from_Communication _v9))) <$> searchQuery_communication record ] write_SearchQuery :: (T.Protocol p, T.Transport t) => p t -> SearchQuery -> P.IO () write_SearchQuery oprot record = T.writeVal oprot $ from_SearchQuery record@@ -194,7 +204,9 @@ searchQuery_labels = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TList _ _val30 -> (Vector.fromList $ P.map (\_v31 -> (case _v31 of {T.TString _val32 -> E.decodeUtf8 _val32; _ -> P.error "wrong type"})) _val30); _ -> P.error "wrong type"})) (Map.lookup (9) fields), searchQuery_type = P.maybe (P.error "Missing required field: type") (\(_,_val17) -> (case _val17 of {T.TI32 _val33 -> P.toEnum $ P.fromIntegral _val33; _ -> P.error "wrong type"})) (Map.lookup (10) fields), searchQuery_lang = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TString _val34 -> E.decodeUtf8 _val34; _ -> P.error "wrong type"})) (Map.lookup (11) fields),- searchQuery_corpus = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TString _val35 -> E.decodeUtf8 _val35; _ -> P.error "wrong type"})) (Map.lookup (12) fields)+ searchQuery_corpus = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TString _val35 -> E.decodeUtf8 _val35; _ -> P.error "wrong type"})) (Map.lookup (12) fields),+ searchQuery_k = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TI32 _val36 -> _val36; _ -> P.error "wrong type"})) (Map.lookup (13) fields),+ searchQuery_communication = P.maybe (P.Nothing) (\(_,_val17) -> P.Just (case _val17 of {T.TStruct _val37 -> (Communication_Types.to_Communication (T.TStruct _val37)); _ -> P.error "wrong type"})) (Map.lookup (14) fields) } to_SearchQuery _ = P.error "not a struct" read_SearchQuery :: (T.Transport t, T.Protocol p) => p t -> P.IO SearchQuery@@ -202,7 +214,7 @@ decode_SearchQuery :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SearchQuery decode_SearchQuery iprot bs = to_SearchQuery $ T.deserializeVal iprot (T.T_STRUCT typemap_SearchQuery) bs typemap_SearchQuery :: T.TypeMap-typemap_SearchQuery = Map.fromList [(1,("terms",(T.T_LIST T.T_STRING))),(2,("questions",(T.T_LIST T.T_STRING))),(3,("communicationId",T.T_STRING)),(4,("tokens",(T.T_STRUCT Structure_Types.typemap_TokenRefSequence))),(5,("rawQuery",T.T_STRING)),(6,("auths",T.T_STRING)),(7,("userId",T.T_STRING)),(8,("name",T.T_STRING)),(9,("labels",(T.T_LIST T.T_STRING))),(10,("type",T.T_I32)),(11,("lang",T.T_STRING)),(12,("corpus",T.T_STRING))]+typemap_SearchQuery = Map.fromList [(1,("terms",(T.T_LIST T.T_STRING))),(2,("questions",(T.T_LIST T.T_STRING))),(3,("communicationId",T.T_STRING)),(4,("tokens",(T.T_STRUCT Structure_Types.typemap_TokenRefSequence))),(5,("rawQuery",T.T_STRING)),(6,("auths",T.T_STRING)),(7,("userId",T.T_STRING)),(8,("name",T.T_STRING)),(9,("labels",(T.T_LIST T.T_STRING))),(10,("type",T.T_I32)),(11,("lang",T.T_STRING)),(12,("corpus",T.T_STRING)),(13,("k",T.T_I32)),(14,("communication",(T.T_STRUCT Communication_Types.typemap_Communication)))] default_SearchQuery :: SearchQuery default_SearchQuery = SearchQuery{ searchQuery_terms = P.Nothing,@@ -216,32 +228,38 @@ searchQuery_labels = P.Nothing, searchQuery_type = (P.toEnum 0), searchQuery_lang = P.Nothing,- searchQuery_corpus = P.Nothing}+ searchQuery_corpus = P.Nothing,+ searchQuery_k = P.Nothing,+ searchQuery_communication = P.Nothing} data SearchResultItem = SearchResultItem { searchResultItem_communicationId :: P.Maybe LT.Text , searchResultItem_sentenceId :: P.Maybe Uuid_Types.UUID , searchResultItem_score :: P.Maybe P.Double , searchResultItem_tokens :: P.Maybe Structure_Types.TokenRefSequence+ , searchResultItem_entity :: P.Maybe Entities_Types.Entity } deriving (P.Show,P.Eq,G.Generic,TY.Typeable) instance H.Hashable SearchResultItem where- hashWithSalt salt record = salt `H.hashWithSalt` searchResultItem_communicationId record `H.hashWithSalt` searchResultItem_sentenceId record `H.hashWithSalt` searchResultItem_score record `H.hashWithSalt` searchResultItem_tokens record + hashWithSalt salt record = salt `H.hashWithSalt` searchResultItem_communicationId record `H.hashWithSalt` searchResultItem_sentenceId record `H.hashWithSalt` searchResultItem_score record `H.hashWithSalt` searchResultItem_tokens record `H.hashWithSalt` searchResultItem_entity record instance QC.Arbitrary SearchResultItem where arbitrary = M.liftM SearchResultItem (M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary) `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary) shrink obj | obj == default_SearchResultItem = [] | P.otherwise = M.catMaybes [ if obj == default_SearchResultItem{searchResultItem_communicationId = searchResultItem_communicationId obj} then P.Nothing else P.Just $ default_SearchResultItem{searchResultItem_communicationId = searchResultItem_communicationId obj} , if obj == default_SearchResultItem{searchResultItem_sentenceId = searchResultItem_sentenceId obj} then P.Nothing else P.Just $ default_SearchResultItem{searchResultItem_sentenceId = searchResultItem_sentenceId obj} , if obj == default_SearchResultItem{searchResultItem_score = searchResultItem_score obj} then P.Nothing else P.Just $ default_SearchResultItem{searchResultItem_score = searchResultItem_score obj} , if obj == default_SearchResultItem{searchResultItem_tokens = searchResultItem_tokens obj} then P.Nothing else P.Just $ default_SearchResultItem{searchResultItem_tokens = searchResultItem_tokens obj}+ , if obj == default_SearchResultItem{searchResultItem_entity = searchResultItem_entity obj} then P.Nothing else P.Just $ default_SearchResultItem{searchResultItem_entity = searchResultItem_entity obj} ] from_SearchResultItem :: SearchResultItem -> T.ThriftVal from_SearchResultItem record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v38 -> (1, ("communicationId",T.TString $ E.encodeUtf8 _v38))) <$> searchResultItem_communicationId record- , (\_v38 -> (2, ("sentenceId",Uuid_Types.from_UUID _v38))) <$> searchResultItem_sentenceId record- , (\_v38 -> (3, ("score",T.TDouble _v38))) <$> searchResultItem_score record- , (\_v38 -> (4, ("tokens",Structure_Types.from_TokenRefSequence _v38))) <$> searchResultItem_tokens record+ [ (\_v40 -> (1, ("communicationId",T.TString $ E.encodeUtf8 _v40))) <$> searchResultItem_communicationId record+ , (\_v40 -> (2, ("sentenceId",Uuid_Types.from_UUID _v40))) <$> searchResultItem_sentenceId record+ , (\_v40 -> (3, ("score",T.TDouble _v40))) <$> searchResultItem_score record+ , (\_v40 -> (4, ("tokens",Structure_Types.from_TokenRefSequence _v40))) <$> searchResultItem_tokens record+ , (\_v40 -> (5, ("entity",Entities_Types.from_Entity _v40))) <$> searchResultItem_entity record ] write_SearchResultItem :: (T.Protocol p, T.Transport t) => p t -> SearchResultItem -> P.IO () write_SearchResultItem oprot record = T.writeVal oprot $ from_SearchResultItem record@@ -249,10 +267,11 @@ encode_SearchResultItem oprot record = T.serializeVal oprot $ from_SearchResultItem record to_SearchResultItem :: T.ThriftVal -> SearchResultItem to_SearchResultItem (T.TStruct fields) = SearchResultItem{- searchResultItem_communicationId = P.maybe (P.Nothing) (\(_,_val40) -> P.Just (case _val40 of {T.TString _val41 -> E.decodeUtf8 _val41; _ -> P.error "wrong type"})) (Map.lookup (1) fields),- searchResultItem_sentenceId = P.maybe (P.Nothing) (\(_,_val40) -> P.Just (case _val40 of {T.TStruct _val42 -> (Uuid_Types.to_UUID (T.TStruct _val42)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- searchResultItem_score = P.maybe (P.Nothing) (\(_,_val40) -> P.Just (case _val40 of {T.TDouble _val43 -> _val43; _ -> P.error "wrong type"})) (Map.lookup (3) fields),- searchResultItem_tokens = P.maybe (P.Nothing) (\(_,_val40) -> P.Just (case _val40 of {T.TStruct _val44 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val44)); _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ searchResultItem_communicationId = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TString _val43 -> E.decodeUtf8 _val43; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ searchResultItem_sentenceId = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TStruct _val44 -> (Uuid_Types.to_UUID (T.TStruct _val44)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ searchResultItem_score = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TDouble _val45 -> _val45; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ searchResultItem_tokens = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TStruct _val46 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val46)); _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ searchResultItem_entity = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TStruct _val47 -> (Entities_Types.to_Entity (T.TStruct _val47)); _ -> P.error "wrong type"})) (Map.lookup (5) fields) } to_SearchResultItem _ = P.error "not a struct" read_SearchResultItem :: (T.Transport t, T.Protocol p) => p t -> P.IO SearchResultItem@@ -260,13 +279,14 @@ decode_SearchResultItem :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SearchResultItem decode_SearchResultItem iprot bs = to_SearchResultItem $ T.deserializeVal iprot (T.T_STRUCT typemap_SearchResultItem) bs typemap_SearchResultItem :: T.TypeMap-typemap_SearchResultItem = Map.fromList [(1,("communicationId",T.T_STRING)),(2,("sentenceId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(3,("score",T.T_DOUBLE)),(4,("tokens",(T.T_STRUCT Structure_Types.typemap_TokenRefSequence)))]+typemap_SearchResultItem = Map.fromList [(1,("communicationId",T.T_STRING)),(2,("sentenceId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(3,("score",T.T_DOUBLE)),(4,("tokens",(T.T_STRUCT Structure_Types.typemap_TokenRefSequence))),(5,("entity",(T.T_STRUCT Entities_Types.typemap_Entity)))] default_SearchResultItem :: SearchResultItem default_SearchResultItem = SearchResultItem{ searchResultItem_communicationId = P.Nothing, searchResultItem_sentenceId = P.Nothing, searchResultItem_score = P.Nothing,- searchResultItem_tokens = P.Nothing}+ searchResultItem_tokens = P.Nothing,+ searchResultItem_entity = P.Nothing} data SearchResult = SearchResult { searchResult_uuid :: Uuid_Types.UUID , searchResult_searchQuery :: SearchQuery , searchResult_searchResultItems :: P.Maybe (Vector.Vector SearchResultItem)@@ -291,11 +311,11 @@ ] from_SearchResult :: SearchResult -> T.ThriftVal from_SearchResult record = T.TStruct $ Map.fromList $ M.catMaybes- [ (\_v47 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v47))) $ searchResult_uuid record- , (\_v47 -> P.Just (2, ("searchQuery",from_SearchQuery _v47))) $ searchResult_searchQuery record- , (\_v47 -> (3, ("searchResultItems",T.TList (T.T_STRUCT typemap_SearchResultItem) $ P.map (\_v49 -> from_SearchResultItem _v49) $ Vector.toList _v47))) <$> searchResult_searchResultItems record- , (\_v47 -> (4, ("metadata",Metadata_Types.from_AnnotationMetadata _v47))) <$> searchResult_metadata record- , (\_v47 -> (5, ("lang",T.TString $ E.encodeUtf8 _v47))) <$> searchResult_lang record+ [ (\_v50 -> P.Just (1, ("uuid",Uuid_Types.from_UUID _v50))) $ searchResult_uuid record+ , (\_v50 -> P.Just (2, ("searchQuery",from_SearchQuery _v50))) $ searchResult_searchQuery record+ , (\_v50 -> (3, ("searchResultItems",T.TList (T.T_STRUCT typemap_SearchResultItem) $ P.map (\_v52 -> from_SearchResultItem _v52) $ Vector.toList _v50))) <$> searchResult_searchResultItems record+ , (\_v50 -> (4, ("metadata",Metadata_Types.from_AnnotationMetadata _v50))) <$> searchResult_metadata record+ , (\_v50 -> (5, ("lang",T.TString $ E.encodeUtf8 _v50))) <$> searchResult_lang record ] write_SearchResult :: (T.Protocol p, T.Transport t) => p t -> SearchResult -> P.IO () write_SearchResult oprot record = T.writeVal oprot $ from_SearchResult record@@ -303,11 +323,11 @@ encode_SearchResult oprot record = T.serializeVal oprot $ from_SearchResult record to_SearchResult :: T.ThriftVal -> SearchResult to_SearchResult (T.TStruct fields) = SearchResult{- searchResult_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val51) -> (case _val51 of {T.TStruct _val52 -> (Uuid_Types.to_UUID (T.TStruct _val52)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),- searchResult_searchQuery = P.maybe (P.error "Missing required field: searchQuery") (\(_,_val51) -> (case _val51 of {T.TStruct _val53 -> (to_SearchQuery (T.TStruct _val53)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),- searchResult_searchResultItems = P.maybe (P.Nothing) (\(_,_val51) -> P.Just (case _val51 of {T.TList _ _val54 -> (Vector.fromList $ P.map (\_v55 -> (case _v55 of {T.TStruct _val56 -> (to_SearchResultItem (T.TStruct _val56)); _ -> P.error "wrong type"})) _val54); _ -> P.error "wrong type"})) (Map.lookup (3) fields),- searchResult_metadata = P.maybe (P.Nothing) (\(_,_val51) -> P.Just (case _val51 of {T.TStruct _val57 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val57)); _ -> P.error "wrong type"})) (Map.lookup (4) fields),- searchResult_lang = P.maybe (P.Nothing) (\(_,_val51) -> P.Just (case _val51 of {T.TString _val58 -> E.decodeUtf8 _val58; _ -> P.error "wrong type"})) (Map.lookup (5) fields)+ searchResult_uuid = P.maybe (P.error "Missing required field: uuid") (\(_,_val54) -> (case _val54 of {T.TStruct _val55 -> (Uuid_Types.to_UUID (T.TStruct _val55)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ searchResult_searchQuery = P.maybe (P.error "Missing required field: searchQuery") (\(_,_val54) -> (case _val54 of {T.TStruct _val56 -> (to_SearchQuery (T.TStruct _val56)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ searchResult_searchResultItems = P.maybe (P.Nothing) (\(_,_val54) -> P.Just (case _val54 of {T.TList _ _val57 -> (Vector.fromList $ P.map (\_v58 -> (case _v58 of {T.TStruct _val59 -> (to_SearchResultItem (T.TStruct _val59)); _ -> P.error "wrong type"})) _val57); _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ searchResult_metadata = P.maybe (P.Nothing) (\(_,_val54) -> P.Just (case _val54 of {T.TStruct _val60 -> (Metadata_Types.to_AnnotationMetadata (T.TStruct _val60)); _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ searchResult_lang = P.maybe (P.Nothing) (\(_,_val54) -> P.Just (case _val54 of {T.TString _val61 -> E.decodeUtf8 _val61; _ -> P.error "wrong type"})) (Map.lookup (5) fields) } to_SearchResult _ = P.error "not a struct" read_SearchResult :: (T.Transport t, T.Protocol p) => p t -> P.IO SearchResult
+ src/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 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/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 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/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 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/Services_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -40,14 +40,16 @@ import qualified Uuid_Types -data AnnotationTaskType = TRANSLATION|NER deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)+data AnnotationTaskType = TRANSLATION|NER|TOPICID deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded) instance P.Enum AnnotationTaskType where fromEnum t = case t of TRANSLATION -> 1 NER -> 2+ TOPICID -> 3 toEnum t = case t of 1 -> TRANSLATION 2 -> NER+ 3 -> TOPICID _ -> X.throw T.ThriftException instance H.Hashable AnnotationTaskType where hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum@@ -83,7 +85,7 @@ from_ServicesException :: ServicesException -> T.ThriftVal from_ServicesException record = T.TStruct $ Map.fromList $ M.catMaybes [ (\_v2 -> P.Just (1, ("message",T.TString $ E.encodeUtf8 _v2))) $ servicesException_message record- , (\_v2 -> (2, ("serEx",T.TString _v2))) <$> servicesException_serEx record+ , (\_v2 -> (2, ("serEx",T.TBinary _v2))) <$> servicesException_serEx record ] write_ServicesException :: (T.Protocol p, T.Transport t) => p t -> ServicesException -> P.IO () write_ServicesException oprot record = T.writeVal oprot $ from_ServicesException record@@ -92,7 +94,7 @@ to_ServicesException :: T.ThriftVal -> ServicesException to_ServicesException (T.TStruct fields) = ServicesException{ servicesException_message = P.maybe (P.error "Missing required field: message") (\(_,_val4) -> (case _val4 of {T.TString _val5 -> E.decodeUtf8 _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),- servicesException_serEx = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ servicesException_serEx = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val6 -> _val6; T.TString _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields) } to_ServicesException _ = P.error "not a struct" read_ServicesException :: (T.Transport t, T.Protocol p) => p t -> P.IO ServicesException@@ -100,7 +102,7 @@ decode_ServicesException :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> ServicesException decode_ServicesException iprot bs = to_ServicesException $ T.deserializeVal iprot (T.T_STRUCT typemap_ServicesException) bs typemap_ServicesException :: T.TypeMap-typemap_ServicesException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_STRING))]+typemap_ServicesException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_BINARY))] default_ServicesException :: ServicesException default_ServicesException = ServicesException{ servicesException_message = "",@@ -122,7 +124,7 @@ from_NotImplementedException :: NotImplementedException -> T.ThriftVal from_NotImplementedException record = T.TStruct $ Map.fromList $ M.catMaybes [ (\_v9 -> P.Just (1, ("message",T.TString $ E.encodeUtf8 _v9))) $ notImplementedException_message record- , (\_v9 -> (2, ("serEx",T.TString _v9))) <$> notImplementedException_serEx record+ , (\_v9 -> (2, ("serEx",T.TBinary _v9))) <$> notImplementedException_serEx record ] write_NotImplementedException :: (T.Protocol p, T.Transport t) => p t -> NotImplementedException -> P.IO () write_NotImplementedException oprot record = T.writeVal oprot $ from_NotImplementedException record@@ -131,7 +133,7 @@ to_NotImplementedException :: T.ThriftVal -> NotImplementedException to_NotImplementedException (T.TStruct fields) = NotImplementedException{ notImplementedException_message = P.maybe (P.error "Missing required field: message") (\(_,_val11) -> (case _val11 of {T.TString _val12 -> E.decodeUtf8 _val12; _ -> P.error "wrong type"})) (Map.lookup (1) fields),- notImplementedException_serEx = P.maybe (P.Nothing) (\(_,_val11) -> P.Just (case _val11 of {T.TString _val13 -> _val13; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ notImplementedException_serEx = P.maybe (P.Nothing) (\(_,_val11) -> P.Just (case _val11 of {T.TBinary _val13 -> _val13; T.TString _val13 -> _val13; _ -> P.error "wrong type"})) (Map.lookup (2) fields) } to_NotImplementedException _ = P.error "not a struct" read_NotImplementedException :: (T.Transport t, T.Protocol p) => p t -> P.IO NotImplementedException@@ -139,7 +141,7 @@ decode_NotImplementedException :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> NotImplementedException decode_NotImplementedException iprot bs = to_NotImplementedException $ T.deserializeVal iprot (T.T_STRUCT typemap_NotImplementedException) bs typemap_NotImplementedException :: T.TypeMap-typemap_NotImplementedException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_STRING))]+typemap_NotImplementedException = Map.fromList [(1,("message",T.T_STRING)),(2,("serEx",T.T_BINARY))] default_NotImplementedException :: NotImplementedException default_NotImplementedException = NotImplementedException{ notImplementedException_message = "",
src/Situations_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Spans_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
+ src/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 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/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 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/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 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/Structure_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------@@ -702,8 +702,8 @@ typemap_TokenLattice = Map.fromList [(1,("startState",T.T_I32)),(2,("endState",T.T_I32)),(3,("arcList",(T.T_LIST (T.T_STRUCT typemap_Arc)))),(4,("cachedBestPath",(T.T_STRUCT typemap_LatticePath)))] default_TokenLattice :: TokenLattice default_TokenLattice = TokenLattice{- tokenLattice_startState = P.Just 0,- tokenLattice_endState = P.Just 0,+ tokenLattice_startState = P.Just (0),+ tokenLattice_endState = P.Just (0), tokenLattice_arcList = Vector.empty, tokenLattice_cachedBestPath = P.Nothing} data TokenList = TokenList { tokenList_tokenList :: (Vector.Vector Token)
+ src/Summarization_Types.hs view
@@ -0,0 +1,248 @@+{-# 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_Types 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+++data SummarySourceType = DOCUMENT|TOKENIZATION|ENTITY deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)+instance P.Enum SummarySourceType where+ fromEnum t = case t of+ DOCUMENT -> 0+ TOKENIZATION -> 1+ ENTITY -> 2+ toEnum t = case t of+ 0 -> DOCUMENT+ 1 -> TOKENIZATION+ 2 -> ENTITY+ _ -> X.throw T.ThriftException+instance H.Hashable SummarySourceType where+ hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum+instance QC.Arbitrary SummarySourceType where+ arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)+data SummarizationRequest = SummarizationRequest { summarizationRequest_queryTerms :: P.Maybe (Vector.Vector LT.Text)+ , summarizationRequest_maximumTokens :: P.Maybe I.Int32+ , summarizationRequest_maximumCharacters :: P.Maybe I.Int32+ , summarizationRequest_sourceType :: P.Maybe SummarySourceType+ , summarizationRequest_sourceIds :: P.Maybe (Vector.Vector Uuid_Types.UUID)+ , summarizationRequest_sourceCommunication :: P.Maybe Communication_Types.Communication+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SummarizationRequest where+ hashWithSalt salt record = salt `H.hashWithSalt` summarizationRequest_queryTerms record `H.hashWithSalt` summarizationRequest_maximumTokens record `H.hashWithSalt` summarizationRequest_maximumCharacters record `H.hashWithSalt` summarizationRequest_sourceType record `H.hashWithSalt` summarizationRequest_sourceIds record `H.hashWithSalt` summarizationRequest_sourceCommunication record +instance QC.Arbitrary SummarizationRequest where + arbitrary = M.liftM SummarizationRequest (M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_SummarizationRequest = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SummarizationRequest{summarizationRequest_queryTerms = summarizationRequest_queryTerms obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_queryTerms = summarizationRequest_queryTerms obj}+ , if obj == default_SummarizationRequest{summarizationRequest_maximumTokens = summarizationRequest_maximumTokens obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_maximumTokens = summarizationRequest_maximumTokens obj}+ , if obj == default_SummarizationRequest{summarizationRequest_maximumCharacters = summarizationRequest_maximumCharacters obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_maximumCharacters = summarizationRequest_maximumCharacters obj}+ , if obj == default_SummarizationRequest{summarizationRequest_sourceType = summarizationRequest_sourceType obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_sourceType = summarizationRequest_sourceType obj}+ , if obj == default_SummarizationRequest{summarizationRequest_sourceIds = summarizationRequest_sourceIds obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_sourceIds = summarizationRequest_sourceIds obj}+ , if obj == default_SummarizationRequest{summarizationRequest_sourceCommunication = summarizationRequest_sourceCommunication obj} then P.Nothing else P.Just $ default_SummarizationRequest{summarizationRequest_sourceCommunication = summarizationRequest_sourceCommunication obj}+ ]+from_SummarizationRequest :: SummarizationRequest -> T.ThriftVal+from_SummarizationRequest record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> (1, ("queryTerms",T.TList T.T_STRING $ P.map (\_v4 -> T.TString $ E.encodeUtf8 _v4) $ Vector.toList _v2))) <$> summarizationRequest_queryTerms record+ , (\_v2 -> (2, ("maximumTokens",T.TI32 _v2))) <$> summarizationRequest_maximumTokens record+ , (\_v2 -> (3, ("maximumCharacters",T.TI32 _v2))) <$> summarizationRequest_maximumCharacters record+ , (\_v2 -> (4, ("sourceType",T.TI32 $ P.fromIntegral $ P.fromEnum _v2))) <$> summarizationRequest_sourceType record+ , (\_v2 -> (5, ("sourceIds",T.TList (T.T_STRUCT Uuid_Types.typemap_UUID) $ P.map (\_v6 -> Uuid_Types.from_UUID _v6) $ Vector.toList _v2))) <$> summarizationRequest_sourceIds record+ , (\_v2 -> (6, ("sourceCommunication",Communication_Types.from_Communication _v2))) <$> summarizationRequest_sourceCommunication record+ ]+write_SummarizationRequest :: (T.Protocol p, T.Transport t) => p t -> SummarizationRequest -> P.IO ()+write_SummarizationRequest oprot record = T.writeVal oprot $ from_SummarizationRequest record+encode_SummarizationRequest :: (T.Protocol p, T.Transport t) => p t -> SummarizationRequest -> LBS.ByteString+encode_SummarizationRequest oprot record = T.serializeVal oprot $ from_SummarizationRequest record+to_SummarizationRequest :: T.ThriftVal -> SummarizationRequest+to_SummarizationRequest (T.TStruct fields) = SummarizationRequest{+ summarizationRequest_queryTerms = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TList _ _val9 -> (Vector.fromList $ P.map (\_v10 -> (case _v10 of {T.TString _val11 -> E.decodeUtf8 _val11; _ -> P.error "wrong type"})) _val9); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ summarizationRequest_maximumTokens = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TI32 _val12 -> _val12; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ summarizationRequest_maximumCharacters = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TI32 _val13 -> _val13; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ summarizationRequest_sourceType = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TI32 _val14 -> P.toEnum $ P.fromIntegral _val14; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ summarizationRequest_sourceIds = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TList _ _val15 -> (Vector.fromList $ P.map (\_v16 -> (case _v16 of {T.TStruct _val17 -> (Uuid_Types.to_UUID (T.TStruct _val17)); _ -> P.error "wrong type"})) _val15); _ -> P.error "wrong type"})) (Map.lookup (5) fields),+ summarizationRequest_sourceCommunication = P.maybe (P.Nothing) (\(_,_val8) -> P.Just (case _val8 of {T.TStruct _val18 -> (Communication_Types.to_Communication (T.TStruct _val18)); _ -> P.error "wrong type"})) (Map.lookup (6) fields)+ }+to_SummarizationRequest _ = P.error "not a struct"+read_SummarizationRequest :: (T.Transport t, T.Protocol p) => p t -> P.IO SummarizationRequest+read_SummarizationRequest iprot = to_SummarizationRequest <$> T.readVal iprot (T.T_STRUCT typemap_SummarizationRequest)+decode_SummarizationRequest :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SummarizationRequest+decode_SummarizationRequest iprot bs = to_SummarizationRequest $ T.deserializeVal iprot (T.T_STRUCT typemap_SummarizationRequest) bs+typemap_SummarizationRequest :: T.TypeMap+typemap_SummarizationRequest = Map.fromList [(1,("queryTerms",(T.T_LIST T.T_STRING))),(2,("maximumTokens",T.T_I32)),(3,("maximumCharacters",T.T_I32)),(4,("sourceType",T.T_I32)),(5,("sourceIds",(T.T_LIST (T.T_STRUCT Uuid_Types.typemap_UUID)))),(6,("sourceCommunication",(T.T_STRUCT Communication_Types.typemap_Communication)))]+default_SummarizationRequest :: SummarizationRequest+default_SummarizationRequest = SummarizationRequest{+ summarizationRequest_queryTerms = P.Nothing,+ summarizationRequest_maximumTokens = P.Nothing,+ summarizationRequest_maximumCharacters = P.Nothing,+ summarizationRequest_sourceType = P.Nothing,+ summarizationRequest_sourceIds = P.Nothing,+ summarizationRequest_sourceCommunication = P.Nothing}+data Summary = Summary { summary_summaryCommunication :: P.Maybe Communication_Types.Communication+ , summary_concepts :: P.Maybe (Vector.Vector SummaryConcept)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Summary where+ hashWithSalt salt record = salt `H.hashWithSalt` summary_summaryCommunication record `H.hashWithSalt` summary_concepts record +instance QC.Arbitrary Summary where + arbitrary = M.liftM Summary (M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Summary = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Summary{summary_summaryCommunication = summary_summaryCommunication obj} then P.Nothing else P.Just $ default_Summary{summary_summaryCommunication = summary_summaryCommunication obj}+ , if obj == default_Summary{summary_concepts = summary_concepts obj} then P.Nothing else P.Just $ default_Summary{summary_concepts = summary_concepts obj}+ ]+from_Summary :: Summary -> T.ThriftVal+from_Summary record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v21 -> (1, ("summaryCommunication",Communication_Types.from_Communication _v21))) <$> summary_summaryCommunication record+ , (\_v21 -> (2, ("concepts",T.TList (T.T_STRUCT typemap_SummaryConcept) $ P.map (\_v23 -> from_SummaryConcept _v23) $ Vector.toList _v21))) <$> summary_concepts record+ ]+write_Summary :: (T.Protocol p, T.Transport t) => p t -> Summary -> P.IO ()+write_Summary oprot record = T.writeVal oprot $ from_Summary record+encode_Summary :: (T.Protocol p, T.Transport t) => p t -> Summary -> LBS.ByteString+encode_Summary oprot record = T.serializeVal oprot $ from_Summary record+to_Summary :: T.ThriftVal -> Summary+to_Summary (T.TStruct fields) = Summary{+ summary_summaryCommunication = P.maybe (P.Nothing) (\(_,_val25) -> P.Just (case _val25 of {T.TStruct _val26 -> (Communication_Types.to_Communication (T.TStruct _val26)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ summary_concepts = P.maybe (P.Nothing) (\(_,_val25) -> P.Just (case _val25 of {T.TList _ _val27 -> (Vector.fromList $ P.map (\_v28 -> (case _v28 of {T.TStruct _val29 -> (to_SummaryConcept (T.TStruct _val29)); _ -> P.error "wrong type"})) _val27); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Summary _ = P.error "not a struct"+read_Summary :: (T.Transport t, T.Protocol p) => p t -> P.IO Summary+read_Summary iprot = to_Summary <$> T.readVal iprot (T.T_STRUCT typemap_Summary)+decode_Summary :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Summary+decode_Summary iprot bs = to_Summary $ T.deserializeVal iprot (T.T_STRUCT typemap_Summary) bs+typemap_Summary :: T.TypeMap+typemap_Summary = Map.fromList [(1,("summaryCommunication",(T.T_STRUCT Communication_Types.typemap_Communication))),(2,("concepts",(T.T_LIST (T.T_STRUCT typemap_SummaryConcept))))]+default_Summary :: Summary+default_Summary = Summary{+ summary_summaryCommunication = P.Nothing,+ summary_concepts = P.Nothing}+data SummaryConcept = SummaryConcept { summaryConcept_tokens :: P.Maybe Structure_Types.TokenRefSequence+ , summaryConcept_concept :: P.Maybe LT.Text+ , summaryConcept_confidence :: P.Maybe P.Double+ , summaryConcept_utility :: P.Maybe P.Double+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SummaryConcept where+ hashWithSalt salt record = salt `H.hashWithSalt` summaryConcept_tokens record `H.hashWithSalt` summaryConcept_concept record `H.hashWithSalt` summaryConcept_confidence record `H.hashWithSalt` summaryConcept_utility record +instance QC.Arbitrary SummaryConcept where + arbitrary = M.liftM SummaryConcept (M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_SummaryConcept = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SummaryConcept{summaryConcept_tokens = summaryConcept_tokens obj} then P.Nothing else P.Just $ default_SummaryConcept{summaryConcept_tokens = summaryConcept_tokens obj}+ , if obj == default_SummaryConcept{summaryConcept_concept = summaryConcept_concept obj} then P.Nothing else P.Just $ default_SummaryConcept{summaryConcept_concept = summaryConcept_concept obj}+ , if obj == default_SummaryConcept{summaryConcept_confidence = summaryConcept_confidence obj} then P.Nothing else P.Just $ default_SummaryConcept{summaryConcept_confidence = summaryConcept_confidence obj}+ , if obj == default_SummaryConcept{summaryConcept_utility = summaryConcept_utility obj} then P.Nothing else P.Just $ default_SummaryConcept{summaryConcept_utility = summaryConcept_utility obj}+ ]+from_SummaryConcept :: SummaryConcept -> T.ThriftVal+from_SummaryConcept record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v32 -> (1, ("tokens",Structure_Types.from_TokenRefSequence _v32))) <$> summaryConcept_tokens record+ , (\_v32 -> (2, ("concept",T.TString $ E.encodeUtf8 _v32))) <$> summaryConcept_concept record+ , (\_v32 -> (3, ("confidence",T.TDouble _v32))) <$> summaryConcept_confidence record+ , (\_v32 -> (4, ("utility",T.TDouble _v32))) <$> summaryConcept_utility record+ ]+write_SummaryConcept :: (T.Protocol p, T.Transport t) => p t -> SummaryConcept -> P.IO ()+write_SummaryConcept oprot record = T.writeVal oprot $ from_SummaryConcept record+encode_SummaryConcept :: (T.Protocol p, T.Transport t) => p t -> SummaryConcept -> LBS.ByteString+encode_SummaryConcept oprot record = T.serializeVal oprot $ from_SummaryConcept record+to_SummaryConcept :: T.ThriftVal -> SummaryConcept+to_SummaryConcept (T.TStruct fields) = SummaryConcept{+ summaryConcept_tokens = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TStruct _val35 -> (Structure_Types.to_TokenRefSequence (T.TStruct _val35)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ summaryConcept_concept = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TString _val36 -> E.decodeUtf8 _val36; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ summaryConcept_confidence = P.maybe (summaryConcept_confidence default_SummaryConcept) (\(_,_val34) -> P.Just (case _val34 of {T.TDouble _val37 -> _val37; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ summaryConcept_utility = P.maybe (summaryConcept_utility default_SummaryConcept) (\(_,_val34) -> P.Just (case _val34 of {T.TDouble _val38 -> _val38; _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_SummaryConcept _ = P.error "not a struct"+read_SummaryConcept :: (T.Transport t, T.Protocol p) => p t -> P.IO SummaryConcept+read_SummaryConcept iprot = to_SummaryConcept <$> T.readVal iprot (T.T_STRUCT typemap_SummaryConcept)+decode_SummaryConcept :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SummaryConcept+decode_SummaryConcept iprot bs = to_SummaryConcept $ T.deserializeVal iprot (T.T_STRUCT typemap_SummaryConcept) bs+typemap_SummaryConcept :: T.TypeMap+typemap_SummaryConcept = Map.fromList [(1,("tokens",(T.T_STRUCT Structure_Types.typemap_TokenRefSequence))),(2,("concept",T.T_STRING)),(3,("confidence",T.T_DOUBLE)),(4,("utility",T.T_DOUBLE))]+default_SummaryConcept :: SummaryConcept+default_SummaryConcept = SummaryConcept{+ summaryConcept_tokens = P.Nothing,+ summaryConcept_concept = P.Nothing,+ summaryConcept_confidence = P.Just (1),+ summaryConcept_utility = P.Just (1)}+data SummarizationCapability = SummarizationCapability { summarizationCapability_type :: SummarySourceType+ , summarizationCapability_lang :: LT.Text+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SummarizationCapability where+ hashWithSalt salt record = salt `H.hashWithSalt` summarizationCapability_type record `H.hashWithSalt` summarizationCapability_lang record +instance QC.Arbitrary SummarizationCapability where + arbitrary = M.liftM SummarizationCapability (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SummarizationCapability = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SummarizationCapability{summarizationCapability_type = summarizationCapability_type obj} then P.Nothing else P.Just $ default_SummarizationCapability{summarizationCapability_type = summarizationCapability_type obj}+ , if obj == default_SummarizationCapability{summarizationCapability_lang = summarizationCapability_lang obj} then P.Nothing else P.Just $ default_SummarizationCapability{summarizationCapability_lang = summarizationCapability_lang obj}+ ]+from_SummarizationCapability :: SummarizationCapability -> T.ThriftVal+from_SummarizationCapability record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v41 -> P.Just (1, ("type",T.TI32 $ P.fromIntegral $ P.fromEnum _v41))) $ summarizationCapability_type record+ , (\_v41 -> P.Just (2, ("lang",T.TString $ E.encodeUtf8 _v41))) $ summarizationCapability_lang record+ ]+write_SummarizationCapability :: (T.Protocol p, T.Transport t) => p t -> SummarizationCapability -> P.IO ()+write_SummarizationCapability oprot record = T.writeVal oprot $ from_SummarizationCapability record+encode_SummarizationCapability :: (T.Protocol p, T.Transport t) => p t -> SummarizationCapability -> LBS.ByteString+encode_SummarizationCapability oprot record = T.serializeVal oprot $ from_SummarizationCapability record+to_SummarizationCapability :: T.ThriftVal -> SummarizationCapability+to_SummarizationCapability (T.TStruct fields) = SummarizationCapability{+ summarizationCapability_type = P.maybe (P.error "Missing required field: type") (\(_,_val43) -> (case _val43 of {T.TI32 _val44 -> P.toEnum $ P.fromIntegral _val44; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ summarizationCapability_lang = P.maybe (P.error "Missing required field: lang") (\(_,_val43) -> (case _val43 of {T.TString _val45 -> E.decodeUtf8 _val45; _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_SummarizationCapability _ = P.error "not a struct"+read_SummarizationCapability :: (T.Transport t, T.Protocol p) => p t -> P.IO SummarizationCapability+read_SummarizationCapability iprot = to_SummarizationCapability <$> T.readVal iprot (T.T_STRUCT typemap_SummarizationCapability)+decode_SummarizationCapability :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> SummarizationCapability+decode_SummarizationCapability iprot bs = to_SummarizationCapability $ T.deserializeVal iprot (T.T_STRUCT typemap_SummarizationCapability) bs+typemap_SummarizationCapability :: T.TypeMap+typemap_SummarizationCapability = Map.fromList [(1,("type",T.T_I32)),(2,("lang",T.T_STRING))]+default_SummarizationCapability :: SummarizationCapability+default_SummarizationCapability = SummarizationCapability{+ summarizationCapability_type = (P.toEnum 0),+ summarizationCapability_lang = ""}
src/Twitter_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
src/Uuid_Types.hs view
@@ -8,7 +8,7 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -------------------------------------------------------------------- Autogenerated by Thrift Compiler (0.9.3) --+-- Autogenerated by Thrift Compiler (0.10.0) -- -- -- -- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING -- -----------------------------------------------------------------
+ utils/IngestJson.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts, GADTs, MultiParamTypeClasses, FlexibleInstances, RecordWildCards #-}+module Main (main) where++import qualified Data.ByteString.Lazy as BS+import Control.Monad.IO.Class (liftIO)+import qualified Data.Map as M+import Data.Functor (($>))+import Data.List (intercalate)+import Control.Applicative (empty)+import Data.Monoid ((<>))+import Control.Monad (void, join, liftM)+import Data.Text.Lazy (Text, unpack, take)+import qualified Data.Text.Lazy as T+import Data.Text.Lazy.Encoding (decodeUtf8)+import Data.Vector (Vector, fromList, snoc, empty)+import Data.List (isSuffixOf, reverse, drop)+import qualified Control.Monad.State as S+import qualified Control.Monad.Identity as I+import qualified Data.List.NonEmpty as NE++import System.FilePath (takeExtension)+import qualified Codec.Compression.GZip as GZip++import qualified Options.Applicative as O+import Options.Applicative (option, auto, short, long, metavar, strOption, help, execParser, info, helper, fullDesc, progDesc, many)++import Text.Megaparsec.Char (spaceChar, char)+import qualified Text.Megaparsec.Lexer as L+import Text.Megaparsec.Combinator (choice, sepBy, sepBy1, between)+import Text.Megaparsec.Error (Dec)+import Text.Megaparsec.Pos (defaultTabWidth)+import Text.Megaparsec.Prim (Parsec, ParsecT, setTokensProcessed)+import Text.Megaparsec ( parseErrorPretty+ , many+ , eof+ , (<|>)+ , space+ , try+ , hexDigitChar+ , count+ , manyTill+ , anyChar+ , getParserState+ , State(..)+ , ParsecT+ , SourcePos(..)+ , Pos(..)+ , initialPos+ , runParserT+ , runParserT'+ , some+ )++import Data.Concrete ( read_Communication+ , write_Communication+ , default_Communication+ , Communication(..)+ , default_Section+ , Section(..)+ , default_AnnotationMetadata+ , AnnotationMetadata(..)+ , default_CommunicationMetadata+ , CommunicationMetadata(..)+ , default_Sentence+ , Sentence(..)+ , default_TextSpan+ , TextSpan(..)+ )++import qualified Data.Concrete.Utils as CU+import qualified Data.Concrete as C++type Parser = Parsec Dec Text++data JSON = JNumber Double+ | JString String+ | JArray [JSON]+ | JObject (M.Map String JSON)+ | JBool Bool+ | JNull+ deriving (Show)++data BuildState = BuildState { path :: [String]+ , sections :: [Section]+ , comms :: [Communication]+ , offset :: Int+ , id :: Maybe String+ }++type CommunicationParser a = ParsecT Dec Text (S.StateT BuildState IO) a ++jsonCP :: CommunicationParser JSON+jsonCP = do+ s <- (fromIntegral . stateTokensProcessed) <$> getParserState + j <- lexeme $ choice [nullP, numberP, stringP, boolP, objectP, arrayP]+ e <- (fromIntegral . stateTokensProcessed) <$> getParserState+ bs@(BuildState {..}) <- S.get+ uuid <- liftIO CU.getUUID+ let path' = T.pack (intercalate "." (reverse path))+ section = default_Section { section_uuid=uuid+ , section_label=Just path'+ , section_textSpan=Just $ TextSpan (s - (fromIntegral offset)) (e - (fromIntegral offset))+ , section_kind="metadata"+ }+ S.put $ bs { sections=section:sections }+ return j++nullP = do+ symbol "null"+ return $ JNull+ +boolP = do+ c <- symbol "true" <|> symbol "false"+ return $ JBool (c == "true")+ +numberP = do+ c <- L.signed (pure ()) (try L.float <|> (fromInteger <$> L.integer))+ return $ JNumber c++escapedChar = do+ char '\\'+ choice [+ char '\"' $> '\"', -- A boring list of hardcoded values from the spec.+ char '\\' $> '\\',+ char '/' $> '/' ,+ char 'n' $> '\n',+ char 'r' $> '\r',+ char 'f' $> '\f',+ char 't' $> '\t',+ char 'b' $> '\b',+ unicodeEscape ]++unicodeEscape = do+ char 'u'+ code <- count 4 hexDigitChar+ return $ toEnum (read ("0x" ++ code))++stringLiteral = lexeme $ do + char '\"'+ (escapedChar <|> anyChar) `manyTill` char '\"'++stringP = do+ c <- stringLiteral+ return $ JString c++arrayEntryP = do+ bs@(BuildState{..}) <- S.get+ let p = (read $ head path) :: Int+ S.put $ bs { path=(show (p + 1)):(tail path) } + jsonCP+ +arrayP = do+ S.modify' (\ bs@(BuildState{..}) -> bs { path=(show (-1)):path })+ c <- brackets (arrayEntryP `sepBy` comma)+ S.modify' (\ bs@(BuildState{..}) -> bs { path=tail path})+ return $ JArray c+ +pairP = do+ key <- stringLiteral+ symbol ":"+ S.modify' (\ bs@(BuildState{..}) -> bs { path=key:path })+ value <- jsonCP+ S.modify' (\ bs@(BuildState{..}) -> bs { path=tail path})+ return (key, value)++objectP = do+ c <- M.fromList <$> braces (pairP `sepBy` comma)+ return $ JObject c++topLevelObjectP t = do+ offset <- (fromIntegral . stateTokensProcessed) <$> getParserState+ S.modify (\bs -> bs { offset=offset })+ objectP+ end <- (fromIntegral . stateTokensProcessed) <$> getParserState+ let t' = substr t offset end+ uuid <- liftIO CU.getUUID+ S.modify (\ bs@(BuildState{..}) -> bs { sections=[]+ , comms=(default_Communication { communication_id=C.uUID_uuidString uuid+ , communication_uuid=uuid+ , communication_text=Just $ T.pack t'+ , communication_sectionList=(Just . fromList . reverse) sections+ }):comms+ })++symbol = L.symbol space+brackets = between (symbol "[") (symbol "]")+braces = between (symbol "{") (symbol "}")+lexeme = L.lexeme space+comma = symbol ","++substr :: Text -> Int -> Int -> String+substr t s e = unpack res+ where+ (_, start) = T.splitAt (fromIntegral s) t + res = T.take (fromIntegral $ e - s) start++data Parameters = Parameters { inputFile :: String+ , outputFile :: String+ , commType :: String+ , commId :: String+ , contentSectionTypes :: [String]+ } deriving (Show)++parameters :: O.Parser Parameters+parameters = Parameters+ <$> strOption (short 'i'+ <> long "input"+ <> metavar "INPUT_FILE"+ <> help "Text file of JSON objects"+ )+ <*> strOption (short 'o'+ <> long "output"+ <> metavar "OUTPUT_FILE"+ <> help "Tar archive of 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\""+ ))++parseComms :: Text -> IO [Communication]+parseComms t = do+ let s = State { stateInput=t+ , statePos=NE.fromList $ [initialPos "JSON"]+ , stateTokensProcessed=0+ , stateTabWidth=defaultTabWidth+ }+ unwrapped = between space eof (some (topLevelObjectP t))+ wrapped = between space eof (brackets ((topLevelObjectP t) `sepBy` comma))+ (r, BuildState _ _ cs _ _) <- (S.runStateT (runParserT' (wrapped <|> unwrapped) s) (BuildState [] [] [] 0 Nothing))+ return cs++main = do+ ps <- execParser opts+ let f = inputFile ps+ t <- decodeUtf8 <$> case takeExtension f of+ ".gz" -> (liftM GZip.decompress . BS.readFile) f+ _ -> BS.readFile f+ cs <- parseComms t+ CU.writeCommunications (outputFile ps) cs+ where + opts = info (helper <*> parameters)+ ( fullDesc+ <> progDesc "Ingest JSON into Concrete Communications"+ )
+ utils/InspectCommunication.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts, GADTs, MultiParamTypeClasses, FlexibleInstances #-}+module Main (main) where++import Data.Monoid ((<>))+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)+import Data.List (intercalate, concat)+import qualified Data.Text.Lazy as T+import Data.Maybe (fromJust, catMaybes, maybeToList)++data Parameters = Parameters { inputFile :: String+ } deriving (Show)++parameters :: O.Parser Parameters+parameters = Parameters+ <$> strOption (short 'i'+ <> long "input"+ <> metavar "INPUT_FILE"+ <> help "Text file of JSON objects"+ )++showSection :: T.Text -> C.Section -> String+showSection t s = "\t" ++ ((T.unpack . fromJust . C.section_label) s) ++ "--->" ++ t'+ where+ C.TextSpan s' e' = (fromJust . C.section_textSpan) s+ t' = substr t (fromIntegral s') (fromIntegral e')++showCommunication :: C.Communication -> String+showCommunication c = (T.unpack $ (C.communication_id c)) ++ "\n" ++ (intercalate "\n" sects) ++ "\n"+ where+ ss = concat $ map V.toList (maybeToList (C.communication_sectionList c))+ t = (fromJust . C.communication_text) c+ sects = map (showSection t) ss+++substr :: T.Text -> Int -> Int -> String+substr t s e = T.unpack res+ where+ (_, start) = T.splitAt (fromIntegral s) t + res = T.take (fromIntegral $ e - s) start++main = do+ ps <- execParser opts+ cs <- CU.readCommunications (inputFile ps)+ putStr $ intercalate "\n" (map show cs) ++ "\n"+ putStr $ intercalate "\n" [showCommunication c | c <- cs] ++ "\n"+ where+ opts = info (helper <*> parameters)+ ( fullDesc+ <> progDesc "Inspect a tar file of serialized Communications"+ )