concrete-haskell-0.1.0.9: src/ActiveLearnerServerService.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-----------------------------------------------------------------
-- Autogenerated by Thrift Compiler (0.10.0)                      --
--                                                             --
-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --
-----------------------------------------------------------------

module ActiveLearnerServerService where
import Prelude (($), (.), (>>=), (==), (++))
import qualified Prelude as P
import qualified Control.Exception as X
import qualified Control.Monad as M ( liftM, ap, when )
import Data.Functor ( (<$>) )
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Hashable as H
import qualified Data.Int as I
import qualified Data.Maybe as M (catMaybes)
import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )
import qualified Data.Text.Lazy as LT
import qualified GHC.Generics as G (Generic)
import qualified Data.Typeable as TY ( Typeable )
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import qualified Data.Vector as Vector
import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )
import qualified Test.QuickCheck as QC ( elements )

import qualified Thrift as T
import qualified Thrift.Types as T
import qualified Thrift.Arbitraries as T

import qualified Services_Types
import qualified Uuid_Types
import qualified Communication_Types


import qualified Service
import Learn_Types
import qualified ActiveLearnerServerService_Iface as Iface
-- HELPER FUNCTIONS AND STRUCTURES --

data Start_args = Start_args  { start_args_sessionId :: Uuid_Types.UUID
  , start_args_task :: AnnotationTask
  , start_args_contact :: Services_Types.AsyncContactInfo
  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable Start_args where
  hashWithSalt salt record = salt   `H.hashWithSalt` start_args_sessionId record   `H.hashWithSalt` start_args_task record   `H.hashWithSalt` start_args_contact record  
instance QC.Arbitrary Start_args where 
  arbitrary = M.liftM Start_args (QC.arbitrary)
          `M.ap`(QC.arbitrary)
          `M.ap`(QC.arbitrary)
  shrink obj | obj == default_Start_args = []
             | P.otherwise = M.catMaybes
    [ if obj == default_Start_args{start_args_sessionId = start_args_sessionId obj} then P.Nothing else P.Just $ default_Start_args{start_args_sessionId = start_args_sessionId obj}
    , if obj == default_Start_args{start_args_task = start_args_task obj} then P.Nothing else P.Just $ default_Start_args{start_args_task = start_args_task obj}
    , if obj == default_Start_args{start_args_contact = start_args_contact obj} then P.Nothing else P.Just $ default_Start_args{start_args_contact = start_args_contact obj}
    ]
from_Start_args :: Start_args -> T.ThriftVal
from_Start_args record = T.TStruct $ Map.fromList $ M.catMaybes
  [ (\_v22 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v22))) $ start_args_sessionId record
  , (\_v22 -> P.Just (2, ("task",from_AnnotationTask _v22))) $ start_args_task record
  , (\_v22 -> P.Just (3, ("contact",Services_Types.from_AsyncContactInfo _v22))) $ start_args_contact record
  ]
write_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> P.IO ()
write_Start_args oprot record = T.writeVal oprot $ from_Start_args record
encode_Start_args :: (T.Protocol p, T.Transport t) => p t -> Start_args -> LBS.ByteString
encode_Start_args oprot record = T.serializeVal oprot $ from_Start_args record
to_Start_args :: T.ThriftVal -> Start_args
to_Start_args (T.TStruct fields) = Start_args{
  start_args_sessionId = P.maybe (start_args_sessionId default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val25 -> (Uuid_Types.to_UUID (T.TStruct _val25)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),
  start_args_task = P.maybe (start_args_task default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val26 -> (to_AnnotationTask (T.TStruct _val26)); _ -> P.error "wrong type"})) (Map.lookup (2) fields),
  start_args_contact = P.maybe (start_args_contact default_Start_args) (\(_,_val24) -> (case _val24 of {T.TStruct _val27 -> (Services_Types.to_AsyncContactInfo (T.TStruct _val27)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)
  }
to_Start_args _ = P.error "not a struct"
read_Start_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_args
read_Start_args iprot = to_Start_args <$> T.readVal iprot (T.T_STRUCT typemap_Start_args)
decode_Start_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_args
decode_Start_args iprot bs = to_Start_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_args) bs
typemap_Start_args :: T.TypeMap
typemap_Start_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("task",(T.T_STRUCT typemap_AnnotationTask))),(3,("contact",(T.T_STRUCT Services_Types.typemap_AsyncContactInfo)))]
default_Start_args :: Start_args
default_Start_args = Start_args{
  start_args_sessionId = Uuid_Types.default_UUID,
  start_args_task = default_AnnotationTask,
  start_args_contact = Services_Types.default_AsyncContactInfo}
