diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Change log +## v0.0.13 (2015-03-25) + +- Switched from deploying a binary to using Haskell on Heroku. +- Converted HTML to Lucid. +- Converted CSS to Clay. +- Converted JS to JMacro. + ## v0.0.12 (2015-03-25) - Combined `/pointfree` and `/pointful` endpoints into `/convert`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -55,14 +55,29 @@ ## Deploy ``` sh -$ heroku create -$ git checkout -b deploy -$ echo '{}' > package.json -$ echo 'web: ./blunt' > Procfile -$ cp dist/build/blunt/blunt . -$ git add package.json Procfile blunt -$ git commit --allow-empty-message --message '' -$ git push --force heroku deploy:master +# Create a new app on Heroku using the Haskell on Heroku buildpack. +$ heroku apps:create --buildpack https://github.com/mietek/haskell-on-heroku + +# Let Halcyon know that we need happy installed. +$ heroku config:set HALCYON_SANDBOX_EXTRA_APPS='happy' + +# Configure AWS S3. +$ heroku config:set HALCYON_AWS_ACCESS_KEY_ID='...' +$ heroku config:set HALCYON_AWS_SECRET_ACCESS_KEY='...' +$ heroku config:set HALCYON_S3_BUCKET='...' + +# Push the code up to Heroku. Note that this build is expected to fail. +$ git push heroku master + +# Build the app on a PX dyno. +$ heroku run --size PX build + +# Force Heroku to rebuild the app using the cache built in the last step. +$ git commit --amend --no-edit +$ git push --force heroku master + +# Scale up a web dyno to serve requests. +$ heroku ps:scale web=1 ``` [pointfree]: http://hackage.haskell.org/package/pointfree diff --git a/blunt.cabal b/blunt.cabal --- a/blunt.cabal +++ b/blunt.cabal @@ -1,10 +1,12 @@ name: blunt -version: 0.0.12 +version: 0.0.13 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE.md maintainer: Taylor Fausak +homepage: https://blunt.herokuapp.com +bug-reports: https://github.com/tfausak/blunt/issues synopsis: Point-free Haskell as a service. description: @@ -20,14 +22,22 @@ library exposed-modules: Blunt + Blunt.Markup + Blunt.Script + Blunt.Style build-depends: base ==4.*, aeson ==0.8.*, - bytestring -any, - http-types -any, + bytestring ==0.10.*, + clay ==0.10.*, + http-types ==0.8.*, + jmacro ==0.6.*, + lucid ==2.*, pointful >=1.0.6 && <2, - wai -any, - warp ==3.* + text ==1.*, + wai ==3.*, + warp ==3.*, + wl-pprint-text ==1.* default-language: Haskell2010 hs-source-dirs: library ghc-options: -Wall diff --git a/library/Blunt.hs b/library/Blunt.hs --- a/library/Blunt.hs +++ b/library/Blunt.hs @@ -2,10 +2,11 @@ module Blunt where +import Blunt.Markup (markup) + import Control.Exception (SomeException, evaluate, handle) import Data.Aeson (ToJSON, (.=), encode, object, toJSON) import Data.ByteString.Char8 (unpack) -import Data.ByteString.Lazy.Char8 (pack) import Lambdabot.Pointful (pointful) import Network.HTTP.Types (notFound404, ok200) import Network.Wai (Application, Request, Response, queryString, pathInfo, @@ -33,7 +34,7 @@ indexAction :: Action indexAction _request = do let headers = [("Content-Type", "text/html")] - body = pack html + body = markup return (responseLBS ok200 headers body) data Result = Result @@ -74,155 +75,3 @@ safePointfree = handle handler . evaluate . pointfree where handler :: SomeException -> IO [String] handler _ = return [] - -html :: String -html = unlines - [ "" - , "" - , "" - , " " - , " " - , " " - , "" - , " Blunt" - , "" - , " " - , " " - , "" - , " " - , "

Blunt

" - , "" - , "
" - , "
Input
" - , "
" - , " " - , "
" - , "" - , "
Pointfree
" - , "
" - , "
" - , "
" - , "" - , "
Pointful
" - , "
" - , "
" - , "
" - , "
" - , "" - , "

" - , " " - , " https://github.com/tfausak/blunt" - , " " - , "

