├── .gitignore ├── LICENSE ├── Main.hs ├── NOTES.org ├── Pages.hs ├── README.md ├── Setup.hs ├── blimp.cabal └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | .stack-work 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Patrick Thomson 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 included 12 | 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 NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | Copyright (c) 2015 Patrick Thomson 22 | 23 | Permission is hereby granted, free of charge, to any person obtaining 24 | a copy of this software and associated documentation files (the 25 | "Software"), to deal in the Software without restriction, including 26 | without limitation the rights to use, copy, modify, merge, publish, 27 | distribute, sublicense, and/or sell copies of the Software, and to 28 | permit persons to whom the Software is furnished to do so, subject to 29 | the following conditions: 30 | 31 | The above copyright notice and this permission notice shall be included 32 | in all copies or substantial portions of the Software. 33 | 34 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 35 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 36 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 37 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 38 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 39 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 40 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 41 | -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Airship 6 | import Airship.Helpers 7 | import Airship.Resource 8 | import Airship.Route 9 | import Airship.Types 10 | import Control.Applicative 11 | import Control.Monad.Reader 12 | import Data.IORef 13 | import Data.Pool 14 | import Text.Blaze.Html (Html) 15 | import Text.Blaze.Html.Renderer.Utf8 16 | 17 | import Network.Wai (strictRequestBody) 18 | import qualified Network.Wai as WAI 19 | import Network.Wai.Handler.Warp (defaultSettings, runSettings, 20 | setHost, setPort) 21 | 22 | 23 | import Pages 24 | 25 | data AppState = AppState 26 | { pool :: Pool Int 27 | } deriving (Show) 28 | 29 | type Blimp = ReaderT AppState IO 30 | 31 | buildHtmlResponse :: Html -> ResponseBody 32 | buildHtmlResponse = ResponseBuilder . renderHtmlBuilder 33 | 34 | rootResource :: Resource Blimp 35 | rootResource = defaultResource 36 | { knownContentType = contentTypeMatches ["text/*"] 37 | , contentTypesProvided = do 38 | p <- lift $ asks pool 39 | withResource p $ \int1 -> 40 | withResource p $ \int2 -> do 41 | now <- requestTime 42 | let page = frontPage int1 int2 now 43 | return [ ("text/html", return (buildHtmlResponse page))] 44 | } 45 | 46 | mkAppState :: AppState -> Request -> Blimp WAI.Response -> IO WAI.Response 47 | mkAppState st _r resp = runReaderT resp st 48 | 49 | generateInt :: IORef Int -> IO Int 50 | generateInt r = do 51 | val <- readIORef r 52 | modifyIORef r succ 53 | return val 54 | 55 | destroyInt :: IORef Int -> Int -> IO () 56 | destroyInt r _ = modifyIORef r succ 57 | 58 | routes :: RoutingSpec Blimp () 59 | routes = do 60 | root #> rootResource 61 | 62 | main :: IO () 63 | main = do 64 | let port = 3000 65 | host = "127.0.0.1" 66 | settings = setPort port (setHost host defaultSettings) 67 | counter <- newIORef 0 68 | pool <- createPool (generateInt counter) (destroyInt counter) 10 60 10 69 | let state = AppState pool 70 | putStrLn "listening on port 3000" 71 | runSettings settings (resourceToWaiT defaultAirshipConfig (mkAppState state) routes mempty) 72 | -------------------------------------------------------------------------------- /NOTES.org: -------------------------------------------------------------------------------- 1 | * You can't install blaze-html 0.8 because of a blaze-builder dependency mismatch. Solvable? 2 | -------------------------------------------------------------------------------- /Pages.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Pages where 4 | 5 | import Data.Monoid 6 | import Data.Time.Clock 7 | import Data.Time.Format 8 | import Prelude hiding (head) 9 | import Text.Blaze.Html5 10 | 11 | frontPage :: Int -> Int -> UTCTime -> Html 12 | frontPage a b t = do 13 | docType 14 | head $ title "this is a front page!!" 15 | body $ do 16 | p "this is a paragraph!!" 17 | p ("we got an integer: " <> toHtml a) 18 | p ("and another: " <> toHtml b) 19 | let time = formatTime defaultTimeLocale rfc822DateFormat t 20 | p ("request was served at " <> toHtml time) 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Blimp 2 | 3 | This is an example [Airship](https://github.com/helium/airship) application. It shows a simple mapping of routes to resources, HTML generation using blaze-html, and striped resource pooling with [resource-pool](https://hackage.haskell.org/package/resource-pool). 4 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /blimp.cabal: -------------------------------------------------------------------------------- 1 | -- Initial blimp.cabal generated by cabal init. For further documentation, 2 | -- see http://haskell.org/cabal/users-guide/ 3 | 4 | name: blimp 5 | version: 0.1.0.0 6 | synopsis: testing out airship 7 | -- description: 8 | license: MIT 9 | license-file: LICENSE 10 | author: Patrick Thomson 11 | maintainer: patrick@helium.co 12 | -- copyright: 13 | category: Web 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | executable blimp 19 | main-is: Main.hs 20 | other-modules: Pages 21 | -- other-extensions: 22 | ghc-options: -threaded -Wall -Werror -fwarn-tabs -funbox-strict-fields 23 | -rtsopts "-with-rtsopts=-N -T" -fprof-auto 24 | build-depends: base 25 | , airship 26 | , blaze-html 27 | , old-locale 28 | , resource-pool 29 | , time 30 | , mtl 31 | , wai 32 | , warp 33 | 34 | -- hs-source-dirs: 35 | default-language: Haskell2010 36 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | require-stack-version: ">= 1.0.2" 2 | resolver: nightly-2016-07-14 3 | --------------------------------------------------------------------------------