diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/blunt.cabal b/blunt.cabal --- a/blunt.cabal +++ b/blunt.cabal @@ -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 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 diff --git a/data/index.html b/data/index.html deleted file mode 100644 --- a/data/index.html +++ /dev/null @@ -1,53 +0,0 @@ - - - - - - - Blunt - - - -

Blunt

- -
-
Input
-
- -
- -
Output
-
- -
-
- - - - diff --git a/library/Blunt.hs b/library/Blunt.hs --- a/library/Blunt.hs +++ b/library/Blunt.hs @@ -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 + [ "" + , "" + , "" + , " " + , " " + , "" + , " Blunt" + , " " + , "" + , " " + , "

Blunt

" + , "" + , "
" + , "
Input
" + , "
" + , " " + , "
" + , "" + , "
Output
" + , "
" + , " " + , "
" + , "
" + , "" + , " " + , " " + , "" + ] + +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();" + , " };" + , "}());" + ]