summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfozworth <>2015-03-29 14:44:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-03-29 14:44:00 (GMT)
commitdd439f416c32a9672a674dcd40e40dc3e145760f (patch)
tree1a81d20032dd26d5295fd9fb90bcf8febe7e9e42
parent94957e319468cb96eb6436366e2ad854393dde77 (diff)
version 0.0.10.0.1
-rw-r--r--CHANGELOG.md76
-rw-r--r--README.md84
-rw-r--r--blunt.cabal40
-rw-r--r--library/Blunt.hs131
-rw-r--r--library/Blunt/Markup.hs52
-rw-r--r--library/Blunt/Script.hs39
-rw-r--r--library/Blunt/Style.hs65
7 files changed, 67 insertions, 420 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
deleted file mode 100644
index a33ebf1..0000000
--- a/CHANGELOG.md
+++ /dev/null
@@ -1,76 +0,0 @@
-# Change log
-
-## v0.0.15 (2015-03-29)
-
-- Switch to converting expressions over WebSockets.
-- Removed the `/convert` endpoint.
-
-## v0.0.14 (2015-03-27)
-
-- Added request logging.
-- Added gzip compression.
-- Removed trailing semicolons from pointful output.
-
-## 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`.
-
-## v0.0.11 (2015-03-23)
-
-- Added permalinks by storing the input in the URL hash and reading it on
- page load.
-- Added dependency on Hackage version of pointful package.
-
-## v0.0.10 (2015-03-23)
-
-- Added a pointful conversion of the expression as well.
-
-## v0.0.9 (2015-03-20)
-
-- Updated to list all intermediate steps instead of only the final result.
-- Optimized text input for mobile devices.
-
-## v0.0.8 (2015-03-20)
-
-- Created a simple stylesheet.
-
-## v0.0.7 (2015-03-19)
-
-- Fixed link in Hackage documentation.
-
-## v0.0.6 (2015-03-19)
-
-- Switch from Bitbucket to GitHub.
-
-## v0.0.5 (2015-03-19)
-
-- Constraint versions of `pointfree` dependencies.
-
-## 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.
-
-## v0.0.2 (2015-03-18)
-
-- Added a rudimentary user interface.
-- Moved HTML into a separate file.
-
-## v0.0.1 (2015-03-18)
-
-- Initially released.
-
-## v0.0.0 (2015-03-17)
-
-- Initially created.
diff --git a/README.md b/README.md
deleted file mode 100644
index f55726c..0000000
--- a/README.md
+++ /dev/null
@@ -1,84 +0,0 @@
-<h1 align="center">
- <a href="https://github.com/tfausak/blunt">
- Blunt
- </a>
-</h1>
-
-<p align="center">
- Blunt converts between pointfree and pointful Haskell expressions.
-</p>
-
-<p align="center">
- <a href="https://hackage.haskell.org/package/blunt">
- <img alt="" src="https://img.shields.io/hackage/v/blunt.svg">
- </a>
- <a href="http://packdeps.haskellers.com/feed?needle=blunt">
- <img alt="" src="https://img.shields.io/hackage-deps/v/blunt.svg">
- </a>
-</p>
-
-<hr>
-
-Blunt is a web front end to the [pointfree][] and [pointful][] libraries. While
-you can install and run it locally, there's no real reason to prefer it over
-the `pointfree` and `pointful` executables. Instead, use the hosted version:
-<https://blunt.herokuapp.com>.
-
-## Install
-
-``` sh
-$ cabal update
-$ cabal install 'blunt ==0.0.*'
-```
-
-## Use
-
-``` sh
-$ blunt
-# http://localhost:8080
-
-$ env PORT=8888 blunt
-# http://localhost:8888
-```
-
-## Develop
-
-``` sh
-$ git clone https://github.com/tfausak/blunt
-$ cd blunt
-
-$ cabal sandbox init
-$ cabal install happy
-$ cabal install
-```
-
-## Deploy
-
-``` sh
-# 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
-[pointful]: http://hackage.haskell.org/package/pointful
diff --git a/blunt.cabal b/blunt.cabal
index 34c87f0..f9693d2 100644
--- a/blunt.cabal
+++ b/blunt.cabal
@@ -1,56 +1,38 @@
name: blunt
-version: 0.0.15
+version: 0.0.1
cabal-version: >=1.10
build-type: Simple
license: MIT
license-file: LICENSE.md
maintainer: Taylor Fausak <taylor@fausak.me>
-homepage: https://blunt.herokuapp.com
-bug-reports: https://github.com/tfausak/blunt/issues
synopsis: Point-free Haskell as a service.
description:
- <https://github.com/tfausak/blunt>
+ TODO
category: Web
-extra-source-files:
- CHANGELOG.md
- README.md
source-repository head
type: git
- location: https://github.com/tfausak/blunt
+ location: https://bitbucket.org/taylorfausak/blunt
library
exposed-modules:
Blunt
- Blunt.Markup
- Blunt.Script
- Blunt.Style
build-depends:
base ==4.*,
- aeson ==0.8.*,
- bytestring ==0.10.*,
- clay ==0.10.*,
- http-types ==0.8.*,
- jmacro ==0.6.*,
- lucid ==2.*,
- pointful >=1.0.6 && <2,
- text ==1.*,
- wai ==3.*,
- wai-extra ==3.*,
- wai-websockets ==3.*,
- warp ==3.*,
- websockets ==0.9.*,
- wl-pprint-text ==1.*
+ bytestring -any,
+ http-types -any,
+ wai -any,
+ warp ==3.*
default-language: Haskell2010
hs-source-dirs: library
ghc-options: -Wall
-- pointfree
build-depends:
- array >=0.3 && <0.6,
- containers >=0.4 && <0.6,
- haskell-src-exts ==1.16.*,
- transformers <0.5
+ array,
+ containers,
+ haskell-src-exts,
+ transformers
other-modules:
Pointfree
Plugin.Pl.Common
diff --git a/library/Blunt.hs b/library/Blunt.hs
index c62a712..ecf8bfd 100644
--- a/library/Blunt.hs
+++ b/library/Blunt.hs
@@ -2,81 +2,62 @@
module Blunt where
-import Blunt.Markup (markup)
-import Control.Exception (SomeException, evaluate, handle)
-import Control.Monad (forever)
-import Data.Aeson (ToJSON, encode, object, toJSON, (.=))
-import Data.List (isPrefixOf, isSuffixOf)
-import Data.Text.Lazy (Text, unpack)
-import Lambdabot.Pointful (pointful)
+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 (Application, pathInfo, requestMethod, responseLBS)
-import Network.Wai.Handler.Warp (runEnv)
-import Network.Wai.Handler.WebSockets (websocketsOr)
-import Network.Wai.Middleware.Gzip (def, gzip)
-import Network.Wai.Middleware.RequestLogger (logStdout)
-import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions,
- receiveData, sendTextData)
-import Pointfree (pointfree)
+import Network.Wai (queryString, pathInfo, requestMethod, responseLBS)
+import Network.Wai.Handler.Warp (run)
+import Pointfree (pointfree')
main :: IO ()
-main = runEnv 8080 application
-
-application :: Application
-application = websocketsOr defaultConnectionOptions ws http
-
-ws :: ServerApp
-ws pending = do
- connection <- acceptRequest pending
- forever $ do
- message <- receiveData connection
- result <- convert message
- sendTextData connection (encode result)
-
-http :: Application
-http = gzip def . logStdout $ \ request respond ->
- respond $ case (requestMethod request, pathInfo request) of
- ("GET", []) -> responseLBS status headers body where
- status = ok200
- headers = [("Content-Type", "text/html; charset=utf-8")]
- body = markup
- _ -> responseLBS notFound404 [] ""
-
-convert :: Text -> IO Conversion
-convert message = do
- let input = unpack message
- pf <- safePointfree input
- let pl = safePointful input
- return Conversion
- { conversionInput = input
- , conversionPointfree = pf
- , conversionPointful = pl
- }
-
-safePointfree :: String -> IO [String]
-safePointfree = handle handler . evaluate . pointfree
-
-handler :: SomeException -> IO [String]
-handler _ = return []
-
-safePointful :: String -> Maybe String
-safePointful input =
- let output = pointful input
- in if any (`isPrefixOf` output) ["Error:", "<unknown>.hs:"]
- then Nothing
- else if ";" `isSuffixOf` output && not (";" `isSuffixOf` input)
- then Just (init output)
- else Just output
-
-data Conversion = Conversion
- { conversionInput :: String
- , conversionPointfree :: [String]
- , conversionPointful :: Maybe String
- } deriving (Read, Show)
-
-instance ToJSON Conversion where
- toJSON result = object
- [ "input" .= conversionInput result
- , "pointfree" .= conversionPointfree result
- , "pointful" .= conversionPointful result
- ]
+main = run 8080 $ \ request respond -> do
+ let method = requestMethod request
+ path = pathInfo request
+ response = case (method, path) of
+ ("GET", []) -> responseLBS ok200 [("Content-Type", "text/html; charset=utf-8")] $ pack $ unlines
+ [ "<!doctype html>"
+ , ""
+ , "<html>"
+ , " <head>"
+ , " <title>Pointfree</title>"
+ , " </head>"
+ , ""
+ , " <body>"
+ , " <input id='input' autofocus>"
+ , " <input id='output' readonly>"
+ , ""
+ , " <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>"
+ ]
+ ("GET", ["pointfree"]) ->
+ let params = queryString request
+ input = case lookup "input" params of
+ Just (Just param) -> param
+ _ -> ""
+ maybeOutput = pointfree' (unpack input)
+ body = case maybeOutput of
+ Just output -> pack output
+ Nothing -> fromStrict input
+ in responseLBS ok200 [("Content-Type", "text/plain; charset=utf-8")] body
+ _ -> responseLBS notFound404 [] ""
+ respond response
diff --git a/library/Blunt/Markup.hs b/library/Blunt/Markup.hs
deleted file mode 100644
index 352bb71..0000000
--- a/library/Blunt/Markup.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Blunt.Markup where
-
-import Lucid
-
-import Blunt.Script (script)
-import Blunt.Style (style)
-import Data.ByteString.Lazy (ByteString)
-
-markup :: ByteString
-markup = renderBS html
-
-html :: Html ()
-html = doctypehtml_ $ do
- head_ $ do
- 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
deleted file mode 100644
index 8a28824..0000000
--- a/library/Blunt/Script.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Blunt.Script where
-
-import Language.Javascript.JMacro
-
-import Data.Text.Lazy (Text)
-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 socket = new WebSocket(window.location.origin.replace('http', 'ws'));
-
- socket.onopen = \ {
- input.oninput = \ {
- window.location.replace("#input=" + input.value);
- socket.send(input.value);
- };
-
- if (input.value) { input.oninput(); }
- };
-
- socket.onmessage = \ message {
- var response = JSON.parse(message.data);
- pointfree.textContent = response.pointfree.join("\n");
- pointful.textContent = response.pointful;
- };
-
- if (window.location.hash.indexOf("#input=") === 0) {
- input.value = window.location.hash.substring(7);
- }
-}(); |]
diff --git a/library/Blunt/Style.hs b/library/Blunt/Style.hs
deleted file mode 100644
index 02ad0d3..0000000
--- a/library/Blunt/Style.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# 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)