data Start_result = Start_result  { start_result_success :: P.Bool
  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable Start_result where
  hashWithSalt salt record = salt   `H.hashWithSalt` start_result_success record  
instance QC.Arbitrary Start_result where 
  arbitrary = M.liftM Start_result (QC.arbitrary)
  shrink obj | obj == default_Start_result = []
             | P.otherwise = M.catMaybes
    [ if obj == default_Start_result{start_result_success = start_result_success obj} then P.Nothing else P.Just $ default_Start_result{start_result_success = start_result_success obj}
    ]
from_Start_result :: Start_result -> T.ThriftVal
from_Start_result record = T.TStruct $ Map.fromList $ M.catMaybes
  [ (\_v30 -> P.Just (0, ("success",T.TBool _v30))) $ start_result_success record
  ]
write_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> P.IO ()
write_Start_result oprot record = T.writeVal oprot $ from_Start_result record
encode_Start_result :: (T.Protocol p, T.Transport t) => p t -> Start_result -> LBS.ByteString
encode_Start_result oprot record = T.serializeVal oprot $ from_Start_result record
to_Start_result :: T.ThriftVal -> Start_result
to_Start_result (T.TStruct fields) = Start_result{
  start_result_success = P.maybe (start_result_success default_Start_result) (\(_,_val32) -> (case _val32 of {T.TBool _val33 -> _val33; _ -> P.error "wrong type"})) (Map.lookup (0) fields)
  }
to_Start_result _ = P.error "not a struct"
read_Start_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Start_result
read_Start_result iprot = to_Start_result <$> T.readVal iprot (T.T_STRUCT typemap_Start_result)
decode_Start_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Start_result
decode_Start_result iprot bs = to_Start_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Start_result) bs
typemap_Start_result :: T.TypeMap
typemap_Start_result = Map.fromList [(0,("success",T.T_BOOL))]
default_Start_result :: Start_result
default_Start_result = Start_result{
  start_result_success = P.False}
data Stop_args = Stop_args  { stop_args_sessionId :: Uuid_Types.UUID
  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable Stop_args where
  hashWithSalt salt record = salt   `H.hashWithSalt` stop_args_sessionId record  
instance QC.Arbitrary Stop_args where 
  arbitrary = M.liftM Stop_args (QC.arbitrary)
  shrink obj | obj == default_Stop_args = []
             | P.otherwise = M.catMaybes
    [ if obj == default_Stop_args{stop_args_sessionId = stop_args_sessionId obj} then P.Nothing else P.Just $ default_Stop_args{stop_args_sessionId = stop_args_sessionId obj}
    ]
from_Stop_args :: Stop_args -> T.ThriftVal
from_Stop_args record = T.TStruct $ Map.fromList $ M.catMaybes
  [ (\_v36 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v36))) $ stop_args_sessionId record
  ]
write_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> P.IO ()
write_Stop_args oprot record = T.writeVal oprot $ from_Stop_args record
encode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> Stop_args -> LBS.ByteString
encode_Stop_args oprot record = T.serializeVal oprot $ from_Stop_args record
to_Stop_args :: T.ThriftVal -> Stop_args
to_Stop_args (T.TStruct fields) = Stop_args{
  stop_args_sessionId = P.maybe (stop_args_sessionId default_Stop_args) (\(_,_val38) -> (case _val38 of {T.TStruct _val39 -> (Uuid_Types.to_UUID (T.TStruct _val39)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)
  }
to_Stop_args _ = P.error "not a struct"
read_Stop_args :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_args
read_Stop_args iprot = to_Stop_args <$> T.readVal iprot (T.T_STRUCT typemap_Stop_args)
decode_Stop_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_args
decode_Stop_args iprot bs = to_Stop_args $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_args) bs
typemap_Stop_args :: T.TypeMap
typemap_Stop_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID)))]
default_Stop_args :: Stop_args
default_Stop_args = Stop_args{
  stop_args_sessionId = Uuid_Types.default_UUID}
data Stop_result = Stop_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable Stop_result where
  hashWithSalt salt record = salt  
