{-# LANGUAGE PatternSynonyms, RecordWildCards #-} module Language.JavaScript.Host.YQL.Rest where import Control.Applicative ((<$>)) import Control.Lens import Control.Monad (forM) import Control.Monad.Trans.Class (lift) import qualified Data.Aeson as Aeson import qualified Data.ByteString.UTF8 as BS import qualified Data.ByteString.Lazy.UTF8 as LBS import Data.Default (def) import qualified Data.HashMap.Strict as HashMap (toList) import Data.String import qualified Data.Text as Text (unpack) import qualified Data.Vector as Vector (toList) import qualified Network.HTTP.Types as HTTP import Data.OpenDataTable import Data.YQL (YQLM) import qualified Data.YQL as Data import Data.YQL.Response (Response(..), pattern ResponseByteString, pattern ResponseJSON) import qualified Data.YQL.Response as Data.Response import Data.YQL.Result (Result(..)) import qualified Data.YQL.Result as Data.Result import qualified Data.YQL.Rest as Data.Rest import Language.JavaScript.Host import Language.JavaScript.Interpret import Language.JavaScript.SubType import qualified YQL.Rest as YQL import qualified Data.Map as Map (empty, fromList) request :: OpenDataTable -> Select -> JavaScriptT YQLM Object request OpenDataTable {..} s = do url <- lift . lift . use $ Data.rest . Data.Rest.url op <- use objectPrototypeObject fp <- use functionPrototypeObject yqlRestId <- createNextInternalId let yqlRestObj = Object yqlRestId yqlRestAcceptId <- createNextInternalId let yqlRestAcceptObj = Object yqlRestAcceptId yqlRestAcceptObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just (yqlRestAcceptCallImpl yqlRestObj), objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestAcceptObj ?= yqlRestAcceptObjInt yqlRestContentTypeId <- createNextInternalId let yqlRestContentTypeObj = Object yqlRestContentTypeId yqlRestContentTypeObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just (yqlRestContentTypeCallImpl yqlRestObj), objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestContentTypeObj ?= yqlRestContentTypeObjInt yqlRestDecompressId <- createNextInternalId let yqlRestDecompressObj = Object yqlRestDecompressId yqlRestDecompressObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just (yqlRestDecompressCallImpl yqlRestObj), objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestDecompressObj ?= yqlRestDecompressObjInt yqlRestDelId <- createNextInternalId let yqlRestDelObj = Object yqlRestDelId yqlRestDelObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestDelCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestDelObj ?= yqlRestDelObjInt yqlRestFallbackCharsetId <- createNextInternalId let yqlRestFallbackCharsetObj = Object yqlRestFallbackCharsetId yqlRestFallbackCharsetObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestFallbackCharsetCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestFallbackCharsetObj ?= yqlRestFallbackCharsetObjInt yqlRestFilterCharsId <- createNextInternalId let yqlRestFilterCharsObj = Object yqlRestFilterCharsId yqlRestFilterCharsObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestFilterCharsCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestFilterCharsObj ?= yqlRestFilterCharsObjInt yqlRestForceCharsetId <- createNextInternalId let yqlRestForceCharsetObj = Object yqlRestForceCharsetId yqlRestForceCharsetObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestForceCharsetCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestForceCharsetObj ?= yqlRestForceCharsetObjInt yqlRestGetId <- createNextInternalId let yqlRestGetObj = Object yqlRestGetId yqlRestGetObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestGetCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestGetObj ?= yqlRestGetObjInt yqlRestHeadId <- createNextInternalId let yqlRestHeadObj = Object yqlRestHeadId yqlRestHeadObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestHeadCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestHeadObj ?= yqlRestHeadObjInt yqlRestHeadersId <- createNextInternalId let yqlRestHeadersObj = Object yqlRestHeadersId yqlRestHeadersObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist op), objectInternalClass = "Object", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Nothing, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestHeadersObj ?= yqlRestHeadersObjInt yqlRestJsonCompatId <- createNextInternalId let yqlRestJsonCompatObj = Object yqlRestJsonCompatId yqlRestJsonCompatObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestJsonCompatCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestJsonCompatObj ?= yqlRestJsonCompatObjInt yqlRestPathId <- createNextInternalId let yqlRestPathObj = Object yqlRestPathId yqlRestPathObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestPathCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestPathObj ?= yqlRestPathObjInt yqlRestPostId <- createNextInternalId let yqlRestPostObj = Object yqlRestPostId yqlRestPostObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestPostCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestPostObj ?= yqlRestPostObjInt yqlRestPutId <- createNextInternalId let yqlRestPutObj = Object yqlRestPutId yqlRestPutObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestPutCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestPutObj ?= yqlRestPutObjInt yqlRestQueryId <- createNextInternalId let yqlRestQueryObj = Object yqlRestQueryId yqlRestQueryObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just (yqlRestQueryCallImpl yqlRestObj), objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestQueryObj ?= yqlRestQueryObjInt yqlRestQueryParamsId <- createNextInternalId let yqlRestQueryParamsObj = Object yqlRestQueryParamsId yqlRestQueryParamsObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestQueryParamsCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestQueryParamsObj ?= yqlRestQueryParamsObjInt yqlRestTimeoutId <- createNextInternalId let yqlRestTimeoutObj = Object yqlRestTimeoutId yqlRestTimeoutObjInt = ObjectInternal { objectInternalProperties = Map.empty, objectInternalPrototype = const $ return (JSExist fp), objectInternalClass = "Function", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Just yqlRestTimeoutCallImpl, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestTimeoutObj ?= yqlRestTimeoutObjInt let yqlRestObjInt = ObjectInternal { objectInternalProperties = Map.fromList [ ("accept", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestAcceptObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("contentType", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestContentTypeObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("decompress", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestDecompressObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("del", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestDelObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("fallbackCharset", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestFallbackCharsetObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("filterChars", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestFilterCharsObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("forceCharset", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestForceCharsetObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("get", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestGetObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("head", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestHeadObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("headers", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestHeadersObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("jsonCompat", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestJsonCompatObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("path", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestPathObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("post", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestHeadersObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("put", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestPutObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("query", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestQueryObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("queryParams", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestQueryParamsObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("timeout", PropertyData $ DataDescriptor { dataDescriptorValue = inj yqlRestTimeoutObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) , ("url", PropertyData $ DataDescriptor { dataDescriptorValue = inj (LBS.toString url), dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) ], objectInternalPrototype = const $ return (JSExist op), objectInternalClass = "Object", objectInternalExtensible = const $ return True, objectInternalGet = getImpl, objectInternalGetOwnProperty = getOwnPropertyImpl, objectInternalGetProperty = getPropertyImpl, objectInternalPut = putImpl, objectInternalCanPut = canPutImpl, objectInternalHasProperty = hasPropertyImpl, objectInternalDelete = deleteImpl, objectInternalDefaultValue = defaultValueImpl, objectInternalDefineOwnProperty = defineOwnPropertyImpl, objectInternalPrimitiveValue = Nothing, objectInternalConstruct = Nothing, objectInternalCall = Nothing, objectInternalHasInstance = Nothing, objectInternalScope = Nothing, objectInternalFormalParameters = Nothing, objectInternalCode = Nothing, objectInternalTargetFunction = Nothing, objectInternalBoundThis = Nothing, objectInternalBoundArguments = Nothing, objectInternalMatch = Nothing, objectInternalParameterMap = Nothing } mInternalObject yqlRestObj ?= yqlRestObjInt defineGlobalProperty "request" (PropertyData DataDescriptor { dataDescriptorValue = inj yqlRestObj, dataDescriptorWritable = True, dataDescriptorEnumerable = False, dataDescriptorConfigurable = True }) return yqlRestObj yqlRestAcceptCallImpl :: Object -> InternalCallType YQLM yqlRestAcceptCallImpl restObj f this (List args) = do let a = case args of (ValueString s:_) -> s _ -> "" lift . lift $ Data.rest . Data.Rest.accept ?= fromString a return (inj restObj) yqlRestContentTypeCallImpl :: Object -> InternalCallType YQLM yqlRestContentTypeCallImpl restObj f this (List args) = do let a = case args of (ValueString s:_) -> s _ -> "" lift . lift $ Data.rest . Data.Rest.contentType ?= fromString a return (inj restObj) yqlRestDecompressCallImpl :: Object -> InternalCallType YQLM yqlRestDecompressCallImpl restObj f this (List args) = undefined yqlRestDelCallImpl :: InternalCallType YQLM yqlRestDelCallImpl _ _ _ = wrappedHttpCall YQL.del yqlRestFallbackCharsetCallImpl :: InternalCallType YQLM yqlRestFallbackCharsetCallImpl = undefined yqlRestFilterCharsCallImpl :: InternalCallType YQLM yqlRestFilterCharsCallImpl = undefined yqlRestForceCharsetCallImpl :: InternalCallType YQLM yqlRestForceCharsetCallImpl = undefined yqlRestGetCallImpl :: InternalCallType YQLM yqlRestGetCallImpl _ _ _ = wrappedHttpCall YQL.get yqlRestHeadCallImpl :: InternalCallType YQLM yqlRestHeadCallImpl _ _ _ = wrappedHttpCall YQL.head yqlRestJsonCompatCallImpl :: InternalCallType YQLM yqlRestJsonCompatCallImpl = undefined yqlRestPathCallImpl :: InternalCallType YQLM yqlRestPathCallImpl = undefined yqlRestPostCallImpl :: InternalCallType YQLM yqlRestPostCallImpl _ _ (List args) = do case args of (ValueString body:_) -> do wrappedHttpCall $ YQL.post (fromString body) _ -> newTypeErrorObject Nothing >>= jsThrow yqlRestPutCallImpl :: InternalCallType YQLM yqlRestPutCallImpl _ _ (List args) = do case args of (ValueString body:_) -> do wrappedHttpCall $ YQL.post (fromString body) _ -> newTypeErrorObject Nothing >>= jsThrow yqlRestQueryCallImpl :: Object -> InternalCallType YQLM yqlRestQueryCallImpl restObj f this (List args) = do case args of (ValueString key:ValueString value:_) -> undefined _ -> return () return (inj restObj) yqlRestQueryParamsCallImpl :: InternalCallType YQLM yqlRestQueryParamsCallImpl = undefined yqlRestTimeoutCallImpl :: InternalCallType YQLM yqlRestTimeoutCallImpl f this (List args) = do case args of (ValueNumber n:_) -> lift . lift $ do Data.rest . Data.Rest.timeout ?= round n _ -> return () return (inj Undefined) wrappedHttpCall :: YQLM Result -> JavaScriptT YQLM CallValue wrappedHttpCall call = do op <- use objectPrototypeObject Result {..} <- lift . lift $ call let headersObj = undefined :: Object o <- newObjectObject Nothing defineOwnProperty o "headers" def { propertyDescriptorValue = Just (inj headersObj), propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False defineOwnProperty o "status" def { propertyDescriptorValue = Just (inj (Number . fromIntegral . HTTP.statusCode $ resultStatus)), propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False defineOwnProperty o "timeout" def { propertyDescriptorValue = Just (inj resultTimeout), propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False defineOwnProperty o "timeout" def { propertyDescriptorValue = Just (inj (BS.toString resultUrl)), propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False case resultResponse of ResponseJSON j -> do v <- jsonToValue j defineOwnProperty o "response" def { propertyDescriptorValue = Just v, propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False ResponseByteString s -> do defineOwnProperty o "response" def { propertyDescriptorValue = Just (inj (LBS.toString s)), propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } False return (inj o) jsonToValue :: (Functor m, Monad m) => Aeson.Value -> JavaScriptT m Value jsonToValue (Aeson.Object jo) = do o <- newObjectObject Nothing forM (HashMap.toList jo) $ \(k, j) -> do v <- jsonToValue j let desc = def { propertyDescriptorValue = Just v, propertyDescriptorWritable = Just True, propertyDescriptorEnumerable = Just True, propertyDescriptorConfigurable = Just True } defineOwnProperty o (Text.unpack k) desc False return (inj o) jsonToValue (Aeson.Array ja) = do vs <- forM (Vector.toList ja) jsonToValue a <- newArrayObject vs return (inj a) jsonToValue (Aeson.String s) = return . inj $ (Text.unpack s) jsonToValue (Aeson.Number n) = return . inj . Number . fromRational . toRational $ n jsonToValue (Aeson.Bool b) = return (inj b) jsonToValue (Aeson.Null) = return (inj Null)