├── .gitignore
├── demo
├── Setup.hs
├── test
│ └── Spec.hs
├── app
│ └── Main.hs
├── src
│ ├── Route.hs
│ ├── App.hs
│ └── Handler.hs
├── LICENSE
├── demo.cabal
└── stack.yaml
├── docs
├── resources
│ ├── conan.gif
│ ├── web-framework.png
│ └── web-framework.graffle
├── index.html
└── SLIDES.md
└── README.md
/.gitignore:
--------------------------------------------------------------------------------
1 | .stack-work/
2 |
--------------------------------------------------------------------------------
/demo/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 |
--------------------------------------------------------------------------------
/demo/test/Spec.hs:
--------------------------------------------------------------------------------
1 | main :: IO ()
2 | main = putStrLn "Test suite not yet implemented"
3 |
--------------------------------------------------------------------------------
/docs/resources/conan.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cbaatz/build-a-haskell-web-framework/HEAD/docs/resources/conan.gif
--------------------------------------------------------------------------------
/docs/resources/web-framework.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cbaatz/build-a-haskell-web-framework/HEAD/docs/resources/web-framework.png
--------------------------------------------------------------------------------
/docs/resources/web-framework.graffle:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cbaatz/build-a-haskell-web-framework/HEAD/docs/resources/web-framework.graffle
--------------------------------------------------------------------------------
/demo/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import App (app)
4 |
5 | import Network.Wai.Handler.Warp (run)
6 |
7 | main :: IO ()
8 | main = run 3000 app
9 |
--------------------------------------------------------------------------------
/demo/src/Route.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Route
5 | ( Route(..)
6 | , parseRoute
7 | ) where
8 |
9 | import BasicPrelude
10 |
11 | import Data.Attoparsec.ByteString.Char8
12 |
13 | data Route = Home | Message Int
14 |
15 | parseRoute :: ByteString -> Either String Route
16 | parseRoute = parseOnly parser
17 |
18 | parser :: Parser Route
19 | parser = choice
20 | [ string "/" <* endOfInput >> return Home
21 | , string "/messages/" >> fmap Message (decimal <* endOfInput)
22 | ]
23 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | Talk: Build yourself a Haskell web framework
2 | ============================================
3 |
4 | Zurich HaskellerZ meetup -- 27 October 2016
5 |
6 | Slides were created using [remark](https://github.com/gnab/remark) and can be viewed online at https://cbaatz.github.io/build-a-haskell-web-framework/.
7 |
8 | To run the code from the live-coding session:
9 |
10 | 1. Install [Stack](www.haskellstack.org/).
11 | 2. Got to the `demo/` folder in this repo.
12 | 3. `stack ghci` then type `:main` at the prompt. This starts the web-server. Press Ctrl-C to stop it.
13 |
14 | Please note that the code form the live-coding session is not polished, merely a proof-of-concept.
15 |
--------------------------------------------------------------------------------
/demo/src/App.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module App
5 | ( app
6 | ) where
7 |
8 | import BasicPrelude
9 |
10 | import Control.Monad.Reader (asks)
11 | import qualified Data.ByteString.Lazy as L
12 | import qualified Data.ByteString.Lazy.Char8 as L8
13 | import Network.HTTP.Types
14 | import Network.Wai
15 |
16 | import Handler
17 | import Route
18 |
19 | app :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
20 | app req respond = do
21 | let methodEither = parseMethod (requestMethod req)
22 | routeEither = parseRoute (rawPathInfo req)
23 | env = Env req
24 | case (methodEither, routeEither) of
25 | (Right method, Right route) -> do
26 | runHandler (router method route) env >>= respond
27 | _ -> runHandler notFound env >>= respond
28 |
29 | router :: StdMethod -> Route -> Handler L.ByteString
30 | router GET Home = do
31 | req <- asks envRequest
32 | setStatus status200
33 | return (L8.pack (show $ remoteHost req))
34 | router GET (Message i) = do
35 | when (i == 3) (redirect "/")
36 | return (L8.pack ("Message #" <> (show i)))
37 | router _ _ = notFound
38 |
39 | notFound :: Handler L.ByteString
40 | notFound = do
41 | addHeader ("Content-type", "text/html")
42 | setStatus status404
43 | return $ "404 NOT FOUND
"
44 |
--------------------------------------------------------------------------------
/docs/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Build yourself a Haskell web framework
5 |
6 |
21 |
22 |
23 |
25 |
39 |
40 |
41 |
42 |