instance QC.Arbitrary Stop_result where 
  arbitrary = QC.elements [Stop_result]
from_Stop_result :: Stop_result -> T.ThriftVal
from_Stop_result record = T.TStruct $ Map.fromList $ M.catMaybes
  []
write_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> P.IO ()
write_Stop_result oprot record = T.writeVal oprot $ from_Stop_result record
encode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> Stop_result -> LBS.ByteString
encode_Stop_result oprot record = T.serializeVal oprot $ from_Stop_result record
to_Stop_result :: T.ThriftVal -> Stop_result
to_Stop_result (T.TStruct fields) = Stop_result{

  }
to_Stop_result _ = P.error "not a struct"
read_Stop_result :: (T.Transport t, T.Protocol p) => p t -> P.IO Stop_result
read_Stop_result iprot = to_Stop_result <$> T.readVal iprot (T.T_STRUCT typemap_Stop_result)
decode_Stop_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> Stop_result
decode_Stop_result iprot bs = to_Stop_result $ T.deserializeVal iprot (T.T_STRUCT typemap_Stop_result) bs
typemap_Stop_result :: T.TypeMap
typemap_Stop_result = Map.fromList []
default_Stop_result :: Stop_result
default_Stop_result = Stop_result{
}
data AddAnnotations_args = AddAnnotations_args  { addAnnotations_args_sessionId :: Uuid_Types.UUID
  , addAnnotations_args_annotations :: (Vector.Vector Annotation)
  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable AddAnnotations_args where
  hashWithSalt salt record = salt   `H.hashWithSalt` addAnnotations_args_sessionId record   `H.hashWithSalt` addAnnotations_args_annotations record  
instance QC.Arbitrary AddAnnotations_args where 
  arbitrary = M.liftM AddAnnotations_args (QC.arbitrary)
          `M.ap`(QC.arbitrary)
  shrink obj | obj == default_AddAnnotations_args = []
             | P.otherwise = M.catMaybes
    [ if obj == default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_sessionId = addAnnotations_args_sessionId obj}
    , if obj == default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj} then P.Nothing else P.Just $ default_AddAnnotations_args{addAnnotations_args_annotations = addAnnotations_args_annotations obj}
    ]
from_AddAnnotations_args :: AddAnnotations_args -> T.ThriftVal
from_AddAnnotations_args record = T.TStruct $ Map.fromList $ M.catMaybes
  [ (\_v47 -> P.Just (1, ("sessionId",Uuid_Types.from_UUID _v47))) $ addAnnotations_args_sessionId record
  , (\_v47 -> P.Just (2, ("annotations",T.TList (T.T_STRUCT typemap_Annotation) $ P.map (\_v49 -> from_Annotation _v49) $ Vector.toList _v47))) $ addAnnotations_args_annotations record
  ]
write_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> P.IO ()
write_AddAnnotations_args oprot record = T.writeVal oprot $ from_AddAnnotations_args record
encode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_args -> LBS.ByteString
encode_AddAnnotations_args oprot record = T.serializeVal oprot $ from_AddAnnotations_args record
to_AddAnnotations_args :: T.ThriftVal -> AddAnnotations_args
to_AddAnnotations_args (T.TStruct fields) = AddAnnotations_args{
  addAnnotations_args_sessionId = P.maybe (addAnnotations_args_sessionId default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TStruct _val52 -> (Uuid_Types.to_UUID (T.TStruct _val52)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),
  addAnnotations_args_annotations = P.maybe (addAnnotations_args_annotations default_AddAnnotations_args) (\(_,_val51) -> (case _val51 of {T.TList _ _val53 -> (Vector.fromList $ P.map (\_v54 -> (case _v54 of {T.TStruct _val55 -> (to_Annotation (T.TStruct _val55)); _ -> P.error "wrong type"})) _val53); _ -> P.error "wrong type"})) (Map.lookup (2) fields)
  }
to_AddAnnotations_args _ = P.error "not a struct"
read_AddAnnotations_args :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_args
read_AddAnnotations_args iprot = to_AddAnnotations_args <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_args)
decode_AddAnnotations_args :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_args
decode_AddAnnotations_args iprot bs = to_AddAnnotations_args $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_args) bs
typemap_AddAnnotations_args :: T.TypeMap
typemap_AddAnnotations_args = Map.fromList [(1,("sessionId",(T.T_STRUCT Uuid_Types.typemap_UUID))),(2,("annotations",(T.T_LIST (T.T_STRUCT typemap_Annotation))))]
default_AddAnnotations_args :: AddAnnotations_args
default_AddAnnotations_args = AddAnnotations_args{
  addAnnotations_args_sessionId = Uuid_Types.default_UUID,
  addAnnotations_args_annotations = Vector.empty}