" - , "" - , " " - , " " - , "" - ] - -css :: String -css = unlines - [ "html, body {" - , " background: #f5f5f5;" - , " color: #151515;" - , " font: 100%/1.5em sans-serif;" - , " margin: 0;" - , " padding: 0;" - , "}" - , "" - , "body {" - , " box-sizing: border-box;" - , " margin: 0 auto;" - , " max-width: 40em;" - , " padding: 0 1.5em;" - , "}" - , "" - , "h1 {" - , " color: #90a959;" - , " font-size: 2em;" - , " font-weight: bold;" - , " line-height: 3em;" - , " margin: 0;" - , " text-align: center;" - , "}" - , "" - , "dl {" - , " margin: 0;" - , "}" - , "" - , "dt {" - , " margin-top: 1.5em;" - , "}" - , "" - , "dd {" - , " margin: 0;" - , "}" - , "" - , "input, div {" - , " border: thin solid #e0e0e0;" - , " box-sizing: border-box;" - , " font-family: monospace;" - , " font-size: 1em;" - , " width: 100%;" - , "}" - , "" - , "input {" - , " height: 3em;" - , " line-height: 3em;" - , " padding: 0 0.75em;" - , "}" - , "" - , "div {" - , " padding: 0.75em;" - , " white-space: pre-wrap;" - , "}" - , "" - , "p {" - , " margin: 1.5em 0 0 0;" - , " text-align: center;" - , "}" - ] - -js :: String -js = unlines - [ "'use strict';" - , "" - , "(function () {" - , " var input = document.getElementById('input');" - , " var pointfree = document.getElementById('pointfree');" - , " var pointful = document.getElementById('pointful');" - , "" - , " var updateHash = function () {" - , " window.location.replace('#input=' + input.value);" - , " };" - , "" - , " var updateOutput = function () {" - , " var request = new XMLHttpRequest();" - , "" - , " request.onreadystatechange = function () {" - , " if (request.readyState === 4 && request.status === 200) {" - , " var response = JSON.parse(request.response);" - , "" - , " pointfree.textContent = response.pointfree.join('\\n');" - , " pointful.textContent = response.pointful;" - , " }" - , " };" - , " request.open('GET', '/convert?input=' + encodeURIComponent(input.value));" - , " request.send();" - , " };" - , "" - , " input.oninput = function (_event) {" - , " updateHash();" - , " updateOutput();" - , " };" - , "" - , " if (window.location.hash.indexOf('#input=') === 0) {" - , " input.value = window.location.hash.substring(7);" - , " input.oninput();" - , " }" - , "}());" - ] diff --git a/library/Blunt/Markup.hs b/library/Blunt/Markup.hs new file mode 100644 --- /dev/null +++ b/library/Blunt/Markup.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Blunt.Markup where + +import Blunt.Script (script) +import Blunt.Style (style) + +import Data.ByteString.Lazy (ByteString) +import Lucid + +markup :: ByteString +markup = renderBS html + +html :: Html () +html = doctypehtml_ $ do + head_ $ do + meta_ [charset_ "utf-8"] + meta_ + [ name_ "viewport" + , content_ "initial-scale = 1, maximum-scale = 1, minimum-scale = 1, width = device-width" + ] + + title_ "Blunt" + + style_ [] style + + body_ $ do + h1_ "Blunt" + + dl_ $ do + dt_ "Input" + dd_ $ do + input_ + [ id_ "input" + , placeholder_ "sum xs = foldr (+) 0 xs" + , autocomplete_ "off" + , autofocus_ + , spellcheck_ "off" + , term "autocapitalize" "none" + , term "autocorrect" "off" + ] + + dt_ "Pointfree" + dd_ (div_ [id_ "pointfree"] "") + + dt_ "Pointful" + dd_ (div_ [id_ "pointful"] "") + + p_ $ do + a_ [href_ "https://github.com/tfausak/blunt"] $ do + "github.com/tfausak/blunt" + + script_ [] script diff --git a/library/Blunt/Script.hs b/library/Blunt/Script.hs new file mode 100644 --- /dev/null +++ b/library/Blunt/Script.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Blunt.Script where + +import Data.Text.Lazy (Text) +import Language.Javascript.JMacro +import Text.PrettyPrint.Leijen.Text (displayT, renderOneLine) + +script :: Text +script = displayT (renderOneLine (renderJs js)) + +js :: JStat +js = [jmacro| + var input = document.getElementById("input"); + var pointfree = document.getElementById("pointfree"); + var pointful = document.getElementById("pointful"); + + var updateHash = \ { window.location.replace("#input=" + input.value); }; + + var updateOutput = \ { + var request = new XMLHttpRequest; + + request.onreadystatechange = \ { + if (request.readyState !== 4 || request.status !== 200) { return; } + + var response = JSON.parse request.response; + pointfree.textContent = response.pointfree.join("\n"); + pointful.textContent = response.pointful; + }; + + request.open("GET", "/convert?input=" + encodeURIComponent(input.value)); + request.send(); + }; + + input.oninput = \ { + updateHash(); + updateOutput(); + }; + + if (window.location.hash.indexOf("#input=") === 0) { + input.value = window.location.hash.substring(7); + input.oninput(); + } +|] diff --git a/library/Blunt/Style.hs b/library/Blunt/Style.hs new file mode 100644 --- /dev/null +++ b/library/Blunt/Style.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Blunt.Style where + +import Clay +import Data.Monoid ((<>)) +import Data.Text.Lazy (Text) +import Prelude hiding (div) + +style :: Text +style = renderWith compact [] css + +css :: Css +css = do + html <> body ? do + backgroundColor "#f5f5f5" + color "#151515" + fontFamily [] [sansSerif] + lineHeight (em 1.5) + sym margin nil + sym padding nil + + body ? do + boxSizing borderBox + sym2 margin nil auto + maxWidth (em 40) + sym2 padding nil (em 1.5) + + h1 ? do + color "#90a959" + fontSize (em 2) + fontWeight bold + lineHeight (em 3) + sym margin nil + textAlign (alignSide sideCenter) + + dl ? do + sym margin nil + + dt ? do + marginTop (em 1.5) + + dd ? do + sym margin nil + + input <> div ? do + border solid (px 1) "#e0e0e0" + boxSizing borderBox + fontFamily [] [monospace] + fontSize (em 1) + width (pct 100) + + input ? do + height (em 3) + lineHeight (em 3) + sym2 padding nil (em 0.75) + + div ? do + sym padding (em 0.75) + whiteSpace preWrap + + p ? do + margin (em 1.5) nil nil nil + textAlign (alignSide sideCenter)