Skip to content

Instantly share code, notes, and snippets.

@owickstrom

owickstrom/.gitignore

Last active September 4, 2017 04:43
Show Gist options
  • Save owickstrom/91615af9d0de89cf2107efaa57a8b019 to your computer and use it in GitHub Desktop.
Save owickstrom/91615af9d0de89cf2107efaa57a8b019 to your computer and use it in GitHub Desktop.
Download ZIP
Compile-time checking globally loaded scripts for Yesod
Raw
README.md

Compile-time checking globally loaded scripts for Yesod

Yesod has powerful features for including dynamic scripts, using widgets. In many cases this is exactly what I want, but in some, I want scripts to be loaded globally in all pages.

The primary motivation for globally loaded scripts, appearing in the <head> element in all pages, is for using something like PJAX, possibly together with HTML5 custom elements. I'd like to declare a number of custom elements, and only use HTML markup in the widgets using the custom elements, i.e. no dynamic script tags added to the page by the widgets. By doing so, the PJAX-variant could be much simpler, not having to inject scripts in the page sent in the PJAX response. All custom elements' Javascript would already be loaded, and the DOM insertions of the widget markup would trigger the scripts to run.

A complication with these global scripts are that all possibly needed scripts have to be loaded. For this to be statically known, at compile-time, the globally loaded scripts need to represented in types somehow. This demonstration is a dumbed down version of Yesod, just to illustrate the design, and some machinery for associating global scripts with an application (Foundation type).

Raw
global-scripts.cabal
name: global-scripts
version: 0.1.0.0
homepage: https://gist.github.com/owickstrom/91615af9d0de89cf2107efaa57a8b019
author: Oskar Wickström
maintainer: [email protected]
copyright: 2017 Oskar Wickström
category: Web
build-type: Simple
cabal-version: >=1.10
extra-source-files: README.md
executable global-scripts
hs-source-dirs: .
main-is: Main.hs
default-language: Haskell2010
build-depends: base >= 4.7 && < 5
, protolude
, text
, mtl
Raw
Main.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Protolude
import Control.Monad.Reader hiding ((<>))
import Control.Monad.Writer hiding ((<>))
import Data.String
-- YESOD LIGHT
type Widget app a = WriterT Text (Reader app) a
respond :: Text -> Widget app ()
respond = tell
runWidget :: app -> Widget app a -> (a, Text)
runWidget app = flip runReader app . runWriterT
-- GLOBAL SCRIPTS LIBRARY
-- | For applications (Yesod foundation types) that that have globally
-- loaded scripts.
class GlobalScripts app where
type Scripts app :: [*]
globalScripts :: app -> HList (Scripts app)
-- | Specialized result type used in checking if a global script is
-- available. Used instead of type-level boolean for better error
-- messages.
data ScriptAvailability where
ScriptNotAvailable :: k -> ScriptAvailability
ScriptAvailable :: ScriptAvailability
-- | Checks if a global script is available in the list.
type family HasScript (x :: *) (xs :: [*]) where
HasScript x '[] = 'ScriptNotAvailable x
HasScript x (x ': xs) = 'ScriptAvailable
HasScript x (a ': xs) = HasScript x xs
-- | Asserts that the application has a given script globally loaded.
requireGlobalScript
:: forall script app.
(HasScript script (Scripts app) ~ 'ScriptAvailable)
=> Proxy script -> Widget app ()
requireGlobalScript script = return ()
-- | Get the source for a single script.
class ScriptSource s where
scriptSource :: s -> Text
-- | Get the sources for a multiple scripts.
class ScriptSources s where
scriptSources :: s -> [Text]
-- | HList could perhaps come from some library...
data HList xs where
Nil :: HList '[]
Cons :: x -> HList xs -> HList (x ': xs)
instance (ScriptSource x, ScriptSources (HList xs)) =>
ScriptSources (HList (x ': xs)) where
scriptSources (Cons x xs) =
scriptSource x : scriptSources xs
instance ScriptSources (HList '[]) where
scriptSources Nil = []
-- | Runs a widget, returning all script tags and page content as
-- 'Text'. This would look a bit different in a real implementation.
runHandler
:: (GlobalScripts app, ScriptSources (HList (Scripts app)))
=> app -> Widget app () -> Text
runHandler app w =
scriptSources (globalScripts app)
& map scriptTag
& mconcat
& (<> pc)
where
scriptTag src =
mconcat [ "<script src=\"", src, "\"></script>"]
(_, pc) = runWidget app w
-- This is the part the user would write. Perhaps not the 'JQuery' definition.
-- SCRIPTS
data JQuery
= JQuerySlimMinified
| JQueryUncompressed
instance ScriptSource JQuery where
scriptSource =
\case
JQueryUncompressed -> "https://code.jquery.com/jquery-3.2.1.js"
JQuerySlimMinified -> "https://code.jquery.com/jquery-3.2.1.slim.min.js"
newtype MyCustomElements = MyCustomElements { root :: Text }
instance ScriptSource MyCustomElements where
-- | Here would be nice to refer to a StaticR route.
scriptSource customElements =
root customElements <> "/my-custom-elements.js"
-- APP
newtype TestApp = TestApp { appDevelopment :: Bool }
instance GlobalScripts TestApp where
-- | We specify what scripts are globally available in our
-- application.
type Scripts TestApp = '[ JQuery, MyCustomElements]
-- | We provide specific values for the global scripts. Different
-- versions of jQuery might be loaded at runtime, but the Widgets
-- don't care as long as it's the JQuery type.
globalScripts TestApp {..} =
Cons jquery (Cons (MyCustomElements customElementsRoot) Nil)
where
jquery =
if appDevelopment
then JQueryUncompressed
else JQuerySlimMinified
customElementsRoot =
if appDevelopment
then ""
else "https://my-site.example.com"
-- WIDGETS
--
-- Here we can require scripts be loaded globally, and this be sure at
-- compile-time they are.
myWidget1 :: Widget TestApp ()
myWidget1 = do
requireGlobalScript (Proxy @JQuery)
respond "<p>Hello, I use jQuery!</p>"
myWidget2 :: Widget TestApp ()
myWidget2 = do
requireGlobalScript (Proxy @JQuery)
respond "<p>I also depend on Query.</p>"
myWidget3 :: Widget TestApp ()
myWidget3 = do
requireGlobalScript (Proxy @MyCustomElements)
respond "<my-custom-element>Here we go!</my-custom-element>"
myHandler :: Widget TestApp ()
myHandler = do
myWidget1
myWidget2
myWidget3
-- MAIN
main :: IO ()
main = do
let app = TestApp {appDevelopment = False}
putStrLn $ runHandler app myHandler
-- PROGRAM OUTPUT
--
-- *Main> :main
-- <script src="https://code.jquery.com/jquery-3.2.1.slim.min.js"></script><script src="https://my-site.example.com/my-custom-elements.js"></script><p>Hello, I use jQuery!</p><p>I also depend on Query.</p><my-custom-element>Here we go!</my-custom-element>
Raw
Setup.hs
import Distribution.Simple
main = defaultMain
Raw
stack.yaml
resolver: lts-9.2
packages:
- '.'
extra-deps: []
flags: {}
extra-package-dbs: []
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment