2012-05-28 14:08:40 +00:00
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings, TypeFamilies, MultiParamTypeClasses #-}
|
|
|
|
|
|
2012-05-28 15:09:27 +00:00
|
|
|
import Language.Elm
|
2012-05-30 17:59:54 +00:00
|
|
|
import Language.Elm.Quasi
|
2012-05-28 14:08:40 +00:00
|
|
|
import Language.Elm.Yesod
|
|
|
|
|
import Yesod
|
|
|
|
|
import Text.Hamlet
|
|
|
|
|
|
|
|
|
|
data ElmTest = ElmTest
|
|
|
|
|
|
2012-05-30 19:49:46 +00:00
|
|
|
-- loading external elm code
|
2012-05-30 17:59:54 +00:00
|
|
|
mousePage = $(elmFile "elm_source/mouse.elm")
|
2012-05-28 22:39:25 +00:00
|
|
|
|
2012-05-30 17:59:54 +00:00
|
|
|
clockPage = $(elmFile "elm_source/clock.elm")
|
2012-05-28 22:39:25 +00:00
|
|
|
|
|
|
|
|
-- embedding elm code inside Haskell using the QuasiQuoter:
|
|
|
|
|
shapesPage = [elm|
|
|
|
|
|
square = rect 200 200 (150,150)
|
|
|
|
|
circle = oval 140 140 (150,150)
|
|
|
|
|
pentagon = ngon 5 60 (150,150)
|
|
|
|
|
|
|
|
|
|
main = collage 300 300
|
|
|
|
|
[ outlined black square
|
|
|
|
|
, filled green pentagon
|
|
|
|
|
, customOutline [8,4] blue circle
|
|
|
|
|
]
|
2012-05-28 14:08:40 +00:00
|
|
|
|]
|
|
|
|
|
|
|
|
|
|
-- our Yesod App
|
|
|
|
|
mkYesod "ElmTest" [parseRoutes|
|
|
|
|
|
/ RootR GET
|
|
|
|
|
/mouse MouseR GET
|
2012-05-28 22:39:25 +00:00
|
|
|
/clock ClockR GET
|
|
|
|
|
/shapes ShapesR GET
|
2012-05-28 14:08:40 +00:00
|
|
|
|]
|
|
|
|
|
|
2012-05-30 19:49:46 +00:00
|
|
|
-- elmWidget takes some elm source code and returns the finished elm widget
|
|
|
|
|
-- inside the GHandler monad. URL interpolation is done automatically, all
|
|
|
|
|
-- interpolated variables have to be in scope when the elmWidget call happens.
|
2012-05-28 14:08:40 +00:00
|
|
|
getMouseR :: Handler RepHtml
|
2012-05-30 19:33:19 +00:00
|
|
|
getMouseR = do
|
|
|
|
|
widget <- elmWidget mousePage
|
|
|
|
|
defaultLayout $ do
|
|
|
|
|
setTitle "Mouse position demo"
|
|
|
|
|
widget
|
2012-05-28 14:08:40 +00:00
|
|
|
|
2012-05-28 22:39:25 +00:00
|
|
|
getClockR :: Handler RepHtml
|
2012-05-30 19:33:19 +00:00
|
|
|
getClockR = do
|
|
|
|
|
widget <- elmWidget clockPage
|
|
|
|
|
defaultLayout $ do
|
|
|
|
|
setTitle "A clock"
|
|
|
|
|
widget
|
2012-05-28 22:39:25 +00:00
|
|
|
|
|
|
|
|
getShapesR :: Handler RepHtml
|
2012-05-30 19:33:19 +00:00
|
|
|
getShapesR = do
|
|
|
|
|
widget <- elmWidget shapesPage
|
|
|
|
|
defaultLayout $ do
|
|
|
|
|
setTitle "Simple shapes"
|
|
|
|
|
widget
|
2012-05-28 22:39:25 +00:00
|
|
|
|
2012-05-28 14:08:40 +00:00
|
|
|
getRootR :: Handler RepHtml
|
2012-05-29 00:58:37 +00:00
|
|
|
getRootR = do
|
2012-05-30 19:33:19 +00:00
|
|
|
widget <- elmWidget $(elmFile "elm_source/index.elm")
|
2012-05-29 00:58:37 +00:00
|
|
|
defaultLayout $ do
|
|
|
|
|
setTitle "Welcome!"
|
2012-05-30 19:33:19 +00:00
|
|
|
widget
|
2012-05-28 14:08:40 +00:00
|
|
|
|
2012-05-28 22:39:25 +00:00
|
|
|
|
|
|
|
|
-- Our Yesod instance contains the default layout, which inserts the elm-min.js
|
|
|
|
|
-- file in the site's <head> tag.
|
2012-05-28 14:08:40 +00:00
|
|
|
instance Yesod ElmTest where
|
|
|
|
|
jsLoader _ = BottomOfHeadBlocking
|
|
|
|
|
defaultLayout widget = do
|
|
|
|
|
mmsg <- getMessage
|
|
|
|
|
pc <- widgetToPageContent $ do
|
|
|
|
|
addScriptRemote $ "http://f.cl.ly/items/2e3Z3r3v29263U393c3x/elm-min.js"
|
|
|
|
|
$(whamletFile "templates/default-layout.hamlet")
|
|
|
|
|
hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
|
|
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
|
main = warpDebug 3000 ElmTest
|
