2012-05-30 18:05:08 +00:00
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
import Control.Monad (msum)
|
|
|
|
import Happstack.Server
|
2012-05-30 18:05:08 +00:00
|
|
|
import Language.Elm
|
|
|
|
import Language.Elm.Quasi
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
elmLoc :: String
|
|
|
|
elmLoc = "http://f.cl.ly/items/2e3Z3r3v29263U393c3x/elm-min.js"
|
|
|
|
|
2012-05-30 18:05:08 +00:00
|
|
|
elmResponse :: ElmSource a
|
|
|
|
=> String -- ^ Page title
|
|
|
|
-> a -- ^ elm source
|
2012-05-29 21:47:31 +00:00
|
|
|
-> Response
|
2012-05-30 18:05:08 +00:00
|
|
|
elmResponse title = toResponse . toHtml elmLoc title
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
-- embedding variables (in this case URLs)
|
|
|
|
rootHandler :: ServerPart Response
|
|
|
|
rootHandler = ok $ elmResponse "Welcome!" $ elmIndex
|
|
|
|
where
|
|
|
|
mouse = "/mouse"
|
|
|
|
clock = "/clock"
|
|
|
|
shapes = "/shapes"
|
2012-05-30 18:05:08 +00:00
|
|
|
elmIndex = $(elmFile "elm_source/index.elm")
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
-- loading elm source from file
|
|
|
|
|
|
|
|
mouseHandler :: ServerPart Response
|
2012-05-30 18:05:08 +00:00
|
|
|
mouseHandler = ok $ elmResponse "Mouse position demo"
|
|
|
|
$(elmFile "elm_source/mouse.elm")
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
clockHandler :: ServerPart Response
|
2012-05-30 18:05:08 +00:00
|
|
|
clockHandler = ok $ elmResponse "A clock" $(elmFile "elm_source/clock.elm")
|
2012-05-29 21:47:31 +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
|
|
|
|
]
|
|
|
|
|]
|
|
|
|
|
|
|
|
shapesHandler :: ServerPart Response
|
|
|
|
shapesHandler = ok $ elmResponse "Simple shapes" $ shapesPage
|
|
|
|
|
|
|
|
-- routing
|
|
|
|
elmExample :: ServerPart Response
|
|
|
|
elmExample =
|
|
|
|
msum [ nullDir >> rootHandler
|
|
|
|
, dir "mouse" $ nullDir >>
|
|
|
|
mouseHandler
|
|
|
|
, dir "clock" $ nullDir >>
|
|
|
|
clockHandler
|
|
|
|
, dir "shapes" $ nullDir >>
|
|
|
|
shapesHandler
|
|
|
|
]
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = simpleHTTP nullConf {port = 3000} elmExample
|