data AddAnnotations_result = AddAnnotations_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)
instance H.Hashable AddAnnotations_result where
  hashWithSalt salt record = salt  
instance QC.Arbitrary AddAnnotations_result where 
  arbitrary = QC.elements [AddAnnotations_result]
from_AddAnnotations_result :: AddAnnotations_result -> T.ThriftVal
from_AddAnnotations_result record = T.TStruct $ Map.fromList $ M.catMaybes
  []
write_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> P.IO ()
write_AddAnnotations_result oprot record = T.writeVal oprot $ from_AddAnnotations_result record
encode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> AddAnnotations_result -> LBS.ByteString
encode_AddAnnotations_result oprot record = T.serializeVal oprot $ from_AddAnnotations_result record
to_AddAnnotations_result :: T.ThriftVal -> AddAnnotations_result
to_AddAnnotations_result (T.TStruct fields) = AddAnnotations_result{

  }
to_AddAnnotations_result _ = P.error "not a struct"
read_AddAnnotations_result :: (T.Transport t, T.Protocol p) => p t -> P.IO AddAnnotations_result
read_AddAnnotations_result iprot = to_AddAnnotations_result <$> T.readVal iprot (T.T_STRUCT typemap_AddAnnotations_result)
decode_AddAnnotations_result :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> AddAnnotations_result
decode_AddAnnotations_result iprot bs = to_AddAnnotations_result $ T.deserializeVal iprot (T.T_STRUCT typemap_AddAnnotations_result) bs
typemap_AddAnnotations_result :: T.TypeMap
typemap_AddAnnotations_result = Map.fromList []
default_AddAnnotations_result :: AddAnnotations_result
default_AddAnnotations_result = AddAnnotations_result{
}
process_start (seqid, iprot, oprot, handler) = do
  args <- read_Start_args iprot
  (X.catch
    (do
      val <- Iface.start handler (start_args_sessionId args) (start_args_task args) (start_args_contact args)
      let res = default_Start_result{start_result_success = val}
      T.writeMessageBegin oprot ("start", T.M_REPLY, seqid)
      write_Start_result oprot res
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot))
    ((\_ -> do
      T.writeMessageBegin oprot ("start", T.M_EXCEPTION, seqid)
      T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))
process_stop (seqid, iprot, oprot, handler) = do
  args <- read_Stop_args iprot
  (X.catch
    (do
      Iface.stop handler (stop_args_sessionId args)
      let res = default_Stop_result
      T.writeMessageBegin oprot ("stop", T.M_REPLY, seqid)
      write_Stop_result oprot res
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot))
    ((\_ -> do
      T.writeMessageBegin oprot ("stop", T.M_EXCEPTION, seqid)
      T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))
process_addAnnotations (seqid, iprot, oprot, handler) = do
  args <- read_AddAnnotations_args iprot
  (X.catch
    (do
      Iface.addAnnotations handler (addAnnotations_args_sessionId args) (addAnnotations_args_annotations args)
      let res = default_AddAnnotations_result
      T.writeMessageBegin oprot ("addAnnotations", T.M_REPLY, seqid)
      write_AddAnnotations_result oprot res
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot))
    ((\_ -> do
      T.writeMessageBegin oprot ("addAnnotations", T.M_EXCEPTION, seqid)
      T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN "")
      T.writeMessageEnd oprot
      T.tFlush (T.getTransport oprot)) :: X.SomeException -> P.IO ()))
proc_ handler (iprot,oprot) (name,typ,seqid) = case name of
  "start" -> process_start (seqid,iprot,oprot,handler)
  "stop" -> process_stop (seqid,iprot,oprot,handler)
  "addAnnotations" -> process_addAnnotations (seqid,iprot,oprot,handler)
  _ -> Service.proc_ handler (iprot,oprot) (name,typ,seqid)
process handler (iprot, oprot) = do
  (name, typ, seqid) <- T.readMessageBegin iprot
  proc_ handler (iprot,oprot) (name,typ,seqid)
  T.readMessageEnd iprot
  P.return P.True