├── .github ├── ISSUE_TEMPLATE.md ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── tests.yml ├── .gitignore ├── CODE_OF_CONDUCT.md ├── CONTRIBUTING.md ├── Dockerfile ├── LICENSE ├── README.md ├── cabal.project ├── demo ├── appcache │ ├── AppCache.hs │ ├── Main.hs │ └── Routes.hs ├── auth │ ├── config │ │ └── secrets.yaml │ └── email_auth_ses_mailer.hs ├── lite │ └── lite.hs ├── streaming-db │ └── streaming-db.hs ├── streaming │ └── streaming.hs └── subsite │ ├── Main.hs │ ├── Wiki.hs │ └── WikiRoutes.hs ├── stack-lts-22.yaml ├── stack.yaml ├── stack.yaml.lock ├── yesod-auth-oauth ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ └── Auth │ │ └── OAuth.hs └── yesod-auth-oauth.cabal ├── yesod-auth ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── Auth.hs │ └── Auth │ │ ├── BrowserId.hs │ │ ├── Dummy.hs │ │ ├── Email.hs │ │ ├── GoogleEmail2.hs │ │ ├── Hardcoded.hs │ │ ├── Message.hs │ │ ├── OpenId.hs │ │ ├── Routes.hs │ │ ├── Rpxnow.hs │ │ └── Util │ │ └── PasswordStore.hs ├── auth2.hs ├── browserid.hs ├── openid.hs ├── persona_sign_in_blue.png └── yesod-auth.cabal ├── yesod-bin ├── AddHandler.hs ├── ChangeLog.md ├── Devel.hs ├── HsFile.hs ├── Keter.hs ├── LICENSE ├── Options.hs ├── README.md ├── Setup.lhs ├── certificate.pem ├── devel-example │ ├── .gitignore │ ├── README.md │ ├── Setup.hs │ ├── app │ │ ├── Main.hs │ │ └── devel.hs │ ├── devel-example.cabal │ ├── src │ │ └── DevelExample.hs │ └── stack.yaml ├── key.pem ├── main.hs ├── refreshing.html ├── update-hsfiles.sh └── yesod-bin.cabal ├── yesod-core ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── attic │ └── pong.hs ├── bench.sh ├── bench │ ├── THHelper.hs │ ├── non-th.hs │ ├── pong.hs │ ├── th.hs │ └── widget.hs ├── helloworld.hs ├── src │ └── Yesod │ │ ├── Core.hs │ │ ├── Core │ │ ├── Class │ │ │ ├── Breadcrumbs.hs │ │ │ ├── Dispatch.hs │ │ │ ├── Handler.hs │ │ │ └── Yesod.hs │ │ ├── Content.hs │ │ ├── Dispatch.hs │ │ ├── Handler.hs │ │ ├── Internal.hs │ │ ├── Internal │ │ │ ├── LiteApp.hs │ │ │ ├── Request.hs │ │ │ ├── Response.hs │ │ │ ├── Run.hs │ │ │ ├── Session.hs │ │ │ ├── TH.hs │ │ │ └── Util.hs │ │ ├── Json.hs │ │ ├── TypeCache.hs │ │ ├── Types.hs │ │ ├── Unsafe.hs │ │ └── Widget.hs │ │ └── Routes │ │ ├── Class.hs │ │ ├── Overlap.hs │ │ ├── Parse.hs │ │ ├── TH.hs │ │ └── TH │ │ ├── Dispatch.hs │ │ ├── ParseRoute.hs │ │ ├── RenderRoute.hs │ │ ├── RouteAttrs.hs │ │ └── Types.hs ├── static │ ├── script.js │ ├── style.css │ └── style2.css ├── test │ ├── Hierarchy.hs │ ├── RouteSpec.hs │ ├── YesodCoreTest.hs │ ├── YesodCoreTest │ │ ├── Auth.hs │ │ ├── Breadcrumb.hs │ │ ├── Cache.hs │ │ ├── CleanPath.hs │ │ ├── Csrf.hs │ │ ├── ErrorHandling.hs │ │ ├── ErrorHandling │ │ │ └── CustomApp.hs │ │ ├── Exceptions.hs │ │ ├── Header.hs │ │ ├── InternalRequest.hs │ │ ├── JsAttributes.hs │ │ ├── JsLoader.hs │ │ ├── JsLoaderSites │ │ │ └── Bottom.hs │ │ ├── Json.hs │ │ ├── Links.hs │ │ ├── LiteApp.hs │ │ ├── Media.hs │ │ ├── MediaData.hs │ │ ├── Meta.hs │ │ ├── NoOverloadedStrings.hs │ │ ├── NoOverloadedStringsSub.hs │ │ ├── ParameterizedSite.hs │ │ ├── ParameterizedSite │ │ │ ├── Compat.hs │ │ │ ├── PolyAny.hs │ │ │ └── PolyShow.hs │ │ ├── RawResponse.hs │ │ ├── Redirect.hs │ │ ├── Reps.hs │ │ ├── RequestBodySize.hs │ │ ├── Ssl.hs │ │ ├── Streaming.hs │ │ ├── StubLaxSameSite.hs │ │ ├── StubSslOnly.hs │ │ ├── StubStrictSameSite.hs │ │ ├── StubUnsecured.hs │ │ ├── SubSub.hs │ │ ├── SubSubData.hs │ │ ├── WaiSubsite.hs │ │ ├── Widget.hs │ │ └── YesodTest.hs │ ├── en.msg │ ├── fixtures │ │ └── routes_with_line_continuations.yesodroutes │ └── test.hs └── yesod-core.cabal ├── yesod-eventsource ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ └── EventSource.hs └── yesod-eventsource.cabal ├── yesod-form-multi ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ └── Form │ │ └── MultiInput.hs └── yesod-form-multi.cabal ├── yesod-form ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── Form.hs │ ├── Form │ │ ├── Bootstrap3.hs │ │ ├── Fields.hs │ │ ├── Functions.hs │ │ ├── I18n │ │ │ ├── Chinese.hs │ │ │ ├── Croatian.hs │ │ │ ├── Czech.hs │ │ │ ├── Dutch.hs │ │ │ ├── English.hs │ │ │ ├── French.hs │ │ │ ├── German.hs │ │ │ ├── Japanese.hs │ │ │ ├── Korean.hs │ │ │ ├── Norwegian.hs │ │ │ ├── Portuguese.hs │ │ │ ├── Romanian.hs │ │ │ ├── Russian.hs │ │ │ ├── Spanish.hs │ │ │ └── Swedish.hs │ │ ├── Input.hs │ │ ├── Jquery.hs │ │ ├── MassInput.hs │ │ ├── Nic.hs │ │ ├── Option.hs │ │ └── Types.hs │ └── Helpers │ │ └── Crud.hs ├── hello-forms.hs ├── test │ └── main.hs └── yesod-form.cabal ├── yesod-newsfeed ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── AtomFeed.hs │ ├── Feed.hs │ ├── FeedTypes.hs │ └── RssFeed.hs └── yesod-newsfeed.cabal ├── yesod-persistent ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── Persist.hs │ └── Persist │ │ └── Core.hs ├── test │ ├── Spec.hs │ └── Yesod │ │ └── PersistSpec.hs └── yesod-persistent.cabal ├── yesod-sitemap ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ └── Sitemap.hs └── yesod-sitemap.cabal ├── yesod-static ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── EmbeddedStatic.hs │ ├── EmbeddedStatic │ │ ├── Css │ │ │ ├── AbsoluteUrl.hs │ │ │ └── Util.hs │ │ ├── Generators.hs │ │ ├── Internal.hs │ │ └── Types.hs │ └── Static.hs ├── sample-embed.hs ├── sample.hs ├── test │ ├── EmbedDevelTest.hs │ ├── EmbedProductionTest.hs │ ├── EmbedTestGenerator.hs │ ├── FileGeneratorTests.hs │ ├── GeneratorTestUtil.hs │ ├── YesodStaticTest.hs │ ├── embed-dir │ │ ├── abc │ │ │ └── def.txt │ │ ├── foo │ │ └── lorem.txt │ ├── fs │ │ ├── .ignored │ │ ├── bar │ │ │ └── baz │ │ ├── foo │ │ └── tmp │ │ │ └── ignored │ ├── tests.hs │ └── unicode │ │ ├── LICENSE │ │ ├── README │ │ ├── Setup.lhs │ │ ├── TODO │ │ ├── app.hs │ │ ├── embedded-sample.hs │ │ ├── folder.png │ │ ├── folder.svg │ │ ├── haskell.png │ │ ├── sample.hs │ │ ├── test.hs │ │ ├── tests │ │ ├── a │ │ │ └── b │ │ └── runtests.hs │ │ ├── unicode.hs │ │ ├── wai-app-static.cabal │ │ ├── warp.hs │ │ ├── קרררר.html │ │ ├── שלום │ │ └── ששש │ │ └── DUMMY.txt └── yesod-static.cabal ├── yesod-test ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod │ ├── Test.hs │ └── Test │ │ ├── CssQuery.hs │ │ ├── Internal.hs │ │ ├── Internal │ │ └── SIO.hs │ │ └── TransversingCSS.hs ├── test │ └── main.hs └── yesod-test.cabal ├── yesod-websockets ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── Yesod │ └── WebSockets.hs ├── chat-with-multiple-channels.hs ├── chat-with-timeout-control.hs ├── chat.hs ├── sample.hs └── yesod-websockets.cabal └── yesod ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.lhs ├── Yesod.hs ├── Yesod └── Default │ ├── Config.hs │ ├── Config2.hs │ ├── Handlers.hs │ ├── Main.hs │ └── Util.hs └── yesod.cabal /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | 30 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Before submitting your PR, check that you've: 2 | 3 | - [ ] Bumped the version number 4 | - [ ] Documented new APIs with [Haddock markup](https://www.haskell.org/haddock/doc/html/index.html) 5 | - [ ] Added [`@since` declarations](http://haskell-haddock.readthedocs.io/en/latest/markup.html#since) to the Haddocks for new, public APIs 6 | 7 | After submitting your PR: 8 | 9 | - [ ] Update the Changelog.md file with a link to your PR 10 | - [ ] Check that CI passes (or if it fails, for reasons unrelated to your change, like CI timeouts) 11 | 12 | 15 | -------------------------------------------------------------------------------- /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - master 8 | 9 | jobs: 10 | build: 11 | name: CI 12 | runs-on: ${{ matrix.os }} 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | os: [ubuntu-latest, macos-latest, windows-latest] 17 | args: 18 | - "--resolver lts-23" 19 | - "--resolver lts-22 --stack-yaml stack-lts-22.yaml" 20 | - "--resolver lts-20 --stack-yaml stack-lts-22.yaml" 21 | - "--resolver lts-18 --stack-yaml stack-lts-22.yaml" 22 | - "--resolver lts-16 --stack-yaml stack-lts-22.yaml" 23 | exclude: 24 | # llvm too new on macos-latest for ghc 8 25 | - os: macos-latest 26 | args: "--resolver lts-18 --stack-yaml stack-lts-22.yaml" 27 | - os: macos-latest 28 | args: "--resolver lts-16 --stack-yaml stack-lts-22.yaml" 29 | 30 | steps: 31 | - name: Clone project 32 | uses: actions/checkout@v4 33 | 34 | # Getting weird OS X errors... 35 | # - name: Cache dependencies 36 | # uses: actions/cache@v1 37 | # with: 38 | # path: ~/.stack 39 | # key: ${{ runner.os }}-${{ matrix.resolver }}-${{ hashFiles('stack.yaml') }} 40 | # restore-keys: | 41 | # ${{ runner.os }}-${{ matrix.resolver }}- 42 | 43 | - name: Install stack if needed 44 | shell: bash 45 | run: | 46 | set -ex 47 | if [[ "${{ matrix.os }}" == "macos-latest" ]] 48 | then 49 | # macos-latest does not include Haskell tools as of 2024-05-06. 50 | curl -sSL https://get.haskellstack.org/ | sh 51 | fi 52 | 53 | - name: Build and run tests 54 | shell: bash 55 | run: | 56 | set -ex 57 | stack --version 58 | stack test --fast --no-terminal ${{ matrix.args }} 59 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.o 3 | *.o_p 4 | *.hi 5 | dist/ 6 | dist-stack/ 7 | stack.yaml.lock 8 | .stack-work 9 | *.swp 10 | client_session_key.aes 11 | cabal-dev/ 12 | yesod/foobar/ 13 | .hsenv/ 14 | .cabal-sandbox/ 15 | cabal.sandbox.config 16 | /vendor/ 17 | .shelly/ 18 | tarballs/ 19 | 20 | # useful when mounting into docker 21 | .cabal 22 | .ghc 23 | .stackage 24 | .bash_history 25 | 26 | # OS X 27 | .DS_Store 28 | *.yaml.lock 29 | dist-newstyle/ 30 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM haskell:7.10 2 | MAINTAINER Greg Weber 3 | 4 | # Intended as a development environment 5 | # 6 | # docker build -t yesod . 7 | # docker run --rm -i -t -v `pwd`:/home/haskell yesod /bin/bash 8 | # stackage update 9 | # 10 | 11 | RUN apt-get update && apt-get install sudo \ 12 | # ssl stuff that you may find useful 13 | && apt-get install -y libssl-dev ca-certificates libcurl4-openssl-dev \ 14 | # stackage-cli uses git. authbind can be useful for exposing ports 15 | && apt-get install -y git authbind \ 16 | && apt-get clean 17 | 18 | # run as a user named "haskell" 19 | RUN useradd -m -d /home/haskell -s /bin/bash haskell 20 | RUN mkdir -p /etc/sudoers.d && echo "haskell ALL=(ALL) NOPASSWD: ALL" > /etc/sudoers.d/haskell && chmod 0440 /etc/sudoers.d/haskell 21 | ENV HOME /home/haskell 22 | WORKDIR /home/haskell 23 | USER haskell 24 | ENV LANG C.UTF-8 25 | ENV LC_ALL C.UTF-8 26 | 27 | # install stackage binaries to /opt/stackage 28 | RUN sudo mkdir -p /opt/stackage/bin 29 | ENV PATH /opt/stackage/bin:.cabal-sandbox/bin:.cabal/bin:$PATH:./ 30 | RUN sudo chown haskell:haskell /opt/stackage/bin 31 | RUN cabal update \ 32 | && cabal install stackage-update && stackage-update \ 33 | && cabal install stackage-install \ 34 | && stackage-install stackage-cli stackage-cabal stackage-sandbox stackage-upload \ 35 | && mv /home/haskell/.cabal/bin/* /opt/stackage/bin/ \ 36 | && rm -r /home/haskell/.cabal 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012-2017 Michael Snoyman, http://www.yesodweb.com/ 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Tests](https://github.com/yesodweb/yesod/workflows/Tests/badge.svg) 2 | 3 | # Yesod Web Framework 4 | 5 | An advanced web framework using the Haskell programming language. Featuring: 6 | 7 | * safety & security guaranteed at compile time 8 | * developer productivity: tools for all your basic web development needs 9 | * raw performance 10 | * fast, compiled code 11 | * techniques for constant-space memory consumption 12 | * asynchronous IO 13 | * this is built in to the Haskell programming language (like Erlang) 14 | 15 | ## Getting Started 16 | 17 | Learn more about Yesod on [its main website](http://www.yesodweb.com/). If you 18 | want to get started using Yesod, we strongly recommend the [quick start 19 | guide](http://www.yesodweb.com/page/quickstart), based on [the Haskell build 20 | tool stack](https://github.com/commercialhaskell/stack#readme). 21 | 22 | Here's a minimal example! 23 | 24 | ```haskell 25 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeFamilies #-} 26 | 27 | import Yesod 28 | 29 | data App = App -- Put your config, database connection pool, etc. in here. 30 | 31 | -- Derive routes and instances for App. 32 | mkYesod "App" [parseRoutes| 33 | / HomeR GET 34 | |] 35 | 36 | instance Yesod App -- Methods in here can be overridden as needed. 37 | 38 | -- The handler for the GET request at /, corresponds to HomeR. 39 | getHomeR :: Handler Html 40 | getHomeR = defaultLayout [whamlet|Hello World!|] 41 | 42 | main :: IO () 43 | main = warp 3000 App 44 | ``` 45 | 46 | To read about each of the concepts in use above (routing, handlers, 47 | linking, JSON), in detail, visit 48 | [Basics in the Yesod book](https://www.yesodweb.com/book/basics#basics_routing). 49 | 50 | ## Hacking on Yesod 51 | 52 | Yesod consists mostly of four repositories: 53 | 54 | ```bash 55 | git clone --recurse-submodules http://github.com/yesodweb/shakespeare 56 | git clone --recurse-submodules http://github.com/yesodweb/persistent 57 | git clone --recurse-submodules http://github.com/yesodweb/wai 58 | git clone --recurse-submodules http://github.com/yesodweb/yesod 59 | ``` 60 | 61 | Each repository can be built with `stack build`. 62 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | yesod-core 3 | yesod-static 4 | yesod-persistent 5 | yesod-newsfeed 6 | yesod-form 7 | yesod-form-multi 8 | yesod-auth 9 | yesod-auth-oauth 10 | yesod-sitemap 11 | yesod-test 12 | yesod-bin 13 | yesod 14 | yesod-eventsource 15 | yesod-websockets 16 | -------------------------------------------------------------------------------- /demo/appcache/AppCache.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module AppCache where 4 | 5 | import Control.Monad (when) 6 | import Control.Monad.Trans.Writer 7 | import Data.Hashable (hashWithSalt) 8 | import Data.List (intercalate) 9 | import qualified Data.Set as Set 10 | import Data.Text (Text) 11 | import Data.Text (pack) 12 | import Language.Haskell.TH.Syntax 13 | import Yesod.Core 14 | import Yesod.Routes.TH 15 | 16 | newtype AppCache = AppCache { unAppCache :: Text } 17 | 18 | appCache :: [ResourceTree String] -> Q Exp 19 | appCache trees = do 20 | piecesSet <- execWriterT $ mapM_ (goTree id) trees 21 | let body = unlines $ map toPath $ Set.toList piecesSet 22 | hash = hashWithSalt 0 body 23 | total = concat 24 | [ "CACHE MANIFEST\n# Version: " 25 | , show hash 26 | , "\n\nCACHE:\n" 27 | , body 28 | ] 29 | [|return (AppCache (pack total))|] 30 | where 31 | toPath [] = "/" 32 | toPath x = concatMap ('/':) x 33 | 34 | goTree :: Monad m 35 | => ([String] -> [String]) 36 | -> ResourceTree String 37 | -> WriterT (Set.Set [String]) m () 38 | goTree front (ResourceLeaf res) = do 39 | pieces' <- goPieces (resourceName res) $ resourcePieces res 40 | when ("CACHE" `elem` resourceAttrs res) $ 41 | tell $ Set.singleton $ front pieces' 42 | goTree front (ResourceParent name pieces trees) = do 43 | pieces' <- goPieces name pieces 44 | mapM_ (goTree $ front . (pieces' ++)) trees 45 | 46 | goPieces :: Monad m => String -> [(CheckOverlap, Piece String)] -> m [String] 47 | goPieces name = 48 | mapM (goPiece . snd) 49 | where 50 | goPiece (Static s) = return s 51 | goPiece (Dynamic _) = fail $ concat 52 | [ "AppCache only applies to fully-static paths, but " 53 | , name 54 | , " has dynamic pieces." 55 | ] 56 | 57 | instance ToContent AppCache where 58 | toContent = toContent . unAppCache 59 | instance ToTypedContent AppCache where 60 | toTypedContent = TypedContent "text/cache-manifest" . toContent 61 | -------------------------------------------------------------------------------- /demo/appcache/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | import AppCache 6 | import Routes 7 | import Yesod.Core 8 | 9 | instance Yesod App 10 | 11 | mkYesodDispatch "App" resourcesApp 12 | 13 | getHomeR :: Handler String 14 | getHomeR = return "Hello" 15 | 16 | getSomethingR :: Handler String 17 | getSomethingR = return "Hello" 18 | 19 | getAppCacheR :: Handler AppCache 20 | getAppCacheR = $(appCache resourcesApp) 21 | 22 | main :: IO () 23 | main = warp 3000 App 24 | -------------------------------------------------------------------------------- /demo/appcache/Routes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | module Routes where 6 | 7 | import Yesod.Core 8 | 9 | data App = App 10 | 11 | mkYesodData "App" [parseRoutes| 12 | / HomeR GET 13 | /some/thing SomethingR GET !CACHE 14 | /appcache AppCacheR GET 15 | |] 16 | -------------------------------------------------------------------------------- /demo/auth/config/secrets.yaml: -------------------------------------------------------------------------------- 1 | accessKey: 2 | secretKey: 3 | -------------------------------------------------------------------------------- /demo/lite/lite.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Yesod.Core 3 | import Data.Aeson 4 | import Data.Monoid ((<>)) 5 | import Data.Text (Text, pack) 6 | 7 | people :: [(Text, Int)] 8 | people = [("Alice", 25), ("Bob", 43), ("Charlie", 37)] 9 | 10 | main = warp 3000 $ liteApp $ do 11 | onStatic "people" $ dispatchTo getPeople 12 | onStatic "person" $ withDynamic $ dispatchTo . getPerson 13 | 14 | getPeople = return $ toJSON $ map fst people 15 | 16 | getPerson name = 17 | case lookup name people of 18 | Nothing -> notFound 19 | Just age -> selectRep $ do 20 | provideRep $ return $ object ["name" .= name, "age" .= age] 21 | provideRep $ return $ name <> " is " <> pack (show age) <> " years old" 22 | -------------------------------------------------------------------------------- /demo/streaming-db/streaming-db.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE QuasiQuotes #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | import Control.Monad.Logger (runNoLoggingT) 9 | import Data.Conduit (awaitForever, runResourceT, ($=)) 10 | import Data.Text (Text) 11 | import Database.Persist.Sqlite (ConnectionPool, SqlPersist, 12 | SqliteConf (..), runMigration, 13 | runSqlPool) 14 | import Database.Persist.Store (createPoolConfig) 15 | import Yesod.Core 16 | import Yesod.Persist 17 | 18 | share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist| 19 | Person 20 | name Text 21 | |] 22 | 23 | data App = App 24 | { appConfig :: SqliteConf 25 | , appPool :: ConnectionPool 26 | } 27 | 28 | mkYesod "App" [parseRoutes| 29 | / HomeR GET 30 | |] 31 | 32 | instance Yesod App 33 | instance YesodPersist App where 34 | type YesodPersistBackend App = SqlPersist 35 | runDB = defaultRunDB appConfig appPool 36 | instance YesodPersistRunner App where 37 | getDBRunner = defaultGetDBRunner appPool 38 | 39 | getHomeR :: Handler TypedContent 40 | getHomeR = do 41 | runDB $ do 42 | runMigration migrateAll 43 | deleteWhere ([] :: [Filter Person]) 44 | insert_ $ Person "Charlie" 45 | insert_ $ Person "Alice" 46 | insert_ $ Person "Bob" 47 | respondSourceDB typePlain $ selectSource [] [Asc PersonName] $= awaitForever toBuilder 48 | where 49 | toBuilder (Entity _ (Person name)) = do 50 | sendChunkText name 51 | sendChunkText "\n" 52 | sendFlush 53 | 54 | main :: IO () 55 | main = do 56 | let config = SqliteConf ":memory:" 1 57 | pool <- createPoolConfig config 58 | runNoLoggingT $ runResourceT $ flip runSqlPool pool $ do 59 | runMigration migrateAll 60 | deleteWhere ([] :: [Filter Person]) 61 | insert_ $ Person "Charlie" 62 | insert_ $ Person "Alice" 63 | insert_ $ Person "Bob" 64 | warp 3000 App 65 | { appConfig = config 66 | , appPool = pool 67 | } 68 | -------------------------------------------------------------------------------- /demo/streaming/streaming.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-} 2 | import Yesod.Core 3 | import Data.Conduit 4 | import qualified Data.Conduit.Binary as CB 5 | import Control.Concurrent.Lifted (threadDelay) 6 | import Data.Monoid ((<>)) 7 | import qualified Data.Text as T 8 | import Control.Monad (forM_) 9 | 10 | data App = App 11 | 12 | mkYesod "App" [parseRoutes| 13 | / HomeR GET 14 | |] 15 | 16 | instance Yesod App 17 | 18 | fibs :: [Int] 19 | fibs = 1 : 1 : zipWith (+) fibs (tail fibs) 20 | 21 | getHomeR :: Handler TypedContent 22 | getHomeR = do 23 | value <- lookupGetParam "x" 24 | case value of 25 | Just "file" -> respondSource typePlain $ do 26 | sendChunkText "Going to read a file\n\n" 27 | CB.sourceFile "streaming.hs" $= awaitForever sendChunkBS 28 | sendChunkText "Finished reading the file\n" 29 | Just "fibs" -> respondSource typePlain $ do 30 | forM_ fibs $ \fib -> do 31 | $logError $ "Got fib: " <> T.pack (show fib) 32 | sendChunkText $ "Next fib is: " <> T.pack (show fib) <> "\n" 33 | yield Flush 34 | sendFlush 35 | threadDelay 1000000 36 | _ -> fmap toTypedContent $ defaultLayout $ do 37 | setTitle "Streaming" 38 | [whamlet| 39 |

Notice how in the code above we perform selection before starting the stream. 40 |

Anyway, choose one of the options below. 41 |