Allow loading examples from GitHub

client/config/dev/Try.Config.purs

@@ -6,5 +6,5 @@ loaderUrl = "js/output"
 compileUrl :: String
 compileUrl = "http://localhost:8081"
 
-mainGist :: String
-mainGist = "7ad2b2eef11ac7dcfd14aa1585dd8f69"
+mainGithubExample :: String
+mainGithubExample = "purescript/trypurescript/master/client/examples/Main.purs"

client/config/prod/Try.Config.purs

@@ -6,5 +6,5 @@ loaderUrl = "https://compile.purescript.org/output"
 compileUrl :: String
 compileUrl = "https://compile.purescript.org"
 
-mainGist :: String
-mainGist = "7ad2b2eef11ac7dcfd14aa1585dd8f69"
+mainGithubExample :: String
+mainGithubExample = "purescript/trypurescript/master/client/examples/Main.purs"

client/examples/Main.purs

@@ -0,0 +1,57 @@
+module Main where
+
+import Prelude
+
+import Effect (Effect)
+import Data.Foldable (fold)
+import TryPureScript (h1, h2, p, text, list, indent, link, render, code)
+
+main :: Effect Unit
+main =
+    render $ fold
+      [ h1 (text "Try PureScript!")
+      , p (text "Try out the examples below, or create your own!")
+      , h2 (text "Examples")
+      , list (map fromExample examples)
+      , h2 (text "Share Your Code")
+      , p (text "Code can be loaded from a GitHub Gist. To share code, simply include the Gist ID in the URL as follows:")
+      , indent (p (code (text "  try.purescript.org?gist=gist-id")))
+      , p (fold
+          [ text "The Gist should contain a file named "
+          , code (text "Main.purs")
+          , text " containing your PureScript code."
+          ])
+      ]
+  where
+    fromExample { title, gist } =
+      link ("https://gist.github.com/" <> gist) (text title)
+
+    examples =
+      [ { title: "Algebraic Data Types"
+        , gist: "387999a4467a39744ece236e69a442ec"
+        }
+      , { title: "Loops"
+        , gist: "429eab1e957e807f9feeddbf4f573dd0"
+        }
+      , { title: "Operators"
+        , gist: "8395d2b421a5ca6d1056e301a6e12599"
+        }
+      , { title: "Records"
+        , gist: "170c3ca22f0141ed06a120a12b8243af"
+        }
+      , { title: "Recursion"
+        , gist: "659ae8a085f1cf6e52fed2c35ad93643"
+        }
+      , { title: "Do Notation"
+        , gist: "525cb36c147d3497f652028db1214ec8"
+        }
+      , { title: "Type Classes"
+        , gist: "b04463fd49cd4d7d385941b3b2fa226a"
+        }
+      , { title: "Generic Programming"
+        , gist: "e3b6284959f65ac674d39aa981fcb8fb"
+        }
+      , { title: "QuickCheck"
+        , gist: "69f7f94fe4ff3bd47f4b"
+        }
+      ]

client/src/Main.purs

@@ -7,9 +7,10 @@ import Control.Monad.Except.Trans (runExceptT)
 import Data.Array (mapMaybe)
 import Data.Array as Array
 import Data.Either (Either(..))
-import Data.Foldable (elem, fold, for_, intercalate, traverse_)
+import Data.Foldable (elem, fold, for_, intercalate, traverse_, oneOf)
 import Data.FoldableWithIndex (forWithIndex_)
 import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Traversable (sequence)
 import Effect (Effect)
 import Effect.Console (error)
 import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn5, mkEffectFn1, runEffectFn1, runEffectFn2, runEffectFn5)
@@ -22,6 +23,7 @@ import Try.API (CompileError(..), CompileResult(..), CompileWarning(..), Compile
 import Try.API as API
 import Try.Config as Config
 import Try.Gist (getGistById, tryLoadFileFromGist, uploadGist)
+import Try.Github (getRawGithubFile)
 import Try.Loader (Loader, makeLoader, runLoader)
 import Try.QueryString (getQueryStringMaybe, setQueryStrings)
 import Try.Session (createSessionIdIfNecessary, storeSession, tryRetrieveSession)
@@ -231,6 +233,18 @@ loadFromGist id_ k = do
         k { code: "" }
       Right code -> k { code }
 
+loadFromGithub
+  :: String
+  -> ({ code :: String } -> Effect Unit)
+  -> Effect Unit
+loadFromGithub id_ k = do
+  runContT (runExceptT (getRawGithubFile id_)) $
+    case _ of
+      Left err -> do
+        window >>= alert err
+        k { code: "" }
+      Right code -> k { code }
+
 withSession
   :: String
   -> ({ code :: String } -> Effect Unit)
@@ -240,8 +254,11 @@ withSession sessionId k = do
   case state of
     Just state' -> k state'
     Nothing -> do
-      gist <- fromMaybe Config.mainGist <$> getQueryStringMaybe "gist"
-      loadFromGist gist k
+      action <- oneOf <$> sequence
+        [ map loadFromGithub <$> getQueryStringMaybe "github"
+        , map loadFromGist <$> getQueryStringMaybe "gist"
+        ]
+      fromMaybe (loadFromGithub Config.mainGithubExample) action k
 
 -- | Cache the current code in the session state
 cacheCurrentCode :: Effect Unit

client/src/Try/Gist.purs

@@ -5,7 +5,6 @@ module Try.Gist
   , tryLoadFileFromGist
   ) where
 
--- | An abstract data type representing the data we get back from the GitHub API.
 import Prelude
 
 import Control.Monad.Cont.Trans (ContT(..))

client/src/Try/Github.js

@@ -0,0 +1,10 @@
+"use strict";
+
+exports.getRawGithubFile_ = function(id, done, fail) {
+  $.ajax({
+    url: 'https://raw.githubusercontent.com/' + id,
+    dataType: 'text'
+  }).done(done).fail(function(err) {
+    fail("Unable to load file from GitHub");
+  });
+}

client/src/Try/Github.purs

@@ -0,0 +1,20 @@
+module Try.Github where
+
+import Prelude
+
+import Control.Monad.Cont.Trans (ContT(..))
+import Control.Monad.Except.Trans (ExceptT(..))
+import Data.Either (Either(..))
+import Effect (Effect)
+import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, runEffectFn3)
+
+-- | Fetch a raw file from a GitHub repo via raw.githubusercontent.com
+foreign import getRawGithubFile_
+  :: EffectFn3 String
+               (EffectFn1 String Unit)
+               (EffectFn1 String Unit)
+               Unit
+
+-- | A wrapper for `getRawGithubFile_` which uses `ContT`.
+getRawGithubFile :: String -> ExceptT String (ContT Unit Effect) String
+getRawGithubFile id_ = ExceptT (ContT \k -> runEffectFn3 getRawGithubFile_ id_ (mkEffectFn1 (k <<< Right)) (mkEffectFn1 (k <<< Left)))