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
|
|
|
|
2013-02-08 18:19:14 +00:00
|
|
|
elmRuntime="elm-runtime.js"
|
|
|
|
elmRTPath='/':elmRuntime
|
2012-05-29 21:47:31 +00:00
|
|
|
|
2012-05-30 19:49:46 +00:00
|
|
|
-- elmResponse is a "nice to have" helper function for compiling
|
|
|
|
-- Elm code when using Elm with Happstack. At some point this might
|
|
|
|
-- be moved to an elm-happstack package.
|
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
|
2013-02-08 18:19:14 +00:00
|
|
|
elmResponse title = toResponse . toHtml elmRTPath title
|
2012-05-29 21:47:31 +00:00
|
|
|
|
|
|
|
-- embedding variables (in this case URLs)
|
|
|
|
rootHandler :: ServerPart Response
|
|
|
|
rootHandler = ok $ elmResponse "Welcome!" $ elmIndex
|
|
|
|
where
|
2013-02-07 15:25:47 +00:00
|
|
|
mouse = "/mouse" -- all three of these variables are used in elm_source/index.elm
|
2012-05-29 21:47:31 +00:00
|
|
|
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
|
2013-02-08 18:19:14 +00:00
|
|
|
elmExample :: String -> ServerPart Response
|
|
|
|
elmExample elmLoc = do
|
|
|
|
msum [ nullDir >> rootHandler
|
|
|
|
, dir elmRuntime $ nullDir >>
|
|
|
|
serveFile (guessContentTypeM mimeTypes) elmLoc
|
2012-05-29 21:47:31 +00:00
|
|
|
, dir "mouse" $ nullDir >>
|
2013-02-08 18:19:14 +00:00
|
|
|
mouseHandler
|
2012-05-29 21:47:31 +00:00
|
|
|
, dir "clock" $ nullDir >>
|
|
|
|
clockHandler
|
|
|
|
, dir "shapes" $ nullDir >>
|
|
|
|
shapesHandler
|
|
|
|
]
|
|
|
|
|
|
|
|
main :: IO ()
|
2013-02-08 18:19:14 +00:00
|
|
|
main = do
|
|
|
|
elmLoc <- Language.Elm.runtimeLocation
|
|
|
|
simpleHTTP nullConf {port = 3000} $ elmExample elmLoc
|