public
Last active

Demonstrate conversion from standard Yesod to yesod-pure

  • Download Gist
fib.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative ((<$>))
import Text.Blaze.Html (toValue, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
import Yesod.Pure
 
data App = App
 
instance RenderRoute App where
data Route App = HomeR
| FibR Int
deriving Eq
renderRoute HomeR = ([], [])
renderRoute (FibR i) = (["fib", toPathPiece i], [])
 
parseRoute :: RouteParse App
parseRoute [] = Just HomeR
parseRoute ["fib", i] = FibR <$> fromPathPiece i
parseRoute _ = Nothing
 
dispatchRoute :: RouteDispatch App
dispatchRoute "GET" HomeR = handler getHomeR
dispatchRoute "GET" (FibR i) = handler $ getFibR i
dispatchRoute _ _ = Nothing
 
instance YesodDispatch App App where
yesodDispatch = dispatch parseRoute dispatchRoute
 
instance Yesod App
type Handler = GHandler App App
 
getHomeR :: Handler RepHtml
getHomeR = defaultLayout $ do
setTitle "Hello World!"
toWidget $ \render -> do
H.p "Hello World"
H.a ! HA.href (toValue $ render (FibR 5) []) $ "Fifth fib"
addCSS "p { color: red }"
 
getFibR :: Int -> Handler RepHtml
getFibR i = defaultLayout $ do
setTitle "Fibs"
toWidget $ \render -> do
H.p $ do
"Fib for "
toHtml i
": "
toHtml $ fibs !! i
H.a ! HA.href (toValue $ render (FibR $ i + 1) []) $ "Next fib"
 
fib :: Int -> Int
fib i = fibs !! i
 
fibs :: [Int]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 
main :: IO ()
main = warpDebug 3000 App

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.