bsummer4/ListEvents.hs

## 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>

## 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

## 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) })};
	<!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>
	{-# 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
	// 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) })};