├── .gitignore
├── LICENSE
├── README.markdown
├── Setup.lhs
├── main
    └── yesod-slides.hs
├── src
    └── Slides.hs
└── yesod-slides.cabal


/.gitignore:
--------------------------------------------------------------------------------
1 | /dist/
2 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The following license covers this documentation, and the source code, except
 2 | where otherwise indicated.
 3 | 
 4 | Copyright 2011, Hamish Mackenzie. All rights reserved.
 5 | 
 6 | Redistribution and use in source and binary forms, with or without
 7 | modification, are permitted provided that the following conditions are met:
 8 | 
 9 | * Redistributions of source code must retain the above copyright notice, this
10 |   list of conditions and the following disclaimer.
11 | 
12 | * Redistributions in binary form must reproduce the above copyright notice,
13 |   this list of conditions and the following disclaimer in the documentation
14 |   and/or other materials provided with the distribution.
15 | 
16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
17 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
18 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
19 | EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
20 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
22 | OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
24 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
25 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 | 


--------------------------------------------------------------------------------
/README.markdown:
--------------------------------------------------------------------------------
  1 | Quick Tour to Yesod
  2 | ===================
  3 | 
  4 | These are the slides I used in my presentation to the Wellington FP Users group.  After each slide I showed the code for the slide and discussed how it works.
  5 | 
  6 | The talk covered the parts of Yesod that were of particular interest to me.
  7 | 
  8 | I have now extended the slides to include an example of using GHCJS to run Haskell in the web browser.
  9 | 
 10 | Building GHC with JavaScript output
 11 | -----------------------------------
 12 | This version of GHC makes a .js file whenever it outputs an object file.  It also "links" the javascript by copying all the files .js files into a .jsexe directory.
 13 | It has its own version of cabal so that .js files and .jsexe directories are installed properly.
 14 | 
 15 | <pre>
 16 | git clone https://github.com/the-real-blackh/ghc.git
 17 | cd ghc
 18 | ./sync-all -r https://github.com/ghc get
 19 | ./sync-all -r https://github.com/ghc get
 20 | ./sync-all -r https://github.com/ghc get
 21 | ./sync-all -r https://github.com/ghc get
 22 | </pre>
 23 | 
 24 | (You may need to rerun sync-all a few times if like me you get network errors part way through)
 25 | 
 26 | <pre>
 27 | rm -rf libraries/Cabal
 28 | git clone https://github.com/the-real-blackh/packages-Cabal.git libraries/Cabal
 29 | cp mk/build.mk.sample mk/build.mk
 30 | perl boot
 31 | ./configure --prefix=/home/hamish/ghcjs
 32 | make
 33 | make install
 34 | </pre>
 35 | 
 36 | To use this compiler add /home/hamish/ghcjs to your path ahead of any other ghc.
 37 | 
 38 | <pre>
 39 | export PATH=/home/hamish/ghcjs/bin:$PATH
 40 | </pre>
 41 | 
 42 | You should be able to switch back to your main compiler at any point by simply not including this in you path.
 43 | 
 44 | The global packages (including JavaScript) will be installed to something like
 45 | 
 46 |  * ~/ghcjs/lib/ghc-7.1.20110508
 47 | 
 48 | User cabal packages are installed to something like
 49 | 
 50 |  * ~/.ghc/i386-darwin-7.1.20110508
 51 |  * ~/.cabal/lib/*/ghc-7.1.20110508
 52 | 
 53 | Installing cabal-install with GHCJS
 54 | -----------------------------------
 55 | You need to make a version of cabal-install that uses the new Cabal package.  So that which you run "cabal install" it will copy .js files and .jsexe directories to the install location.
 56 | 
 57 | <pre>
 58 | darcs get --lazy http://darcs.haskell.org/cabal-install
 59 | cd cabal-install
 60 | </pre>
 61 | 
 62 | Change build-depends in cabal-install.cabal so it has Cabal >= 1.10.1 && < 1.12
 63 | 
 64 | <pre>
 65 | cabal install --ghc-options='-XFlexibleInstances'
 66 | </pre>
 67 | 
 68 | There is a catch.  Because your old cabal install installed the dependancies the .js files for these libraries will not have been installed.  So you shoule unregister then so they will be installed again with the new cabal-install.
 69 | 
 70 | <pre>
 71 | ghc-pkg unregister HTTP
 72 | ghc-pkg unregister network
 73 | ghc-pkg unregister parsec
 74 | ghc-pkg unregister mtl
 75 | ghc-pkg unregister transformers
 76 | ghc-pkg unregister zlib
 77 | </pre>
 78 | 
 79 | Installing GHCJS RTS
 80 | --------------------
 81 | The runtime system js files need by GHCJS are in a package.  To install this do
 82 | 
 83 | <pre>
 84 | git clone https://github.com/hamishmack/ghcjs-rts.git
 85 | cd ghcjs-rts
 86 | cabal install
 87 | </pre>
 88 | 
 89 | Installing Yesod Slides
 90 | -----------------------
 91 | Almost there now
 92 | 
 93 | <pre>
 94 | git clone https://github.com/hamishmack/yesod-slides.git
 95 | cd yesod-slides
 96 | cabal install --constraint='tagged==0.2' --ghc-options='-XFlexibleInstances'
 97 | yesod-slides
 98 | </pre>
 99 | 
100 | You need the -XFlixibleInstances because some of the packages on which we depend do not build with this dev version of ghc without it. 
101 |   
102 | Point your web browser at http://127.0.0.1:3000
103 | 
104 | Click to advance from one slide to the next.  The GHCJS slde is here the last one http://127.0.0.1:3000/ghcjs
105 | 
106 | 


--------------------------------------------------------------------------------
/Setup.lhs:
--------------------------------------------------------------------------------
1 | #!/usr/bin/runhaskell 
2 | > module Main where
3 | > import Distribution.Simple
4 | > main :: IO ()
5 | > main = defaultMain
6 | 
7 | 


--------------------------------------------------------------------------------
/main/yesod-slides.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE CPP #-}
 2 | #if PRODUCTION
 3 | import Slides (withSlides)
 4 | import Network.Wai.Handler.Warp (run)
 5 | import Paths_yesod_slides
 6 | 
 7 | main :: IO ()
 8 | main = do
 9 |     binDir <- getBinDir
10 |     withSlides binDir $ run 3000
11 | #else
12 | import Slides (withSlides)
13 | import System.IO (hPutStrLn, stderr)
14 | import Network.Wai.Middleware.Debug (debug)
15 | import Network.Wai.Handler.Warp (run)
16 | import Paths_yesod_slides
17 | 
18 | main :: IO ()
19 | main = do
20 |     let port = 3000
21 |     hPutStrLn stderr $ "Application launched, listening on port " ++ show port
22 |     binDir <- getBinDir
23 |     withSlides binDir $ run port . debug
24 | #endif
25 | 


--------------------------------------------------------------------------------
/src/Slides.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeFamilies #-}
  2 | {-# LANGUAGE QuasiQuotes #-}
  3 | {-# LANGUAGE MultiParamTypeClasses #-}
  4 | {-# LANGUAGE TemplateHaskell #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# LANGUAGE ScopedTypeVariables #-}
  7 | module Slides (withSlides, helloString, validatePrime) where
  8 | 
  9 | import Yesod.Core
 10 | import Yesod.Helpers.Static
 11 | import Network.Wai (Application)
 12 | import Text.Hamlet (hamlet, Html)
 13 | import Text.Cassius (cassius)
 14 | import Text.Julius (julius)
 15 | import qualified Text.Blaze.Html5 as H (h1, ul, li)
 16 | import Text.Blaze.Renderer.String (renderHtml)
 17 | --import Language.Haskell.TH.Quote (QuasiQuoter(..))
 18 | --import Language.Haskell.TH (pprint, runQ)
 19 | import System.FilePath ((</>))
 20 | import Control.Monad.Trans.Class (lift)
 21 | 
 22 | data Slides = Slides {
 23 |     jsexeStatic :: Static
 24 |     }
 25 | 
 26 | -- This example uses GHC 7 syntax.  GHC 6 users should replace
 27 | -- [parseRoutes| with [$parseRoutes|
 28 | -- [hamlet|      with [$hamlet|
 29 | -- [cassius|     with [$cassius|
 30 | -- [julius|      with [$julius|
 31 | mkYesod "Slides" [parseRoutes|
 32 |     /              RootR          GET
 33 |     /main          Main           GET
 34 |     /how           How            GET
 35 |     /hamlet        Hamlet         GET
 36 |     /hamletvsblaze HamletVsBlaze  GET
 37 |     /cassius       Cassius        GET
 38 |     /julius        Julius         GET
 39 |     /ghcjs         GhcJs          GET
 40 |     /jsexe         Jsexe          Static    jsexeStatic    
 41 |     |]
 42 | 
 43 | instance Yesod Slides where
 44 |     approot _ = ""
 45 | 
 46 |     defaultLayout widget = do
 47 |         mmsg <- getMessage
 48 |         pc <- widgetToPageContent $ do
 49 |             widget
 50 |             addCassius [cassius|
 51 |                 body
 52 |                     font-family: sans-serif
 53 |                     font-size: 30px
 54 |                     height: 100%
 55 |                 h1
 56 |                     font-size: 40px
 57 |                 h2
 58 |                     font-size: 30px
 59 |                 ul
 60 |                     margin-bottom: 5px
 61 |                 li li
 62 |                     font-size: 25px
 63 |                 input
 64 |                     font-size: 30px
 65 |                 |]
 66 |         hamletToRepHtml [hamlet|
 67 |             <html>
 68 |                 <head>
 69 |                     <script type="text/javascript" src="jsexe/rts-common.js">
 70 |                     <script type="text/javascript" src="jsexe/rts-trampoline.js">
 71 |                     <title>#{pageTitle pc}
 72 |                     ^{pageHead pc}
 73 |                 <body #slideBody>
 74 |                     $maybe msg <- mmsg
 75 |                         <div #message>#{msg}
 76 |                     <div style="margin:0 auto; width:600px;">
 77 |                         ^{pageBody pc}
 78 |             |]
 79 | 
 80 | type Handler = GHandler Slides Slides
 81 | 
 82 | getRootR :: Handler RepHtml
 83 | getRootR = do
 84 |     defaultLayout $ do
 85 |         setTitle "Yesod Web Framework"
 86 |         nextPage Main
 87 |         [hamlet|
 88 |             <h1>Quick Tour to Yesod
 89 |             <h2>by Hamish Mackenzie
 90 |             <p>
 91 |                 These are the slides I used in my presentation #
 92 |                 to the Wellington FP Users group.  After each slide #
 93 |                 I showed the code for the slide and discussed how it #
 94 |                 works.
 95 |             <p>
 96 |                 The talk covered the parts of Yesod that were of particular #
 97 |                 interest to me.
 98 |             |]
 99 | 
100 | getMain :: Handler RepHtml
101 | getMain = defaultLayout $ do
102 |     setTitle "Yesod Web Framework"
103 |     nextPage How
104 |     [hamlet|
105 |         <h1>Yesod Web Framwork
106 |         <ul>
107 |             <li>Developers
108 |                 <ul>
109 |                     <li>Michael Snoyman
110 |                     <li>Matt Brown
111 |                     <li>Greg Weber
112 |             <li>Goals
113 |                 <ul>
114 |                     <li>type-safe
115 |                     <li>secure
116 |                     <li>RESTful
117 |                     <li>fast
118 |         |]
119 | 
120 | getHow :: Handler RepHtml
121 | getHow = defaultLayout $ do
122 |     setTitle "Yesod Web Framework - How"
123 |     nextPage Hamlet
124 |     [hamlet|
125 |         <h1>How
126 |         <ul>
127 |             <li>Domain Specific Languages
128 |             <li>Quasy Quoting
129 |             <li>Enumerators
130 |             <li>And much more
131 |     |]
132 | 
133 | getHamlet :: Handler RepHtml
134 | getHamlet = defaultLayout $ do
135 |     setTitle "Yesod Web Framework - Hamlet"
136 |     nextPage HamletVsBlaze
137 |     [hamlet|
138 |         <h1>Hamlet DSL for HTML
139 |         <ul>
140 |             <li>Layout sensitive <b>user</b> friendly syntax
141 |             <li>Compiled or Interpreted
142 |             <li>Uses Blaze Builder
143 |             #{hamletFunction}
144 |             #{blazeFunction}
145 | 
146 |             $forall p1 <- listOfPoints
147 |                 #{H.li p1}
148 | 
149 |             $if True
150 |                 <li>If then else
151 |             $else
152 |                 <li>No if then else
153 | 
154 |             $maybe p2 <- maybePoint
155 |                 #{H.li p2}
156 |             $nothing
157 |                 <li>No point
158 |         |]
159 |   where
160 |     hamletFunction, blazeFunction :: Html
161 |     hamletFunction = [hamlet|<li>Call Hamlet functions|]
162 |     blazeFunction = H.li "Call Blaze functions"
163 |     listOfPoints = ["Map lists"]
164 |     maybePoint = Just "Evaluate Maybe types"
165 | 
166 | -- This is how the quasy quoting works
167 | {-
168 | demoQuasyQuoting :: IO ()
169 | demoQuasyQuoting = do
170 |     test <- runQ (quoteExp hamlet "<h1>#{x}")
171 |     putStrLn (pprint test)
172 | -}
173 | 
174 | -- Output is verbose because of namespaces but it is basically
175 | -- toHamletValue $ do
176 | --    (htmlToHamletMonad . preEscapedString) "<h1>"
177 | --    (htmlToHamletMonad . toHtml) x
178 | --    (htmlToHamletMonad . preEscapedString) "</h1>"
179 | 
180 | getHamletVsBlaze :: Handler RepHtml
181 | getHamletVsBlaze = defaultLayout $ do
182 |     setTitle "Yesod Web Framework - Hamlet vs Blaze"
183 |     nextPage Cassius
184 |     [hamlet|
185 |         #{hamletPros}
186 |         #{blazePros}|]
187 | 
188 | hamletPros :: Html
189 | hamletPros = [hamlet|
190 |     <h1>Hamlet (DSL)
191 |     <ul>
192 |         <li>Optimized syntax
193 |         <li>No namespace issues
194 |         <li>Looks like HTML
195 |     |]
196 | 
197 | blazePros :: Html
198 | blazePros = do
199 |     H.h1 "Blaze (Embedded DSL)"
200 |     H.ul $ do
201 |         H.li "Better GHC error messages"
202 |         H.li "Haskell syntax highlighting"
203 |         H.li "Haskell text completion & metadata"
204 |         H.li "Easier to mix with Haskell (it is Haskell)"
205 | 
206 | getCassius :: Handler RepHtml
207 | getCassius = defaultLayout $ do
208 |     setTitle "Yesod Web Framework - Cassius"
209 |     nextPage Julius
210 |     myId <- lift newIdent
211 |     [hamlet|
212 |         <h1>Cassius DSL for CSS
213 |         <ul>
214 |             <li>Mainly CSS with Embedded Haskell
215 |             <li>Use #
216 |                 <span .someClass>Class
217 |                 \ or #
218 |                 <span #someId>ID
219 |             <li>Use an ID provided by Yesod #
220 |                 <span ##{myId}>(like say "#{myId}")
221 |         |]
222 |     addCassius [cassius|
223 |         .someClass, #someId
224 |             color: #090
225 |         ##{myId}
226 |             font-size: 20px
227 |             color: #009
228 |         |]
229 | 
230 | getJulius :: Handler RepHtml
231 | getJulius = defaultLayout $ do
232 |     setTitle "Yesod Web Framework - Julius"
233 |     nextPage GhcJs
234 |     [hamlet|
235 |         <h1>Julius DSL for JavaScript
236 |         <ul>
237 |             <li>Mainly JavaScript with Embedded Haskell
238 |             <li>This is how nextPage works
239 |         |]
240 | 
241 | nextPage :: Monad m => Route master -> GGWidget master m ()
242 | nextPage next = do
243 |     addJulius [julius|
244 |             document.onclick = function(){
245 |                  window.location.href="@{next}";
246 |             }
247 |         |]
248 | 
249 | hello :: String -> Html
250 | hello who = [hamlet|Hello from <b>#{who}</b>|]
251 | 
252 | helloString :: String -> String
253 | helloString = renderHtml . hello
254 | 
255 | isPrime :: Integral a => a -> Bool
256 | isPrime p = p > 1 && (all (\n -> p `mod` n /= 0) $ takeWhile (\n -> n*n <= p) [2..])
257 | 
258 | validatePrime :: Int -> String
259 | validatePrime p | isPrime p = renderHtml [hamlet|<b>Yes</b>, #{p} is a prime|]
260 |                 | otherwise = renderHtml [hamlet|<b>No</b>, #{p} is not a prime|]
261 | 
262 | getGhcJs :: Handler RepHtml
263 | getGhcJs = defaultLayout $ do
264 |     setTitle "Yesod Web Framework - GHC JavaScript"
265 |     -- Not sure how to disable onclick for all but the input box
266 |     -- nextPage RootR
267 |     helloId <- lift newIdent
268 |     textIn <- lift newIdent
269 |     message <- lift newIdent
270 |     [hamlet|
271 |         <h1>Haskell on client using GHCJS
272 |         Thanks to Victor Nazarov we can...
273 |         <ul>
274 |             <li>Run function on both server and client
275 |                 <ul>
276 |                     <li>#{hello "Server"}
277 |                     <li ##{helloId}>
278 |             <li>
279 |                 Use Haskell for client side validation
280 |                 <input ##{textIn} size="8" oninput="textChanged()" onchange="textChanged()">
281 |                 <span ##{message}>Enter a prime number
282 |         <div #log>
283 |         |]
284 |     addJulius [julius|
285 |             window.onload = function(){
286 |                 $hs.loadPaths = ["jsexe"];
287 | 
288 |                 // Used packages
289 |                 $hs.packages = [""];
290 | 
291 |                 // Must be called first
292 |                 $hs.init();
293 |                 
294 |                 $hs.loadModule("GHC.Base");
295 |                 $hs.loadModule("Slides");
296 |                 
297 |                 #{helloId}.innerHTML = $hs.fromHaskellString(
298 |                     $hs.force( $hs.modules.Slides.hs_helloString,
299 |                         $hs.force( $hs.modules.GHCziBase.hs_unpackCStringzh, "Client\x00")));
300 |             }
301 |             function textChanged() {
302 |                 #{message}.innerHTML = $hs.fromHaskellString(
303 |                     $hs.force( $hs.modules.Slides.hs_validatePrime,
304 |                       $hs.toHaskellInt(#{textIn}.value)));
305 |             }
306 |         |]
307 | 
308 | withSlides :: FilePath -> (Application -> IO a) -> IO a
309 | withSlides binDir f =
310 |     toWaiApp Slides {
311 |           jsexeStatic = static $ binDir </> "yesod-slides.jsexe"
312 |         } >>= f
313 | 


--------------------------------------------------------------------------------
/yesod-slides.cabal:
--------------------------------------------------------------------------------
 1 | name:              yesod-slides
 2 | version:           0.1.0
 3 | license:           BSD3
 4 | license-file:      LICENSE
 5 | author:            Hamish Mackenzie
 6 | maintainer:        Hamish Mackenzie
 7 | synopsis:          The greatest Yesod web application ever.
 8 | description:       I'm sure you can say something clever here if you try.
 9 | category:          Web
10 | stability:         Experimental
11 | cabal-version:     >= 1.8
12 | build-type:        Simple
13 | homepage:          http://yesod-slides.yesodweb.com/
14 | 
15 | Flag production
16 |     Description:   Build the production executable.
17 |     Default:       False
18 | 
19 | Flag devel
20 |     Description:   Build for use with "yesod devel"
21 |     Default:       False
22 | 
23 | library
24 |     build-depends: base         >= 4       && < 5
25 |                  , yesod-core   >= 0.8     && < 0.9
26 |                  , yesod-static
27 |                  , wai-extra
28 |                  , directory
29 |                  , bytestring
30 |                  , text
31 |                  , template-haskell
32 |                  , hamlet
33 |                  , blaze-html
34 |                  , web-routes
35 |                  , transformers
36 |                  , wai
37 |                  , blaze-builder
38 |                  , filepath
39 |     exposed-modules: Slides
40 |     hs-source-dirs: src
41 | 
42 | executable         yesod-slides
43 |     build-depends: base         >= 4       && < 5
44 |                  , yesod-slides == 0.1.0
45 |                  , warp
46 |                  , wai-extra
47 |                  , ghcjs-rts
48 |     if flag(production)
49 |         cpp-options:   -DPRODUCTION
50 |         ghc-options:   -Wall -threaded -O2
51 |     else
52 |         ghc-options:   -Wall -threaded
53 | 
54 |     main-is:       yesod-slides.hs
55 |     hs-source-dirs: main
56 | 
57 |     ghc-options:   -Wall -threaded
58 | 


--------------------------------------------------------------------------------