blunt 0.0.3 → 0.0.4
raw patch · 4 files changed
+102/−87 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Blunt: application :: Application
+ Blunt: html :: String
+ Blunt: indexAction :: Action
+ Blunt: js :: String
+ Blunt: notFoundAction :: Action
+ Blunt: pointfreeAction :: Action
+ Blunt: route :: Request -> Action
+ Blunt: type Action = Request -> IO Response
Files
- CHANGELOG.md +5/−0
- blunt.cabal +2/−7
- data/index.html +0/−53
- library/Blunt.hs +95/−27
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Change log +## v0.0.4 (2015-03-19)++- Allow setting the port with the `PORT` environment variable.+- Took HTML out of its separate file.+ ## v0.0.3 (2015-03-19) - Prevent `pointfree'` from throwing errors during a request.
blunt.cabal view
@@ -1,5 +1,5 @@ name: blunt-version: 0.0.3+version: 0.0.4 cabal-version: >=1.10 build-type: Simple license: MIT@@ -7,11 +7,8 @@ maintainer: Taylor Fausak <taylor@fausak.me> synopsis: Point-free Haskell as a service. description:- TODO+ https://bitbucket.org/taylorfausak/blunt category: Web-data-files:- index.html-data-dir: data extra-source-files: CHANGELOG.md README.md@@ -31,8 +28,6 @@ warp ==3.* default-language: Haskell2010 hs-source-dirs: library- other-modules:- Paths_blunt ghc-options: -Wall -- pointfree
− data/index.html
@@ -1,53 +0,0 @@-<!doctype html>--<html>- <head>- <meta name="viewport" content="initial-scale = 1, width = device-width">-- <title>Blunt</title>- </head>-- <body>- <h1>Blunt</h1>-- <dl>- <dt>Input</dt>- <dd>- <input- id="input"- placeholder="sum xs = foldr (+) 0 xs"- autofocus>- </dd>-- <dt>Output</dt>- <dd>- <input- id="output"- placeholder="sum = foldr (+) 0"- readonly>- </dd>- </dl>-- <script>- 'use strict';-- (function () {- var input = document.getElementById('input');- var output = document.getElementById('output');-- input.oninput = function (_event) {- var request = new XMLHttpRequest();-- request.onreadystatechange = function () {- if (request.readyState === 4 && request.status === 200) {- output.value = request.response;- }- };- request.open('GET',- '/pointfree?input=' + encodeURIComponent(input.value));- request.send();- };- }());- </script>- </body>-</html>
library/Blunt.hs view
@@ -2,43 +2,111 @@ module Blunt where -import Paths_blunt (getDataFileName)- import Control.Exception (SomeException, evaluate, handle) import Data.ByteString.Char8 (unpack) import Data.ByteString.Lazy (fromStrict) import Data.ByteString.Lazy.Char8 (pack) import Network.HTTP.Types (notFound404, ok200)-import Network.Wai (queryString, pathInfo, requestMethod, responseFile,- responseLBS)-import Network.Wai.Handler.Warp (run)+import Network.Wai (Application, Request, Response, queryString, pathInfo,+ requestMethod, responseLBS)+import Network.Wai.Handler.Warp (runEnv) import Pointfree (pointfree') main :: IO ()-main = run 8080 $ \ request respond -> do- index <- getDataFileName "index.html"- let method = requestMethod request- path = pathInfo request- response <- case (method, path) of- ("GET", []) -> return $ responseFile- ok200- [("Content-Type", "text/html; charset=utf-8")]- index- Nothing- ("GET", ["pointfree"]) -> do- let params = queryString request- input = case lookup "input" params of- Just (Just param) -> param- _ -> ""- maybeOutput <- safePointfree (unpack input)- let body = case maybeOutput of- Just output -> pack output- Nothing -> fromStrict input- return $ responseLBS ok200 [("Content-Type", "text/plain; charset=utf-8")] body- _ -> return $ responseLBS notFound404 [] ""- respond response+main = runEnv 8080 application +application :: Application+application request respondWith = do+ let action = route request+ response <- action request+ respondWith response++type Action = Request -> IO Response++route :: Request -> Action+route request = case (requestMethod request, pathInfo request) of+ ("GET", []) -> indexAction+ ("GET", ["pointfree"]) -> pointfreeAction+ _ -> notFoundAction++indexAction :: Action+indexAction _request = do+ let headers = [("Content-Type", "text/html; charset=utf-8")]+ body = pack html+ return (responseLBS ok200 headers body)++pointfreeAction :: Action+pointfreeAction request = do+ let params = queryString request+ input = case lookup "input" params of+ Just (Just param) -> param+ _ -> ""+ maybeOutput <- safePointfree (unpack input)+ let headers = [("Content-Type", "text/plain; charset=utf-8")]+ body = case maybeOutput of+ Just output -> pack output+ Nothing -> fromStrict input+ return (responseLBS ok200 headers body)++notFoundAction :: Action+notFoundAction _request = return (responseLBS notFound404 [] "")+ safePointfree :: String -> IO (Maybe String) safePointfree = handle handler . evaluate . pointfree' where handler :: SomeException -> IO (Maybe String) handler _ = return Nothing++html :: String+html = unlines+ [ "<!doctype html>"+ , ""+ , "<html>"+ , " <head>"+ , " <meta name='viewport' content='initial-scale = 1, width = device-width'>"+ , ""+ , " <title>Blunt</title>"+ , " </head>"+ , ""+ , " <body>"+ , " <h1>Blunt</h1>"+ , ""+ , " <dl>"+ , " <dt>Input</dt>"+ , " <dd>"+ , " <input id='input' placeholder='sum xs = foldr (+) 0 xs' autofocus>"+ , " </dd>"+ , ""+ , " <dt>Output</dt>"+ , " <dd>"+ , " <input id='output' placeholder='sum = foldr (+) 0' readonly>"+ , " </dd>"+ , " </dl>"+ , ""+ , " <script>"+ , js+ , " </script>"+ , " </body>"+ , "</html>"+ ]++js :: String+js = unlines+ [ "'use strict';"+ , ""+ , "(function () {"+ , " var input = document.getElementById('input');"+ , " var output = document.getElementById('output');"+ , ""+ , " input.oninput = function (_event) {"+ , " var request = new XMLHttpRequest();"+ , ""+ , " request.onreadystatechange = function () {"+ , " if (request.readyState === 4 && request.status === 200) {"+ , " output.value = request.response;"+ , " }"+ , " };"+ , " request.open('GET', '/pointfree?input=' + encodeURIComponent(input.value));"+ , " request.send();"+ , " };"+ , "}());"+ ]