Skip to content

Instantly share code, notes, and snippets.

@bsummer4

bsummer4/ListEvents.hs

Last active August 30, 2015 20:22
Show Gist options
  • Save bsummer4/019a0c44caa4094e0442 to your computer and use it in GitHub Desktop.
Save bsummer4/019a0c44caa4094e0442 to your computer and use it in GitHub Desktop.
Download ZIP
Finally managed to get something trivial working with GHCJS.
Raw
index.html
<!DOCTYPE html>
<html>
<head>
<script type="text/javascript">
function gapiLoaded () { console.log("gapi is loaded."); }
</script>
<script src="https://apis.google.com/js/client.js?onload=gapiLoaded"></script>
<script language="javascript" src="ListEventsHelpers.js"></script>
<script language="javascript" src="rts.js"></script>
<script language="javascript" src="lib.js"></script>
<script language="javascript" src="out.js"></script>
</head>
<body>
<button id="authorize" type="button">Authorize</button>
</body>
<script language="javascript" src="runmain.js" defer></script>
</html>
Raw
ListEvents.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}
module Main where
import Control.Concurrent
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Aeson as JSON
import qualified Data.Aeson.TH as JSON
import qualified Data.ByteString.Lazy as LBS
import Data.Default
import qualified Data.List as List
import Data.String.Conversions (cs)
import Data.Text
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock (DiffTime, secondsToDiffTime)
import Data.Time.Clock (UTCTime)
import GHCJS.Foreign
import GHCJS.Marshal
import GHCJS.Types
import JavaScript.JQuery
type LazyByteString = LBS.ByteString
-- Foreign Imports -------------------------------------------------------------
foreign import javascript interruptible
"gapi_authorize($1,$2,$3,$c);"
js_gapi_authorize ∷ JSString → JSArray JSString → JSBool → IO JSBool
foreign import javascript unsafe
"console.log($1);"
js_log ∷ JSRef a → IO ()
foreign import javascript interruptible
"gapi.client.load('calendar', 'v3', $c);"
js_gapi_client_load ∷ IO (JSRef a)
foreign import javascript interruptible
"august_events($c);"
js_august_events ∷ IO (JSArray a)
foreign import javascript unsafe
"JSON.stringify($1)"
js_json_stringify ∷ JSRef o → IO JSString
-- Types -----------------------------------------------------------------------
data Credentials = Credentials { clientID ∷ !Text
, scopes ∷ ![Text]
}
data GCalEvent = GCalEvent { start ∷ UTCTime
, end ∷ UTCTime
, color ∷ Int
, summary ∷ Text
, description ∷ Text
}
$(JSON.deriveJSON JSON.defaultOptions ''GCalEvent)
-- Basic Values ----------------------------------------------------------------
creds ∷ Credentials
creds =
Credentials
"..."
["https://www.googleapis.com/auth/calendar.readonly"]
-- Application -----------------------------------------------------------------
main = do
putStrLn "Haskell code is now loaded"
authSignal ← newEmptyMVar
forkIO $ do putStrLn "Thread 1 -- Authorizing from the cache"
authorizeFromCache creds >>= \case
False → putStrLn "Thread 1 -- Authorization was not in the cache :("
True → do putStrLn "Thread 1 -- Authorized using the cache!"
putMVar authSignal ()
let tryAuthByPopup = void $ forkIO $ do
putStrLn "Side Thread -- Authorizing from a pop-up"
authorizeWithPopup creds >>= \case
False → do putStrLn "Thread 2 -- Failed to authorize by pop-up."
True → do putStrLn "Thread 2 -- Authorized via pop-up!"
putMVar authSignal ()
removeHandler ← select "#authorize" >>= click (const tryAuthByPopup) def
() ← takeMVar authSignal
putStrLn "Main thread is now authenticated"
removeHandler
putStrLn "Loading Google's Calendar library."
void $ js_gapi_client_load
putStrLn "Getting a list of events."
events ← js_august_events
putStrLn "Printing all events."
js_log events
putStrLn "Done!"
fromJust (Just x) = x
fromJSText ∷ JSString → Text
fromJSText = fromJSString
marshallEvent ∷ JSRef a → IO (Maybe GCalEvent)
marshallEvent = fmap (JSON.decode . cs . fromJSText) . js_json_stringify
toJSArray ∷ [JSRef a] → IO (JSArray (JSRef a))
toJSArray = toArray <=< mapM toJSRef
gapi_authorize ∷ Credentials → Bool → IO Bool
gapi_authorize creds immediate = do
fmap fromJSBool $ join $ js_gapi_authorize
<$> (pure $ toJSString $ clientID creds)
<*> (toJSArray $ toJSString <$> scopes creds)
<*> (pure $ toJSBool immediate)
authorizeFromCache ∷ Credentials → IO Bool
authorizeFromCache = flip gapi_authorize True
authorizeWithPopup ∷ Credentials → IO Bool
authorizeWithPopup = flip gapi_authorize False
Raw
ListEventsHelpers.js
// gapi_authorize ∷ (String, [String], Bool, Bool → JS a) → JS b
var gapi_authorize = function(cid,scope,immediate,cont) {
var params = {client_id:cid, scope:scope, immediate:immediate};
var authResult = gapi.auth.authorize(params,function (authResult) {
cont(authResult && !authResult.error)
});
};
var eventFields =
[ 'items(start,end,colorId,description,summary)'
, 'kind'
, 'summary'
];
var allEventsStartingInAugust =
{ calendarId: 'primary'
, timeMin: new Date(2015,7,1).toISOString()
, timeMax: new Date(2015,8,1).toISOString()
, showDeleted: false
, singleEvents: true
, maxResults: 2500
, fields: eventFields.join(',')
, orderBy: 'startTime'
};
// august_events ∷ JSArray a → JS b
var august_events = function (cont) {
gapi.client.calendar.events.list(allEventsStartingInAugust)
.execute(function(response){
if (!response || !('items' in response)) {
return null }
var events = response.items
var getDate = function(e,k) {return new Date(e[k].dateTime || e[k].date)}
var results = events.map(function(event) {
console.log('august_events()', 'EVENT', event)
return { start: getDate(event, 'start')
, end: getDate(event, 'end')
, color: event.colorId
, summary: event.summary
, description: event.description
}});
console.log('august_events()', 'EVENT_COUNT', results.length)
cont(results) })};
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment