diff --git a/Haste/GAPI.hs b/Haste/GAPI.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Haste.GAPI +Description : Entry Module for haste-gapi +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Example of a login to the Google API. Note that @config@ is defined +elsewhere. + +@ + +main :: IO () +main = withGAPI config $ \token -> case token of + OA2Success {} -> + putStrLn $ show token + + OA2Error {errorMsg = e} -> + putStrLn $ "Your success token is invalid (" ++ e ++ ")" + +@ + +The login starts with the @withGAPI@, which will load the Google API +environment. If the script is compiled with @--onexec@ flag, the load will be +significally faster as we don't have to wait until the script has fully loaded +until we download the Google API hooks. + +When loading is done, a @OAuth2Token@ is generated, and we may inspect it +to see wether the login is successful or not. On success, we continue with +showing the token. If not, we print an error instead. Note that the +@withGAPI@ function ought to only be invoked once. + + +Example of a request: + +@ + +greet :: IO () +greet = runR $ do + response <- request "plus\/v1\/people\/me" def + Just [name, pic] \<- sequence <$\> mapM (lookupVal response) [ + "result.displayName", + "result.image.url"] + liftIO . putStrLn $ "Hello " ++ name ++ "! \
" + ++ "You look like this: \
\" + +@ + +The reqeuest above will greet the user by name, fetched from the Google+ API. +A response is generated by taking a Path and some Params to the @request@ +function, which will execute it and return a response. + +After that we look up some fields in the result, namely /result.displayName/ +and /result.image.url/. The first will be bound to name, and the second to +pic. These two elements are both strings, by Haste.Foreign magic. + +After that we use @RequestM@s @liftIO@ (as it's an instance of the MonadIO +class) and present a pretty HTML string! +-} +module Haste.GAPI ( + -- | = Connecting to the Google API + withGAPI, + oa2success, + getToken, + Config(..), + OAuth2Token(..), + -- | = Creating Requests + module Haste.GAPI.Request, + -- | = Handling Results + module Haste.GAPI.Result, + -- | = Common types when working with Google API libraries + module Haste.GAPI.Types + + ) where + +import Haste.Foreign hiding (get, has, hasAll) +import qualified Haste.Foreign as FFI + +-- GHC 7.8 compatibility +import Data.Functor ((<$>)) + +import Haste.GAPI.Request +import Haste.GAPI.Result +import Haste.GAPI.Types +import Data.Default +-- import Control.Monad +import Control.Applicative + +-- Datatypes ----------------------------------------------------------------- + +-- | Google API configuration. For an in-detail description of what each field +-- does, please see the , +-- especially the methods @gapi.auth.authorize@ and @gapi.client.setApiKey@. +data Config = Config { + -- | Client ID to generate an authentification token from. + clientID :: String, + -- | The API key for your application + apiKey :: String, + -- | Here you enter the availiable scopes for your application. + scopes :: String, + -- | If true, the token an attempt will be made to refresh it behind the + -- cenes + immediate :: Bool + } + +instance Show Config where + show (Config cid key scopes' imm) + = "\nConfig: " ++ concatMap (++ "\n\t") [cid, key, scopes', show imm] + +instance ToAny Config where + toAny cfg = toObject [("clientID", toAny $ clientID cfg), + ("apiKey", toAny $ apiKey cfg), + ("scopes", toAny $ scopes cfg), + ("immediate", toAny $ immediate cfg)] + +-- | OAuth2Token, the authentication tokens used by the Google API. +data OAuth2Token = OA2Success { + -- | Authenticated access token + accessToken :: String, + -- | Expiration of the token + expiresIn :: String, + -- | Google API Scopes related to this token. + state :: String + } + | OA2Error { + errorMsg :: String, + state :: String + } + +instance Show OAuth2Token where + show t = if oa2success t + then "Success Token: '" ++ shorten (accessToken t) + ++ "'\n\t for scopes: '" ++ state t + ++ "'\n\t expires in: "++ expiresIn t ++ "s" + else "Failure Token: " ++ errorMsg t + where shorten :: String -> String + shorten str | length str < 16 = str + | otherwise = take 32 str ++ "..." + + +instance FromAny OAuth2Token where + fromAny oa2 = do + success <- FFI.has oa2 "access_token" + if success + then OA2Success <$> FFI.get oa2 "access_token" + <*> FFI.get oa2 "expires_in" + <*> FFI.get oa2 "state" + else OA2Error <$> FFI.get oa2 "error" + <*> FFI.get oa2 "state" + +-- Exported functions -------------------------------------------------------- +-- | Returns true if the token represents a successful authentication +oa2success :: OAuth2Token -> Bool +oa2success OA2Success {} = True +oa2success _ = False + +-- | Loads the Google API, inserts Google API headers and then executes +-- an action. +withGAPI :: Config -> (OAuth2Token -> IO ()) -> IO () +withGAPI cfg handler = do + loadGAPI cfg handler + loadGAPIExternals "GAPILoader" + +-- | Exports and coordinate loading of the Google API. +loadGAPI :: Config -> (OAuth2Token -> IO ()) -> IO () +loadGAPI = loadGAPI' "GAPILoader" + +-- | Loads the Google API with a custom loader name +loadGAPI' :: String -> Config -> (OAuth2Token -> IO ()) -> IO () +loadGAPI' symbol cfg handler + = exportLoaderSymbol symbol $ loadClient cfg $ auth cfg handler + +-- | Returns the token from the current Google API state +getToken :: IO OAuth2Token +getToken = ffi "(function() {return gapi.auth.getToken();})" + +-- | Loads the GAPI Client +loadClient :: Config -> IO () -> IO () +loadClient = ffi "(function(cfg, auth){\ +\gapi.client.setApiKey(cfg.apiKey); \ +\window.setTimeout(auth, 1);})" + +-- | Authenticates the user. Should be invoked by loadClient +auth :: Config -> (OAuth2Token -> IO ()) -> IO () +auth = ffi "(function(cfg, ah)\ +\{gapi.auth.authorize({\ + \'client_id': cfg.clientID, \ + \'scope': cfg.scopes, \ + \'immediate': cfg.immediate}, \ +\ah);})" + +-- | Export the loader symbol +exportLoaderSymbol :: String -> IO () -> IO () +exportLoaderSymbol = ffi "(function(s, f) {window[s] = f;})" + +-- | Loads the external GAPI scripts +loadGAPIExternals :: String -> IO () +loadGAPIExternals = ffi "(function(sym) {\ +\var s = document.createElement('script');\ +\s.setAttribute('src', 'https://apis.google.com/js/client.js?onload=' + sym);\ +\s.setAttribute('type', 'text/javascript');\ +\document.head.appendChild(s);})" diff --git a/Haste/GAPI/GPlus.hs b/Haste/GAPI/GPlus.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/GPlus.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.GPlus +Description : Google+ API bindings for haste-gapi +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Contains default function and result mappings for the Google+ API. +-} +module Haste.GAPI.GPlus ( + peopleGet, + peopleSearch, + peopleListByActivity, + peopleList, + -- | = Google+ datatypes: + + -- | == Google+ Person + module Haste.GAPI.GPlus.Person + + ) where + + +import Haste.GAPI.Types +import Haste.GAPI.GPlus.Person +import Haste.GAPI.Request +import Haste.JSString as J +import Haste (JSString) + +-- | Fetches a user by ID +peopleGet :: UserID -> RequestM (Result Person) +peopleGet uid = request' $ "plus/v1/people/" `append` uid + +-- | Search after users given a query string +-- +-- Optional parameters: +-- +-- [@language@] @language@ to search with. See Google API documentation +-- for valid language codes +-- +-- [@maxResult@] Maximum number of people to include in the response. +-- Acceptable values of @maxResult@ ranges between 1-50, +-- default is 25. +-- +-- [@pageToken@] Token used for pagination in large result sets. +peopleSearch :: JSString -> Params -> RequestM [Result Person] +peopleSearch query ps = do + r <- request "plus/v1/people" $ ("query", query) `pcons` ps + r' <- get r "items" + childs <- children r' + case childs of + Just childs' -> return childs' + Nothing -> fail "peopleSearch: Child was not found!" + +-- | List users by activity +-- +-- Valid collections are "@plusoners@" and "@resharers@". +-- +-- Optional parameters: +-- +-- [@maxResult@] Maximum number of people to include in the response. +-- Acceptable values of @maxResult@ ranges between 1-100, +-- default is 20. +-- +-- [@pageToken@] Token used for pagination in large result sets. +peopleListByActivity :: ActivityID -> Collection -> Params + -> RequestM [Result Person] +peopleListByActivity actId col ps = do + r <- request (J.concat ["plus/v1/activities/", actId, "/people/", col]) ps + r' <- get r "items" + childs <- children r' + case childs of + Just childs' -> return childs' + Nothing -> fail "peopleSearch: Child was not found!" + + + +-- | List people in a specific collection +-- +-- Accepted collections are: +-- +-- [@connected@] The list of visible people in the authenticated user's +-- circles who also use the requesting app. This list +-- is limited to users who made their app activities visible +-- to the authenticated user. +-- +-- [@visible@] The list of people who this user has added to one or more +-- circles, limited to the circles visible to the requesting +-- application. +-- +-- Optional parameters: +-- +-- [@maxResult@] Maximum number of people to include in the response. +-- Acceptable values of @maxResult@ ranges between 1-100, +-- default is 100. +-- +-- [@orderBy@] The order to return people in. Valid inputs are +-- "@alphabetical@" and "@best@" +-- +-- [@pageToken@] Token used for pagination in large result sets. +peopleList :: UserID -> Collection -> Params -> RequestM [Result Person] +peopleList uid c ps = do + r <- request (J.concat ["plus/v1/people/", uid, "/people/", c]) ps + r' <- get r "items" + childs <- children r' + case childs of + Just childs' -> return childs' + Nothing -> fail "peopleSearch: Child was not found!" + + + + + + + + + diff --git a/Haste/GAPI/GPlus/Person.hs b/Haste/GAPI/GPlus/Person.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/GPlus/Person.hs @@ -0,0 +1,17 @@ +{-| +Module : Haste.GAPI.GPlus.Person +Description : Functions for working on persons +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Functions which maps to the Google API +-} +module Haste.GAPI.GPlus.Person where + +-- | Haste.GAPI.Result type parameter +data Person + + diff --git a/Haste/GAPI/Internals/Promise.hs b/Haste/GAPI/Internals/Promise.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Internals/Promise.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.Internals.Promise +Description : Mapping to Google API promises +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Wraps Promises as implemented in Google API with a haskell representation. +-} +module Haste.GAPI.Internals.Promise where + +import Haste +import Haste.Foreign + +-- | An argument to a fulfilled promise +type Response = JSAny +-- | An argument to a rejected promise +type Reason = JSAny + +-- | A promise is either a true promise or a callback +-- (a default error handler will be provided) +data Promise = Promise (Response -> IO ()) (Reason -> IO ()) + | Callback (Response -> IO ()) + +-- | Transform a promise to an any (for application) +instance ToAny Promise where + toAny (Promise thn err) = toObject [("then", toAny thn), + ("error", toAny err)] + toAny (Callback cbk) = toObject [("then", toAny cbk), + ("error", toAny gapiError)] + +-- | Apply a promise to a JSAny +applyPromise :: JSAny -> Promise -> IO () +applyPromise = ffi "(function(action, p) {action.then(p.then, p.error);})" + +-- | Default error handler in promises +gapiError :: (JSString -> IO ()) -> Reason -> IO () +gapiError action reason + = do msg <- lookupAny reason "result.error.message" + case msg of + Just m -> do str <- fromAny m + action str + Nothing -> putStrLn "Malformed response!" diff --git a/Haste/GAPI/Request.hs b/Haste/GAPI/Request.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Request.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.Request +Description : Contains everything Request-related +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Contains RequestM and run functions. + +-} +module Haste.GAPI.Request ( + RequestM (..), + Request (..), + Result(..), + Path (..), + runR, runRConc, + request, request', + has, get, hasAll, val, valOf, children, + lookupResult, lookupVal, + -- | Perform an IO Action inside RequestM + liftIO, + -- | Perform a CIO Action inside RequestM + liftConc, + -- | === Constructing parameters + Params(), + parp, merge, pcons, params + ) where + +import Haste.GAPI.Internals.Promise +import Haste.GAPI.Request.RequestM +import Haste.GAPI.Request.Types ( + Path, + Params(..), Request(..), + merge, pcons, params, + rawRequest) +import Haste.GAPI.Request.Raw +import Haste.GAPI.Result +import qualified Haste.JSString as J + +import Haste.Foreign hiding (has, get, hasAll) +import Haste.Concurrent + +import Data.Default +import Control.Monad +import Control.Applicative + +-- | Runs the request eDSL +runR :: RequestM () -> IO () +runR = concurrent . void . unR + +-- | Runs the request eDSL from a concurrent context +runRConc :: RequestM () -> CIO () +runRConc = void . unR + +-- | Creates a request from an API path and a series of parameters. +request :: Path -> Params -> RequestM (Result a) +request p ps = customRequest (rawRequest p ps) + +-- | Performs a request from an API path but without parameters +request' :: Path -> RequestM (Result a) +request' p = customRequest (rawRequest p def) + +-- | Creates a request using a custom request +customRequest :: Request -> RequestM (Result a) +customRequest req = do + v <- newEmptyMVar + liftConc . fork . liftIO $ do + resp <- jsCreateRequest (path req) (toAny $ rparams req) + applyPromise resp $ Promise (concurrent . putMVar v . Right . toResult) + (\_r -> concurrent . putMVar v . Left . J.pack $ + "Request error: " ++ show req) + Req $ takeMVar v + diff --git a/Haste/GAPI/Request/Raw.hs b/Haste/GAPI/Request/Raw.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Request/Raw.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.Request.Raw +Description : JavaScript functions needed by Request handling. +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Contains JavaScript foreign functions for use with the request handler. +-} + +module Haste.GAPI.Request.Raw where + +import Haste +import Haste.Foreign +import Haste.GAPI.Internals.Promise + +-- | Creates a request object +jsCreateRequest :: JSString -> JSAny -> IO JSAny +jsCreateRequest = ffi "(function(p, ps) {\ +\return gapi.client.request({'path': p, 'params': ps})\ +\})" + +-- | Executes a request and performs the given action as a continuation +jsExecuteRequestThen :: JSString -> JSAny -> (Response -> IO ()) -> IO () +jsExecuteRequestThen = ffi "(function(p, ps, callback) {\ +\ gapi.client.request({'path': p, 'params': ps}).then({\ +\'then': function(resp) {callback(resp);}, \ +\'error': function(err) {console.debug(err);}\ +\});\ +\})" + diff --git a/Haste/GAPI/Request/RequestM.hs b/Haste/GAPI/Request/RequestM.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Request/RequestM.hs @@ -0,0 +1,59 @@ +{-| +Module : Haste.GAPI.Request.RequestM +Description : Monad for use in Requests +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Contains the Request Monad with all its instances +-} +module Haste.GAPI.Request.RequestM ( + Error, + RequestM(..), + liftIO + ) where + +import Haste +import Control.Monad +import Data.Functor +import Haste.Concurrent +import Control.Monad.IO.Class +import Control.Applicative +import qualified Haste.JSString as J + +-- | A default error type for RequestM, will be customisable in the future. +type Error = JSString + +-- | An eDSL for requests. +newtype RequestM a = Req {unR :: CIO (Either Error a)} + +-- | RequestM can perform CIO actions +instance MonadConc RequestM where + liftConc a = Req $ a >>= return . Right + fork (Req c) = Req $ (fork $ void c) >>= return . Right + +-- | RequestM can perform IO actions +instance MonadIO RequestM where + liftIO a = Req $ liftIO a >>= return . Right + +-- | RequestM is a monad +instance Monad RequestM where + fail err = Req . return . Left $ J.pack err + return a = Req . return $ Right a + (Req a) >>= f = Req $ do + a' <- a + case a' of + Right good -> unR $ f good + Left bad -> do + return $ Left bad + +-- | Applicative is defined so that it builds under GHC 7.8 +instance Applicative RequestM where + (<*>) = ap + pure = return + +-- | Functor is defined so that it builds under GHC 7.8 +instance Functor RequestM where + fmap f m = m >>= return . f diff --git a/Haste/GAPI/Request/Types.hs b/Haste/GAPI/Request/Types.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Request/Types.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.Request.Types +Description : Types used in requests. +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Contains default types and functions to work on them. +-} + + +module Haste.GAPI.Request.Types where + +-- GHC 7.8 compatibility +import Data.Functor ((<$>)) + +import Haste +import Haste.Foreign +import Data.Default +import qualified Haste.JSString as J + +-- | Returns an Anys children as a Key-value array +getKV :: JSAny -> IO [(JSString, JSString)] +getKV = ffi "(function(obj) {\ +\var out = [];\ +\for(i in obj) { out.push([i, obj[i] ]); }\ +\return out;\ +\})" + +-- | Path for requests +type Path = JSString + +-- | Parameters for a GAPI request +data Params = Params [(JSString, JSString)] + deriving Show + +-- | Params can be constructed from a JSAny +instance FromAny Params where + fromAny a = Params <$> getKV a + +-- | Params can be converted to a JSAny +instance ToAny Params where + toAny (Params ps) = let objField (k,v) = (k, toAny $ v) + in toObject $ map objField ps + +-- | Empty Parameters as a default instance +instance Default Params where + def = Params [] + +-- | Merge two parameters +merge :: Params -> Params -> Params +merge (Params xs) (Params ys) = Params $ xs ++ ys + +-- | Cons a param with a base value +pcons :: (JSString, JSString) -> Params -> Params +pcons x (Params xs) = Params $ x:xs + +-- | Create a set of parameters +params :: [(JSString, JSString)] -> Params +params = Params + +-- | Request with parameters and everything +data Request = Request { path :: Path, + method :: JSString, + rparams :: Params, + headers :: JSString, + body :: JSString} + +-- | The requests can be shown as a debug feature +instance Show Request where + show (Request p m pms _hs _body) + = let showDict :: (String, String) -> String + showDict (a,b) = "\n\t" ++ a ++ ": " ++ b + showParams (Params p') + = show $ map (\(a,b) -> (J.unpack a, J.unpack b)) p' + in "Request: " ++ concatMap showDict [ + ("Path", J.unpack p), + ("Method", J.unpack m), + ("Params", showParams pms) + ] + +-- | A default request without any path given +instance Default Request where + def = rawRequest "" def + + +-- | Creates a request by manually entering request path and parameters +rawRequest :: JSString -> Params -> Request +rawRequest p ps = Request { path = p, + method = "GET", + rparams = ps, + headers = "", + body = "" } + diff --git a/Haste/GAPI/Result.hs b/Haste/GAPI/Result.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Result.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Haste.GAPI.Result +Description : Managing Results within the Google API +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +This module contains functions to work on results from requests to the Google +API. +-} + + +module Haste.GAPI.Result ( + Result(), + Raw(..), + get, has, hasAll, + lookupVal, lookupResult, + val, valOf, valMaybe, + parp, children, + toResult + ) where + +import Haste +import qualified Haste.Foreign as F +import qualified Haste.JSString as J + +-- GHC 7.8 compatibility +import Data.Functor ((<$>)) + +import Haste.GAPI.Request.Types +import Haste.GAPI.Request.RequestM + +-- | Result mapping. The Result takes a parameter to act as a phantom type +-- on which kind of object you're currently working on. +newtype Result a = Result {rawR :: F.JSAny} + + +-- | Transforms a JSAny to a Result +toResult :: JSAny -> Result a +toResult = Result + +-- | Default result parameter. +data Raw + +-- | Fetches a data field from a GAPI Result +get :: Result a -> JSString -> RequestM (Result Raw) +get (Result r) key = liftIO $ do + h <- F.has r key + if h then Result <$> F.get r key + else fail $ "Child '" ++ J.unpack key ++ "' was not found." + +-- | Looks up a value by a deep index +-- Example: +-- +-- @ +-- rLookup res "a.b.c" +-- @ +-- +-- This will look up`(a.b.c)` where `a` is a field of +-- `res`, `b` is a field of `a`, and `c` is a field of `b`. +lookupVal :: F.FromAny any => Result a -> JSString -> RequestM (Maybe any) +lookupVal res keys = liftIO $ do + v <- F.lookupAny (rawR res) keys + case v of + Just a -> Just <$> F.fromAny a + Nothing -> return Nothing + +-- | Fetches a result from a deep index +lookupResult :: Result a -> JSString -> RequestM (Maybe (Result Raw)) +lookupResult res keys + = liftIO $ fmap Result <$> F.lookupAny (rawR res) keys + +-- | Checks if a Result has a certain field +has :: Result a -> JSString -> RequestM Bool +has (Result res) key = liftIO $ F.has res key + +-- | Checks if a Result has several different fields. Will return true only +-- if all these fields exists. +hasAll :: Result a -> [JSString] -> RequestM Bool +hasAll res keys = and <$> mapM (has res) keys + +-- | Fetches a value from a field, in contrast to a result. +-- Field must contain a value compatible with fromAny +-- Terminates with an error if the field cannot be found. +val :: F.FromAny any => Result a -> JSString -> RequestM any +val r key = liftIO $ F.get (rawR r) key >>= F.fromAny + +-- | Fetches the value of the result directly. +valOf :: F.FromAny any => Result a -> RequestM any +valOf = liftIO . F.fromAny . rawR + +-- | Same as `val`, but will return Nothing if there is no such field. +valMaybe :: F.FromAny any => Result a -> JSString -> RequestM (Maybe any) +valMaybe (Result res) key = liftIO $ do + exists <- F.has res key + if exists then Just <$> (F.get res key >>= F.fromAny) + else return Nothing + +-- | Takes a result and a list of keys and maps these values to Params. +parp :: Result a -> [JSString] -> RequestM (Maybe Params) +parp r keys = do + exists <- hasAll r keys + if not exists + then return Nothing + else do vals <- mapM (val r) keys + return . Just . Params $ zip keys vals + + +-- | Transforms a JSAny representing a list into a list of its children +children' :: JSAny -> IO [JSAny] +children' = F.fromAny + +-- | Checks if a fromAny is an array +isArray :: JSAny -> IO Bool +isArray = F.ffi "(function(a) {\ +\return a.prop \ +\&& a.prop.constructor === Array;\ +\})" + +-- | Transforms a result which represents an array into a list of child +-- elements +children :: Result a -> RequestM (Maybe [Result b]) +children (Result res) = do + arr <- liftIO $ isArray res + if arr + then do + childs <- liftIO $ children' res + return . Just $ map Result childs + else return Nothing diff --git a/Haste/GAPI/Types.hs b/Haste/GAPI/Types.hs new file mode 100644 --- /dev/null +++ b/Haste/GAPI/Types.hs @@ -0,0 +1,43 @@ +{-| +Module : Haste.GAPI.Types +Description : Types used in different subsection APIs, like Google+ +Copyright : (c) Jonathan Skårstedt, 2016 +License : MIT +Maintainer : jonathan.skarstedt@gmail.com +Stability : experimental +Portability : Haste + +Types for use by different APIs connecting to haste-gapi. +-} +module Haste.GAPI.Types where + +import Haste (JSString) + +-- | Resource versioning tag. Will be updated if the resource is updated +type ETag = JSString + +-- | An e-mail address +type EMail = JSString + +-- | Type of e-mail address. +type EMailType = JSString + +-- | An URL +type URL = JSString + +-- | User id +type UserID = JSString + +-- | Activity id +type ActivityID = JSString + +-- | Type of Collection +type Collection = JSString + +-- | Type of URL, like contributor (user is contributing to this site) or +-- website. +type URLType = JSString + +-- | An image wrapped URL +data Image = Image URL + deriving Show diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Jonathan Skårstedt + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 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/haste-gapi.cabal b/haste-gapi.cabal new file mode 100644 --- /dev/null +++ b/haste-gapi.cabal @@ -0,0 +1,61 @@ +name: haste-gapi +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 +synopsis: Google API bindings for the Haste compiler +-- A longer description of the package. +description: This is a library to make use of the Google API Client + Library for JavasScript in a Haskell environment! + + The library works by wrapping login and giving you a + fancy type to perform your requests in. This will ease + chained requests that would give large amounts of clutter + in JavaScript, while giving you a better ability to + handle errors. + + Your HTML doesn't even need to load the GAPI library + itself, Haste-GAPI handles that for you! + +license: MIT +license-file: LICENSE +author: Jonathan Skårstedt +maintainer: jonathan.skarstedt@gmail.com +-- copyright: +category: Web +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: github + location: https://github.com/nyson/haste-gapi + + + +library + -- Modules exported by the library. + exposed-modules: Haste.GAPI, + Haste.GAPI.GPlus, + Haste.GAPI.Types + + -- Modules included in this library but not exported. + other-modules: Haste.GAPI.Result, + Haste.GAPI.Request, + Haste.GAPI.Request.RequestM, + Haste.GAPI.Request.Types, + Haste.GAPI.Request.Raw, + Haste.GAPI.GPlus.Person, + Haste.GAPI.Internals.Promise + + other-extensions: OverloadedStrings + build-depends: base == 4.* , data-default >= 0.5, transformers >= 0.4 +-- if impl(haste) + build-depends: haste-lib >=0.5.1 +-- else + -- build-depends: haste-compiler >=0.5.1 + + default-language: Haskell2010 +