diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2014, Fabian Bergmark +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE RankNTypes, + RecordWildCards #-} + +module Main + ( main ) where + +import Control.Applicative ((<$>)) +import Control.Monad (forM, join, mzero) +import Control.Monad.Catch + +import qualified Data.Map as Map (fromList) +import Data.Maybe (listToMaybe) + +import System.IO + +import Text.XML.HXT.Core (runX, readString, withRemoveWS, yes, (>>>)) + +import System.Environment (getArgs) + +import Data.OpenDataTable +import Data.YQL + +import Language.JavaScript.Interpret +import Language.JavaScript.SubType + +import Data.OpenDataTable.Parser + +import YQL + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + (xml:_) <- getArgs + xmlFile <- openFile xml ReadMode + document <- hGetContents xmlFile + + mOpenDataTable <- listToMaybe <$> runX (readString [withRemoveWS yes] document + >>> parseOpenDataTable) + case mOpenDataTable of + Just opentable@(OpenDataTable {..}) -> do + let selects = [s | SelectBinding s <- openDataTableBindings] + case selects of + Select {..}:_ -> do + vs <- join <$> + forM selectInputs + (\i -> do + case i of + InputKey InputInfo {..} -> do + let key = maybe inputInfoId id inputInfoAs + putStr (key ++ ": ") + str <- getLine + let value = case inputInfoType of + InputTypeBool -> inj (read str :: Bool) + InputTypeDate -> inj str + InputTypeDouble -> inj (Number (read str :: Double)) + InputTypeFloat -> inj (Number (read str :: Double)) + InputTypeInt -> inj (Number (read str :: Double)) + InputTypeString -> inj str + return [(key, value)] + _ -> return mzero) + result <- runYQL opentable (Map.fromList vs) + print result + _ -> throwM YQLExceptionMissingSelect + _ -> throwM YQLExceptionXMLError diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/YQL.hs b/src/Data/YQL.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveDataTypeable, + TemplateHaskell #-} + +module Data.YQL + ( YQL(..) + , YQLException(..) + , YQLM + , rest + , y ) where + +import Control.Lens +import Control.Monad.Catch +import Control.Monad.Trans.State.Lazy (StateT) + +import Data.Typeable + +import Text.Parsec (ParseError) + +import Data.YQL.Response +import Data.YQL.Rest +import Data.YQL.Y + +import Language.JavaScript.Interpret (Value) + +data YQL = + YQL + { yqlResponse :: Response + , yqlRest :: Rest + , yqlY :: Y } + +type YQLM = StateT YQL IO + +data YQLException + = YQLExceptionInternalError + | YQLExceptionJSParseError ParseError + | YQLExceptionJSRuntimeError String + | YQLExceptionJSONError + | YQLExceptionMissingInput + | YQLExceptionMissingSelect + | YQLExceptionTypeError + | YQLExceptionXMLError + deriving (Show, Typeable) + +instance Exception YQLException + +response :: Lens' YQL Response +response = lens yqlResponse (\yql r -> yql { yqlResponse = r }) + +rest :: Lens' YQL Rest +rest = lens yqlRest (\yql r -> yql { yqlRest = r }) + +y :: Lens' YQL Y +y = lens yqlY (\yql y' -> yql { yqlY = y' }) diff --git a/src/Data/YQL/Cache.hs b/src/Data/YQL/Cache.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Cache.hs @@ -0,0 +1,5 @@ +module Data.YQL.Cache + ( Cache(..) ) where + +data Cache = + Cache diff --git a/src/Data/YQL/Context.hs b/src/Data/YQL/Context.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Context.hs @@ -0,0 +1,17 @@ +module Data.YQL.Context + ( Context(..) + , host + , table ) where + +import Control.Lens (Lens', lens) + +data Context = + Context + { contextHost :: String + , contextTable :: String } + +host :: Lens' Context String +host = lens contextHost (\c h -> c { contextHost = h }) + +table :: Lens' Context String +table = lens contextTable (\c t -> c { contextTable = t }) diff --git a/src/Data/YQL/Crypto.hs b/src/Data/YQL/Crypto.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Crypto.hs @@ -0,0 +1,5 @@ +module Data.YQL.Crypto + ( Crypto(..) ) where + +data Crypto = + Crypto diff --git a/src/Data/YQL/Response.hs b/src/Data/YQL/Response.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Response.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Data.YQL.Response + ( Response(..) + , pattern ResponseJSON + , pattern ResponseByteString + , object ) where + +import Control.Lens + +import Data.Aeson (Value) +import Data.ByteString.Lazy + +data Response + = Response + { responseObject :: Either Value ByteString } + +pattern ResponseJSON v = Response (Left v) +pattern ResponseByteString s = Response (Right s) + +instance Show Response where + show (Response (Left v)) = show v + show (Response (Right s)) = show s + +object :: Lens' Response (Either Value ByteString) +object = lens responseObject (\r o -> r { responseObject = o }) diff --git a/src/Data/YQL/Rest.hs b/src/Data/YQL/Rest.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Rest.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings, + RankNTypes #-} + +module Data.YQL.Rest + ( Rest(..) + , accept + , contentType + , header + , headers + , httpManager + , httpRequest + , timeout + , url ) where + +import Control.Lens + +import Data.ByteString.Lazy +import Data.Map + +import qualified Network.HTTP.Conduit as Conduit +import qualified Network.HTTP.Types.Header as HTTP + +data Rest = + Rest + { restHttpManager :: Conduit.Manager + , restHttpRequest :: Conduit.Request } + +httpManager :: Lens' Rest Conduit.Manager +httpManager = lens restHttpManager (\rest m -> rest { restHttpManager = m }) + +httpRequest :: Lens' Rest Conduit.Request +httpRequest = lens restHttpRequest (\rest r -> rest { restHttpRequest = r }) + +requestHeaders :: Lens' Conduit.Request HTTP.RequestHeaders +requestHeaders = + lens Conduit.requestHeaders (\r rhs -> r { Conduit.requestHeaders = rhs }) + +requestTimeout :: Lens' Conduit.Request (Maybe Int) +requestTimeout = + lens + Conduit.responseTimeout + (\r t -> r { Conduit.responseTimeout = t }) + +requestUrl :: Lens' Conduit.Request ByteString +requestUrl = + lens + (fromStrict . Conduit.host) + (\r u -> r { Conduit.host = toStrict u }) + +headers :: Lens' Rest HTTP.RequestHeaders +headers = httpRequest . requestHeaders + +header :: HTTP.HeaderName -> Lens' Rest (Maybe ByteString) +header key = + headers . + lens fromList (const toList) . + lens (fmap fromStrict) (const (fmap toStrict)) . + at key + +timeout :: Lens' Rest (Maybe Int) +timeout = httpRequest . requestTimeout + +url :: Lens' Rest ByteString +url = httpRequest . requestUrl + +accept :: Lens' Rest (Maybe ByteString) +accept = header "Accept" + +contentType :: Lens' Rest (Maybe ByteString) +contentType = header "Content-Type" diff --git a/src/Data/YQL/Result.hs b/src/Data/YQL/Result.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Result.hs @@ -0,0 +1,38 @@ +module Data.YQL.Result + ( Result(..) + , response + , headers + , status + , timeout + , url ) where + +import Control.Lens + +import Data.ByteString + +import qualified Network.HTTP.Types as HTTP + +import Data.YQL.Response + +data Result + = Result + { resultResponse :: Response + , resultHeaders :: HTTP.ResponseHeaders + , resultStatus :: HTTP.Status + , resultTimeout :: Bool + , resultUrl :: ByteString } + +response :: Lens' Result Response +response = lens resultResponse (\res r -> res { resultResponse = r }) + +headers :: Lens' Result HTTP.ResponseHeaders +headers = lens resultHeaders (\res hs -> res { resultHeaders = hs }) + +status :: Lens' Result HTTP.Status +status = lens resultStatus (\res s -> res { resultStatus = s }) + +timeout :: Lens' Result Bool +timeout = lens resultTimeout (\res t -> res { resultTimeout = t }) + +url :: Lens' Result ByteString +url = lens resultUrl (\res u -> res { resultUrl = u }) diff --git a/src/Data/YQL/Y.hs b/src/Data/YQL/Y.hs new file mode 100644 --- /dev/null +++ b/src/Data/YQL/Y.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.YQL.Y + ( Y(..) + , cache + , context + , crypto ) where + +import Control.Lens (Lens', lens) + +import Data.YQL.Cache (Cache) +import Data.YQL.Context (Context) +import Data.YQL.Crypto (Crypto) + +data Y = + Y + { yCache :: Cache + , yContext :: Context + , yCrypto :: Crypto } + +cache :: Lens' Y Cache +cache = lens yCache (\y c -> y { yCache = c }) + +context :: Lens' Y Context +context = lens yContext (\y c -> y { yContext = c }) + +crypto :: Lens' Y Crypto +crypto = lens yCrypto (\y c -> y { yCrypto = c }) diff --git a/src/Language/JavaScript/Host/YQL.hs b/src/Language/JavaScript/Host/YQL.hs new file mode 100644 --- /dev/null +++ b/src/Language/JavaScript/Host/YQL.hs @@ -0,0 +1,15 @@ +module Language.JavaScript.Host.YQL where + +import Data.Map (Map) + +import Data.OpenDataTable +import Data.YQL (YQLM) + +import Language.JavaScript.Interpret +import Language.JavaScript.Host.YQL.Inputs +import Language.JavaScript.Host.YQL.Rest +import Language.JavaScript.Host.YQL.Response +import Language.JavaScript.Host.YQL.Y + +yql :: OpenDataTable -> Select -> Map String Primitive -> JavaScriptT YQLM Object +yql ot s vs = inputs ot s vs >> request ot s >>= y ot s >> response diff --git a/src/Language/JavaScript/Host/YQL/Inputs.hs b/src/Language/JavaScript/Host/YQL/Inputs.hs new file mode 100644 --- /dev/null +++ b/src/Language/JavaScript/Host/YQL/Inputs.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE PatternSynonyms, + RecordWildCards #-} + +module Language.JavaScript.Host.YQL.Inputs where + +import Control.Applicative ((<$>)) +import Control.Lens ((?=), use) +import Control.Monad (join, mzero, when) +import Control.Monad.Catch (throwM) + +import Data.Map (Map) +import qualified Data.Map as Map (assocs, fromList, lookup) +import Data.Traversable (forM) + +import Data.OpenDataTable +import Data.YQL (YQLException(..), YQLM) + +import Language.JavaScript.Host +import Language.JavaScript.Interpret +import Language.JavaScript.SubType + +inputs :: OpenDataTable -> Select -> Map String Primitive -> JavaScriptT YQLM () +inputs OpenDataTable {..} Select {..} vs = do + op <- use objectPrototypeObject + fp <- use functionPrototypeObject + + inputsProperties <- + join <$> + forM selectInputs + (\i -> do + case i of + InputKey InputInfo {..} -> do + let key = maybe inputInfoId id inputInfoAs + case Map.lookup key vs of + Just v -> do + let prop = (key, PropertyData DataDescriptor { + dataDescriptorValue = inj v, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + case (inputInfoType, v) of + (InputTypeBool, PrimitiveBool _) -> return [prop] + (InputTypeDate, PrimitiveString _) -> return [prop] + (InputTypeDouble, PrimitiveNumber _) -> return [prop] + (InputTypeInt, PrimitiveNumber _) -> return [prop] + (InputTypeString, PrimitiveString _) -> return [prop] + _ -> throwM YQLExceptionTypeError + _ -> do + when inputInfoRequired $ + throwM YQLExceptionMissingInput + return mzero + _ -> return mzero) + + yqlInputsId <- createNextInternalId + let yqlInputsObj = Object yqlInputsId + + yqlInputsObjInt = ObjectInternal { + objectInternalProperties = Map.fromList inputsProperties, + 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 yqlInputsObj ?= yqlInputsObjInt + + forM (Map.assocs vs) $ \(key, value) -> do + defineGlobalProperty + key + (PropertyData DataDescriptor { + dataDescriptorValue = inj value, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + + defineGlobalProperty + "inputs" + (PropertyData DataDescriptor { + dataDescriptorValue = inj yqlInputsObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) diff --git a/src/Language/JavaScript/Host/YQL/Response.hs b/src/Language/JavaScript/Host/YQL/Response.hs new file mode 100644 --- /dev/null +++ b/src/Language/JavaScript/Host/YQL/Response.hs @@ -0,0 +1,57 @@ +module Language.JavaScript.Host.YQL.Response where + +import Control.Lens ((?=), use) + +import Data.YQL (YQLM) + +import Language.JavaScript.Host +import Language.JavaScript.Interpret +import Language.JavaScript.SubType + +import qualified Data.Map as Map (empty) + +response :: JavaScriptT YQLM Object +response = do + op <- use objectPrototypeObject + fp <- use functionPrototypeObject + + yqlResponseId <- createNextInternalId + let yqlResponseObj = Object yqlResponseId + yqlResponseObjInt = 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 yqlResponseObj ?= yqlResponseObjInt + + defineGlobalProperty + "response" + (PropertyData DataDescriptor { + dataDescriptorValue = inj yqlResponseObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + + return yqlResponseObj diff --git a/src/Language/JavaScript/Host/YQL/Rest.hs b/src/Language/JavaScript/Host/YQL/Rest.hs new file mode 100644 --- /dev/null +++ b/src/Language/JavaScript/Host/YQL/Rest.hs @@ -0,0 +1,857 @@ +{-# 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) diff --git a/src/Language/JavaScript/Host/YQL/Y.hs b/src/Language/JavaScript/Host/YQL/Y.hs new file mode 100644 --- /dev/null +++ b/src/Language/JavaScript/Host/YQL/Y.hs @@ -0,0 +1,976 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Language.JavaScript.Host.YQL.Y where + +import Control.Lens ((?=), use) +import Control.Monad.Trans.Class (lift) + +import qualified Data.ByteString.Lazy.UTF8 as LBS +import qualified Data.ByteString.UTF8 as BS +import qualified Data.Map as Map (empty, fromList) +import Data.String (fromString) + +import Data.OpenDataTable +import Data.YQL + +import Language.JavaScript.Host +import Language.JavaScript.Interpret +import Language.JavaScript.SubType + +import qualified YQL.Y as Y +import qualified YQL.Crypto as Crypto + +y :: OpenDataTable -> Select -> Object -> JavaScriptT YQLM () +y ot s restObj = do + op <- use objectPrototypeObject + fp <- use functionPrototypeObject + + yqlYContextId <- createNextInternalId + let yqlYContextObj = Object yqlYContextId + yqlYContextObjInt = ObjectInternal { + objectInternalProperties = + Map.fromList + [ ("host", PropertyData $ DataDescriptor { + dataDescriptorValue = inj "", + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("table", PropertyData $ DataDescriptor { + dataDescriptorValue = inj "", + 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 yqlYContextObj ?= yqlYContextObjInt + + yqlYCryptoDecodeBase64Id <- createNextInternalId + let yqlYCryptoDecodeBase64Obj = Object yqlYCryptoDecodeBase64Id + yqlYCryptoDecodeBase64ObjInt = 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 yqlYCryptoDecodeBase64CallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoDecodeBase64Obj ?= yqlYCryptoDecodeBase64ObjInt + + yqlYCryptoEncodeBase64Id <- createNextInternalId + let yqlYCryptoEncodeBase64Obj = Object yqlYCryptoEncodeBase64Id + yqlYCryptoEncodeBase64ObjInt = 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 yqlYCryptoEncodeBase64CallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeBase64Obj ?= yqlYCryptoEncodeBase64ObjInt + + yqlYCryptoEncodeHmacSHA1Id <- createNextInternalId + let yqlYCryptoEncodeHmacSHA1Obj = Object yqlYCryptoEncodeHmacSHA1Id + yqlYCryptoEncodeHmacSHA1ObjInt = 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 yqlYCryptoEncodeHmacSHA1CallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeHmacSHA1Obj ?= yqlYCryptoEncodeHmacSHA1ObjInt + + yqlYCryptoEncodeHmacSHA256Id <- createNextInternalId + let yqlYCryptoEncodeHmacSHA256Obj = Object yqlYCryptoEncodeHmacSHA256Id + yqlYCryptoEncodeHmacSHA256ObjInt = 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 yqlYCryptoEncodeHmacSHA256CallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeHmacSHA256Obj ?= yqlYCryptoEncodeHmacSHA256ObjInt + + yqlYCryptoEncodeMd5Id <- createNextInternalId + let yqlYCryptoEncodeMd5Obj = Object yqlYCryptoEncodeMd5Id + yqlYCryptoEncodeMd5ObjInt = 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 yqlYCryptoEncodeMd5CallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeMd5Obj ?= yqlYCryptoEncodeMd5ObjInt + + yqlYCryptoEncodeMd5HexId <- createNextInternalId + let yqlYCryptoEncodeMd5HexObj = Object yqlYCryptoEncodeMd5HexId + yqlYCryptoEncodeMd5HexObjInt = 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 yqlYCryptoEncodeMd5HexCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeMd5HexObj ?= yqlYCryptoEncodeMd5HexObjInt + + yqlYCryptoEncodeShaId <- createNextInternalId + let yqlYCryptoEncodeShaObj = Object yqlYCryptoEncodeShaId + yqlYCryptoEncodeShaObjInt = 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 yqlYCryptoEncodeShaCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoEncodeShaObj ?= yqlYCryptoEncodeShaObjInt + + yqlYCryptoUUIDId <- createNextInternalId + let yqlYCryptoUUIDObj = Object yqlYCryptoUUIDId + yqlYCryptoUUIDObjInt = 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 yqlYCryptoUUIDCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYCryptoUUIDObj ?= yqlYCryptoUUIDObjInt + + yqlYCryptoId <- createNextInternalId + let yqlYCryptoObj = Object yqlYCryptoId + yqlYCryptoObjInt = ObjectInternal { + objectInternalProperties = + Map.fromList + [ ("decodeBase64", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoDecodeBase64Obj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeBase64", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeBase64Obj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeHmacSHA1", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeHmacSHA1Obj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeHmacSHA256", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeHmacSHA256Obj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeMd5", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeMd5Obj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeMd5Hex", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeMd5HexObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("encodeSha", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoEncodeShaObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("uuid", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoUUIDObj, + 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 yqlYCryptoObj ?= yqlYCryptoObjInt + + yqlYDateGetOffsetFromEpochInMillisId <- createNextInternalId + let yqlYDateGetOffsetFromEpochInMillisObj = + Object yqlYDateGetOffsetFromEpochInMillisId + yqlYDateGetOffsetFromEpochInMillisObjInt = 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 yqlYDateGetOffsetFromEpochInMillisCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYDateGetOffsetFromEpochInMillisObj ?= + yqlYDateGetOffsetFromEpochInMillisObjInt + + yqlYDateId <- createNextInternalId + let yqlYDateObj = Object yqlYDateId + yqlYDateObjInt = ObjectInternal { + objectInternalProperties = + Map.fromList + [ ("getOffsetFromEpochInMillis", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYDateGetOffsetFromEpochInMillisObj, + 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 yqlYDateObj ?= yqlYDateObjInt + + yqlYDecompressId <- createNextInternalId + let yqlYDecompressObj = Object yqlYDecompressId + yqlYDecompressObjInt = 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 yqlYDecompressCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYDecompressObj ?= yqlYDecompressObjInt + + yqlYDeflateId <- createNextInternalId + let yqlYDeflateObj = Object yqlYDeflateId + yqlYDeflateObjInt = 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 yqlYDeflateCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYDeflateObj ?= yqlYDeflateObjInt + + yqlYExitId <- createNextInternalId + let yqlYExitObj = Object yqlYExitId + yqlYExitObjInt = 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 yqlYExitCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYExitObj ?= yqlYExitObjInt + + yqlYIncludeId <- createNextInternalId + let yqlYIncludeObj = Object yqlYIncludeId + yqlYIncludeObjInt = 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 yqlYIncludeCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYIncludeObj ?= yqlYIncludeObjInt + + yqlYInflateId <- createNextInternalId + let yqlYInflateObj = Object yqlYInflateId + yqlYInflateObjInt = 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 yqlYInflateCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYInflateObj ?= yqlYInflateObjInt + + yqlYJsToStringId <- createNextInternalId + let yqlYJsToStringObj = Object yqlYJsToStringId + yqlYJsToStringObjInt = 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 yqlYJsToStringCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYJsToStringObj ?= yqlYJsToStringObjInt + + yqlYRestId <- createNextInternalId + let yqlYRestObj = Object yqlYRestId + yqlYRestObjInt = 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 (yqlYRestCallImpl restObj), + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYRestObj ?= yqlYRestObjInt + + yqlYSyncId <- createNextInternalId + let yqlYSyncObj = Object yqlYSyncId + yqlYSyncObjInt = 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 yqlYSyncCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYSyncObj ?= yqlYSyncObjInt + + yqlYTidyId <- createNextInternalId + let yqlYTidyObj = Object yqlYTidyId + yqlYTidyObjInt = 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 yqlYTidyCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYTidyObj ?= yqlYTidyObjInt + + yqlYXparseJsonId <- createNextInternalId + let yqlYXparseJsonObj = Object yqlYXparseJsonId + yqlYXparseJsonObjInt = 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 yqlYXparseJsonCallImpl, + objectInternalHasInstance = Nothing, + objectInternalScope = Nothing, + objectInternalFormalParameters = Nothing, + objectInternalCode = Nothing, + objectInternalTargetFunction = Nothing, + objectInternalBoundThis = Nothing, + objectInternalBoundArguments = Nothing, + objectInternalMatch = Nothing, + objectInternalParameterMap = Nothing } + + mInternalObject yqlYXparseJsonObj ?= yqlYXparseJsonObjInt + + yqlYId <- createNextInternalId + let yqlYObj = Object yqlYId + yqlYObjInt = ObjectInternal { + objectInternalProperties = + Map.fromList + [ ("context", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYContextObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("crypto", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYCryptoObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("date", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYDateObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("decompress", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYDecompressObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("deflate", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYDeflateObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("exit", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYExitObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("include", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYIncludeObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("inflate", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYInflateObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("jsToString", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYJsToStringObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("rest", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYRestObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("sync", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYSyncObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("tidy", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYTidyObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + , ("xparseJson", PropertyData $ DataDescriptor { + dataDescriptorValue = inj yqlYXparseJsonObj, + 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 yqlYObj ?= yqlYObjInt + + defineGlobalProperty + "y" + (PropertyData DataDescriptor { + dataDescriptorValue = inj yqlYObj, + dataDescriptorWritable = True, + dataDescriptorEnumerable = False, + dataDescriptorConfigurable = True }) + +yqlYCryptoDecodeBase64CallImpl :: InternalCallType YQLM +yqlYCryptoDecodeBase64CallImpl _ _ (List args) = do + case args of + (ValueString s:_) -> do + case Crypto.decodeBase64 (fromString s) of + Just d -> return . inj $ LBS.toString d + _ -> jsThrow "Invalid Base64 encoding" + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoEncodeBase64CallImpl :: InternalCallType YQLM +yqlYCryptoEncodeBase64CallImpl _ _ (List args) = do + case args of + (ValueString s:_) -> do + return . inj . LBS.toString . Crypto.encodeBase64 . fromString $ s + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoEncodeHmacSHA1CallImpl :: InternalCallType YQLM +yqlYCryptoEncodeHmacSHA1CallImpl _ _ (List args) = do + case args of + (ValueString secret:ValueString plaintext:_) -> do + let hex = Crypto.encodeHmacSHA1 (fromString secret) (fromString plaintext) + return (inj . LBS.toString $ hex) + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoEncodeHmacSHA256CallImpl :: InternalCallType YQLM +yqlYCryptoEncodeHmacSHA256CallImpl _ _ (List args) = do + case args of + (ValueString secret:ValueString plaintext:_) -> do + let hex = Crypto.encodeHmacSHA256 (fromString secret) (fromString plaintext) + return (inj . LBS.toString $ hex) + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoEncodeMd5CallImpl :: InternalCallType YQLM +yqlYCryptoEncodeMd5CallImpl _ _ (List args) = do + case args of + (ValueString message:_) -> do + let hex = Crypto.encodeMd5 (fromString message) + return (inj . LBS.toString $ hex) + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoEncodeMd5HexCallImpl :: InternalCallType YQLM +yqlYCryptoEncodeMd5HexCallImpl = undefined + +yqlYCryptoEncodeShaCallImpl :: InternalCallType YQLM +yqlYCryptoEncodeShaCallImpl _ _ (List args) = do + case args of + (ValueString message:_) -> do + let hex = Crypto.encodeSha (fromString message) + return (inj . LBS.toString $ hex) + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYCryptoUUIDCallImpl :: InternalCallType YQLM +yqlYCryptoUUIDCallImpl _ _ _ = do + uuid <- lift . lift $ Crypto.uuid + return (inj . LBS.toString $ uuid) + +yqlYDateGetOffsetFromEpochInMillisCallImpl :: InternalCallType YQLM +yqlYDateGetOffsetFromEpochInMillisCallImpl = undefined + +yqlYDecompressCallImpl :: InternalCallType YQLM +yqlYDecompressCallImpl _ _ (List args) = do + case args of + (ValueString s:_) -> do + case Y.decompress (fromString s) of + Just d -> return . inj $ LBS.toString d + _ -> jsThrow "Invalid Base64 encoding" + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYDeflateCallImpl _ _ (List args) = do + case args of + (ValueString s:ValueNumber l:_) -> do + return . inj . LBS.toString . flip Y.deflate (round l) . fromString $ s + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYExitCallImpl = undefined + +yqlYIncludeCallImpl = undefined + +yqlYInflateCallImpl _ _ (List args) = do + case args of + (ValueString s:_) -> do + case Y.inflate (fromString s) of + Just d -> return . inj $ LBS.toString d + _ -> jsThrow "Invalid Base64 encoding" + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYJsToStringCallImpl = undefined + +yqlYRestCallImpl :: Object -> InternalCallType YQLM +yqlYRestCallImpl restObj f this (List args) = do + case args of + (ValueString url:ValueObject callback:_) -> do + lift . lift $ Y.rest url + return (inj restObj) + _ -> newTypeErrorObject Nothing >>= jsThrow + +yqlYSyncCallImpl = undefined + +yqlYTidyCallImpl = undefined + +yqlYXparseJsonCallImpl = undefined diff --git a/src/YQL.hs b/src/YQL.hs new file mode 100644 --- /dev/null +++ b/src/YQL.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE RecordWildCards, + PatternSynonyms #-} + +module YQL + ( runYQL ) where + +import Control.Lens +import Control.Monad.Catch (throwM) +import Control.Monad.Trans.State.Lazy (evalStateT) + +import Control.Applicative ((<$>)) +import Control.Monad.Trans.Except (catchE) + +import qualified Data.Aeson as Aeson +import Data.Default (def) +import Data.Foldable (foldlM, foldrM) +import qualified Data.HashMap.Strict as HashMap (empty, insert) +import Data.Map (Map) +import qualified Data.Map as Map (foldlWithKey, toList) +import Data.Monoid ((<>)) +import Data.String (fromString) +import qualified Data.Text as Text (pack) +import qualified Data.Text.Lazy as Text (toStrict) +import Data.Text.Lazy.Encoding +import qualified Data.Vector as Vector (cons, empty) + +import Network.HTTP.Conduit (parseUrl) +import Network.HTTP.Client.Conduit (newManager) +import Network.URI.Template + +import System.IO (stderr, Handle) +import System.Log.Formatter +import System.Log.Handler (setFormatter) +import System.Log.Handler.Simple +import System.Log.Logger + +import Data.OpenDataTable +import Data.YQL +import Data.YQL.Response +import Data.YQL.Rest +import Data.YQL.Result + +import qualified Language.JavaScript as JS +import qualified Language.JavaScript.Host.YQL as JS +import qualified Language.JavaScript.Host.Console as JS +import qualified Language.JavaScript.Interpret as JS +import qualified Language.JavaScript.Parser as JS + +import YQL.Rest +import YQL.Y + +withFormatter :: GenericHandler Handle -> GenericHandler Handle +withFormatter handler = setFormatter handler formatter + where formatter = simpleLogFormatter "[$time $loggername $prio] $msg" + +runYQL :: OpenDataTable -> Map String JS.Primitive -> IO Aeson.Value +runYQL ot@(OpenDataTable {..}) vs = do + let logName = rootLoggerName + stderrHandler <- withFormatter <$> streamHandler stderr DEBUG + updateGlobalLogger logName (setLevel DEBUG) + updateGlobalLogger logName (setHandlers [stderrHandler]) + + let selects = [s | SelectBinding s <- openDataTableBindings] + case selects of + (s@(Select{..}):_) -> do + manager <- newManager + let env = + Map.foldlWithKey + (\e k v -> addToEnv k (JS.primitiveToString v) e) + newEnv vs + request <- maybe (return def) (parseUrl . expand env) selectUrl + let _rest = Rest { + restHttpManager = manager, + restHttpRequest = request } + _y = undefined + _yql = YQL { + yqlRest = _rest, + yqlY = _y } + mSource = openDataTableExecute <> selectExecute + flip evalStateT _yql $ do + case mSource of + Just source -> do + let eAST = JS.parseJavaScript source + case eAST of + Right ast -> do + let hostInit = JS.console >> JS.yql ot s vs + eRes <- JS.runJavaScriptT JS.initialState $ do + responseObj <- hostInit + + (JS.interpret ast :: JS.JavaScriptT YQLM JS.Completion) + `catchE` + (\ v -> do + s <- JS.toString v + throwM $ YQLExceptionJSRuntimeError s) + + oi <- use $ JS.internalObject responseObj + case oi ^. JS.internalProperty "object" of + Just (JS.PropertyData JS.DataDescriptor {..}) -> + valueToJSON dataDescriptorValue + _ -> return Aeson.Null + case eRes of + Right res -> return res + Left _ -> do + throwM YQLExceptionInternalError + Left e -> throwM $ YQLExceptionJSParseError e + _ -> do + Result {..} <- get + case resultResponse of + ResponseByteString s -> do + return $ Aeson.String (Text.toStrict . decodeUtf8 $ s) + ResponseJSON j -> return j + _ -> throwM YQLExceptionMissingSelect + +valueToJSON :: (Functor m, Monad m) => JS.Value -> JS.JavaScriptT m Aeson.Value +valueToJSON (JS.ValueNull _) = return Aeson.Null +valueToJSON (JS.ValueUndefined _) = return Aeson.Null +valueToJSON (JS.ValueNumber n) = + return $ Aeson.Number (fromRational . toRational $ n) +valueToJSON (JS.ValueString s) = return $ Aeson.String (fromString s) +valueToJSON (JS.ValueBool b) = return $ Aeson.Bool b +valueToJSON (JS.ValueObject o) = do + c <- use $ JS.class' o + case c of + "Object" -> do + ps <- use $ JS.properties o + jo <- foldlM addObjectField (HashMap.empty) (Map.toList ps) + return $ Aeson.Object jo + + "Array" -> do + ps <- use $ JS.properties o + ja <- foldrM addArrayItem (Vector.empty) (Map.toList ps) + return $ Aeson.Array ja + + where + addObjectField :: (Functor m, Monad m) => + Aeson.Object -> (String, JS.Property) -> + JS.JavaScriptT m Aeson.Object + addObjectField jo (name, property) = + case property of + JS.PropertyData (JS.DataDescriptor {..}) -> do + if dataDescriptorEnumerable + then do + j <- valueToJSON dataDescriptorValue + return $ HashMap.insert (Text.pack name) j jo + else return jo + _ -> return jo + + addArrayItem :: (Functor m, Monad m) => + (String, JS.Property) -> Aeson.Array -> + JS.JavaScriptT m Aeson.Array + addArrayItem (name, property) ja = do + if name /= "length" + then do + case property of + JS.PropertyData (JS.DataDescriptor {..}) -> do + if dataDescriptorEnumerable + then do + j <- valueToJSON dataDescriptorValue + return $ Vector.cons j ja + else return ja + _ -> return ja + else return ja diff --git a/src/YQL/Crypto.hs b/src/YQL/Crypto.hs new file mode 100644 --- /dev/null +++ b/src/YQL/Crypto.hs @@ -0,0 +1,47 @@ +module YQL.Crypto + ( decodeBase64 + , encodeBase64 + , encodeMd5 + , encodeMd5Hex + , encodeSha + , uuid + , encodeHmacSHA1 + , encodeHmacSHA256 ) where + +import Control.Monad.IO.Class (liftIO) +import qualified Crypto.Hash.MD5 as MD5 +import qualified Crypto.Hash.SHA1 as SHA1 + +import qualified Data.ByteString.Base64.Lazy as Base64 +import Data.ByteString.Lazy +import qualified Data.Digest.Pure.SHA as SHA +import qualified Data.UUID as UUID (toLazyASCIIBytes) +import qualified Data.UUID.V4 as UUID + +import Data.YQL (YQLM) + +decodeBase64 :: ByteString -> Maybe ByteString +decodeBase64 s = either (const Nothing) Just (Base64.decode s) + +encodeBase64 :: ByteString -> ByteString +encodeBase64 s = Base64.encode s + +encodeHmacSHA1 :: ByteString -> ByteString -> ByteString +encodeHmacSHA1 secret plaintext = + SHA.bytestringDigest $ SHA.hmacSha1 secret plaintext + +encodeHmacSHA256 :: ByteString -> ByteString -> ByteString +encodeHmacSHA256 secret plaintext = + SHA.bytestringDigest $ SHA.hmacSha256 secret plaintext + +encodeMd5 :: ByteString -> ByteString +encodeMd5 message = fromStrict . MD5.hash . toStrict $ message + +encodeMd5Hex :: ByteString -> ByteString +encodeMd5Hex = undefined + +encodeSha :: ByteString -> ByteString +encodeSha message = fromStrict . SHA1.hash . toStrict $ message + +uuid :: YQLM ByteString +uuid = liftIO $ UUID.nextRandom >>= return . UUID.toLazyASCIIBytes diff --git a/src/YQL/Date.hs b/src/YQL/Date.hs new file mode 100644 --- /dev/null +++ b/src/YQL/Date.hs @@ -0,0 +1,7 @@ +module YQL.Date + ( getOffsetFromEpochInMillis ) where + +import Data.YQL (YQLM) + +getOffsetFromEpochInMillis :: YQLM Int +getOffsetFromEpochInMillis = undefined diff --git a/src/YQL/Rest.hs b/src/YQL/Rest.hs new file mode 100644 --- /dev/null +++ b/src/YQL/Rest.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE OverloadedStrings, + RecordWildCards #-} + +module YQL.Rest + ( del + , get + , head + , post + , put ) where + +import Control.Lens +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Trans.Class (lift) + +import Data.Aeson (decode) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.UTF8 as BS +import Data.Monoid ((<>)) + +import Network.HTTP.Conduit + (Request(..), Response(..), RequestBody(..), + httpLbs) + +import Prelude hiding (head) + +import System.Log.Logger + +import qualified Data.YQL as Data +import qualified Data.YQL.Response as Data.Response +import qualified Data.YQL.Rest as Data.Rest +import qualified Data.YQL.Result as Data.Result + +del :: Data.YQLM Data.Result.Result +del = do + request <- use $ Data.rest . Data.Rest.httpRequest + httpRequest request { method = "DELETE" } + +get :: Data.YQLM Data.Result.Result +get = do + request <- use $ Data.rest . Data.Rest.httpRequest + httpRequest request { method = "GET" } + +head :: Data.YQLM Data.Result.Result +head = do + request <- use $ Data.rest . Data.Rest.httpRequest + httpRequest request { method = "HEAD" } + +post :: LBS.ByteString -> Data.YQLM Data.Result.Result +post body = do + request <- use $ Data.rest . Data.Rest.httpRequest + httpRequest request { method = "POST" + , requestBody = RequestBodyLBS body } + +put :: LBS.ByteString -> Data.YQLM Data.Result.Result +put body = do + request <- use $ Data.rest . Data.Rest.httpRequest + httpRequest request { method = "POST" + , requestBody = RequestBodyLBS body } + +timeout :: Int -> Data.YQLM () +timeout ms = do + Data.rest . Data.Rest.timeout ?= (ms * 1000) + +httpRequest :: Request -> Data.YQLM Data.Result.Result +httpRequest request = do + manager <- use $ Data.rest . Data.Rest.httpManager + lift $ do + res <- httpLbs request manager + let body = responseBody res + status = responseStatus res + headers = responseHeaders res + verb = method request + url = host request <> path request <> queryString request + + liftIO $ + infoM + "YQL" + ("HTTP " <> BS.toString verb <> " request to " <> BS.toString url) + + response <- case lookup "Content-Type" headers of + Just "application/json" -> do + case decode body of + Just v -> do + return $ Data.Response.ResponseJSON v + _ -> throwM Data.YQLExceptionJSONError + _ -> return $ Data.Response.ResponseByteString body + return Data.Result.Result { + resultResponse = response, + resultHeaders = headers, + resultStatus = status, + resultTimeout = False, + resultUrl = url } diff --git a/src/YQL/Y.hs b/src/YQL/Y.hs new file mode 100644 --- /dev/null +++ b/src/YQL/Y.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings, + RecordWildCards #-} + +module YQL.Y + ( decompress + , deflate + , inflate + , rest ) where + +import qualified Codec.Compression.GZip as GZip +import qualified Codec.Compression.Zlib as Zlib + +import Control.Lens + +import Data.ByteString.Lazy +import qualified Data.ByteString.Base64.Lazy as Base64 + +import Network.HTTP.Conduit (parseUrl) + +import qualified Data.YQL as Data +import qualified Data.YQL.Rest as Data + +decompress :: ByteString -> (Maybe ByteString) +decompress e = either (const Nothing) (Just . GZip.decompress) (Base64.decode e) + +deflate :: ByteString -> Int -> ByteString +deflate string level = + Base64.encode $ + Zlib.compressWith + Zlib.defaultCompressParams { + Zlib.compressLevel = Zlib.compressionLevel level } + string + +inflate :: ByteString -> Maybe ByteString +inflate e = + case Base64.decode e of + Right string -> + Just $ Zlib.decompress string + _ -> Nothing + +rest :: String -> Data.YQLM () +rest url = do + req <- parseUrl url + Data.rest . Data.httpRequest .= req diff --git a/yql.cabal b/yql.cabal new file mode 100644 --- /dev/null +++ b/yql.cabal @@ -0,0 +1,89 @@ +name: yql +version: 0.0.0 +synopsis: A YQL engine to execute Open Data Tables +description: A YQL engine that provides a Haskell backbone + library for the YQL specification, and a Javascript + host environment to execute Open Data Tables. +homepage: https://github.com/fabianbergmark/YQL +category: Web +author: Fabian Bergmark +maintainer: fabian.bergmark@gmail.com +license: BSD2 +license-file: LICENSE +cabal-version: >= 1.10 +build-type: Simple + +extra-source-files: LICENSE + +source-repository head + type: git + location: https://github.com/fabianbergmark/YQL.git + +library + default-language: Haskell2010 + + hs-source-dirs: src/ + + exposed-modules: Data.YQL + Data.YQL.Cache + Data.YQL.Context + Data.YQL.Crypto + Data.YQL.Response + Data.YQL.Rest + Data.YQL.Result + Data.YQL.Y + Language.JavaScript.Host.YQL + Language.JavaScript.Host.YQL.Inputs + Language.JavaScript.Host.YQL.Rest + Language.JavaScript.Host.YQL.Response + Language.JavaScript.Host.YQL.Y + YQL + YQL.Date + YQL.Crypto + YQL.Rest + YQL.Y + + ghc-options: -fno-warn-orphans -fno-warn-unused-binds -fno-warn-unused-do-bind -fno-warn-unused-matches + + extensions: + + build-depends: aeson == 0.8.* + , base == 4.* + , base64-bytestring == 1.0.* + , bytestring == 0.10.* + , containers == 0.4.* || == 0.5.* + , cryptohash == 0.11.* + , data-default == 0.5.* + , ecma262 == 0.0.* + , exceptions == 0.6.* + , hslogger == 1.2.* + , http-conduit == 2.1.* + , http-types == 0.8.* + , lens == 4.6.* + , opendatatable == 0.0.* + , parsec == 3.1.* + , SHA == 1.6.* + , text == 1.1.* + , transformers == 0.4.* + , unordered-containers == 0.2.* + , uri-template == 0.2.* + , utf8-string == 0.3.* + , uuid == 1.3.* + , vector == 0.10.* + , zlib == 0.5.* + +executable yql + default-language: Haskell2010 + + main-is: Main.hs + + ghc-options: -fno-warn-orphans -fno-warn-unused-binds -fno-warn-unused-matches + + other-modules: Main + build-depends: base == 4.* + , yql == 0.0.0 + , containers == 0.4.* || == 0.5.* + , ecma262 == 0.0.* + , exceptions == 0.6.* + , opendatatable == 0.0.* + , hxt == 9.3.*