summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfozworth <>2015-03-29 14:31:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-03-29 14:31:00 (GMT)
commit94957e319468cb96eb6436366e2ad854393dde77 (patch)
treeca2ddf423daa2b54c9aa96a14b5effb85adc9873
parent5c857e480e65b323ca23dfb9ad512eab64140e9f (diff)
version 0.0.150.0.15
-rw-r--r--CHANGELOG.md5
-rw-r--r--blunt.cabal11
-rw-r--r--library/Blunt.hs105
-rw-r--r--library/Blunt/Actions.hs51
-rw-r--r--library/Blunt/Application.hs10
-rw-r--r--library/Blunt/Main.hs8
-rw-r--r--library/Blunt/Markup.hs1
-rw-r--r--library/Blunt/Middleware.hs8
-rw-r--r--library/Blunt/Pointfree.hs9
-rw-r--r--library/Blunt/Pointful.hs13
-rw-r--r--library/Blunt/Router.hs12
-rw-r--r--library/Blunt/Script.hs26
12 files changed, 100 insertions, 159 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 22c5c09..a33ebf1 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,10 @@
# 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.
diff --git a/blunt.cabal b/blunt.cabal
index f1b6e58..34c87f0 100644
--- a/blunt.cabal
+++ b/blunt.cabal
@@ -1,5 +1,5 @@
name: blunt
-version: 0.0.14
+version: 0.0.15
cabal-version: >=1.10
build-type: Simple
license: MIT
@@ -22,14 +22,7 @@ source-repository head
library
exposed-modules:
Blunt
- Blunt.Actions
- Blunt.Application
- Blunt.Main
Blunt.Markup
- Blunt.Middleware
- Blunt.Pointfree
- Blunt.Pointful
- Blunt.Router
Blunt.Script
Blunt.Style
build-depends:
@@ -44,7 +37,9 @@ library
text ==1.*,
wai ==3.*,
wai-extra ==3.*,
+ wai-websockets ==3.*,
warp ==3.*,
+ websockets ==0.9.*,
wl-pprint-text ==1.*
default-language: Haskell2010
hs-source-dirs: library
diff --git a/library/Blunt.hs b/library/Blunt.hs
index b13470f..c62a712 100644
--- a/library/Blunt.hs
+++ b/library/Blunt.hs
@@ -1,23 +1,82 @@
-module Blunt
- ( module Blunt.Actions
- , module Blunt.Application
- , module Blunt.Main
- , module Blunt.Markup
- , module Blunt.Middleware
- , module Blunt.Pointfree
- , module Blunt.Pointful
- , module Blunt.Router
- , module Blunt.Script
- , module Blunt.Style
- ) where
-
-import Blunt.Actions
-import Blunt.Application
-import Blunt.Main
-import Blunt.Markup
-import Blunt.Middleware
-import Blunt.Pointfree
-import Blunt.Pointful
-import Blunt.Router
-import Blunt.Script
-import Blunt.Style
+{-# LANGUAGE OverloadedStrings #-}
+
+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 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)
+
+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
+ ]
diff --git a/library/Blunt/Actions.hs b/library/Blunt/Actions.hs
deleted file mode 100644
index e8ef8cf..0000000
--- a/library/Blunt/Actions.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Blunt.Actions where
-
-import Blunt.Markup (markup)
-import Blunt.Pointfree (safePointfree)
-import Blunt.Pointful (safePointful)
-import Data.Aeson (ToJSON, encode, object, toJSON, (.=))
-import Data.ByteString.Char8 (unpack)
-import Network.HTTP.Types (notFound404, ok200)
-import Network.Wai (Request, Response, queryString, responseLBS)
-
-indexAction :: Request -> IO Response
-indexAction _request = do
- let headers = [("Content-Type", "text/html")]
- body = markup
- return (responseLBS ok200 headers body)
-
-data Result = Result
- { resultInput :: String
- , resultPointfree :: [String]
- , resultPointful :: Maybe String
- } deriving (Read, Show)
-
-instance ToJSON Result where
- toJSON result = object
- [ "input" .= resultInput result
- , "pointfree" .= resultPointfree result
- , "pointful" .= resultPointful result
- ]
-
-convertAction :: Request -> IO Response
-convertAction request = do
- let input = case lookup "input" (queryString request) of
- Just (Just param) -> unpack param
- _ -> ""
-
- pf <- safePointfree input
- let pl = safePointful input
- result = Result
- { resultInput = input
- , resultPointfree = pf
- , resultPointful = pl
- }
-
- let headers = [("Content-Type", "application/json")]
- body = encode result
- return (responseLBS ok200 headers body)
-
-notFoundAction :: Request -> IO Response
-notFoundAction _request = return (responseLBS notFound404 [] "")
diff --git a/library/Blunt/Application.hs b/library/Blunt/Application.hs
deleted file mode 100644
index e38523d..0000000
--- a/library/Blunt/Application.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Blunt.Application where
-
-import Blunt.Router (route)
-import Network.Wai (Application)
-
-application :: Application
-application request respondWith = do
- let action = route request
- response <- action request
- respondWith response
diff --git a/library/Blunt/Main.hs b/library/Blunt/Main.hs
deleted file mode 100644
index 2feeff2..0000000
--- a/library/Blunt/Main.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Blunt.Main where
-
-import Blunt.Application (application)
-import Blunt.Middleware (middleware)
-import Network.Wai.Handler.Warp (runEnv)
-
-main :: IO ()
-main = runEnv 8080 (middleware application)
diff --git a/library/Blunt/Markup.hs b/library/Blunt/Markup.hs
index bd54945..352bb71 100644
--- a/library/Blunt/Markup.hs
+++ b/library/Blunt/Markup.hs
@@ -14,7 +14,6 @@ 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"
diff --git a/library/Blunt/Middleware.hs b/library/Blunt/Middleware.hs
deleted file mode 100644
index 69b4ef3..0000000
--- a/library/Blunt/Middleware.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Blunt.Middleware where
-
-import Network.Wai (Middleware)
-import Network.Wai.Middleware.Gzip (def, gzip)
-import Network.Wai.Middleware.RequestLogger (logStdout)
-
-middleware :: Middleware
-middleware = gzip def . logStdout
diff --git a/library/Blunt/Pointfree.hs b/library/Blunt/Pointfree.hs
deleted file mode 100644
index 9f5579e..0000000
--- a/library/Blunt/Pointfree.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Blunt.Pointfree where
-
-import Control.Exception (SomeException, evaluate, handle)
-import Pointfree (pointfree)
-
-safePointfree :: String -> IO [String]
-safePointfree = handle handler . evaluate . pointfree where
- handler :: SomeException -> IO [String]
- handler _ = return []
diff --git a/library/Blunt/Pointful.hs b/library/Blunt/Pointful.hs
deleted file mode 100644
index b3ca8cc..0000000
--- a/library/Blunt/Pointful.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Blunt.Pointful where
-
-import Data.List (isPrefixOf, isSuffixOf)
-import Lambdabot.Pointful (pointful)
-
-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
diff --git a/library/Blunt/Router.hs b/library/Blunt/Router.hs
deleted file mode 100644
index 375a631..0000000
--- a/library/Blunt/Router.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Blunt.Router where
-
-import Blunt.Actions (convertAction, indexAction, notFoundAction)
-import Network.Wai (Request, Response, pathInfo, requestMethod)
-
-route :: Request -> (Request -> IO Response)
-route request = case (requestMethod request, pathInfo request) of
- ("GET", []) -> indexAction
- ("GET", ["convert"]) -> convertAction
- _ -> notFoundAction
diff --git a/library/Blunt/Script.hs b/library/Blunt/Script.hs
index eb2d111..8a28824 100644
--- a/library/Blunt/Script.hs
+++ b/library/Blunt/Script.hs
@@ -16,30 +16,24 @@ js = [jmacro| \ {
var pointfree = document.getElementById("pointfree");
var pointful = document.getElementById("pointful");
- var updateHash = \ { window.location.replace("#input=" + input.value); };
+ var socket = new WebSocket(window.location.origin.replace('http', 'ws'));
- 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;
+ socket.onopen = \ {
+ input.oninput = \ {
+ window.location.replace("#input=" + input.value);
+ socket.send(input.value);
};
- request.open("GET", "/convert?input=" + encodeURIComponent(input.value));
- request.send();
+ if (input.value) { input.oninput(); }
};
- input.oninput = \ {
- updateHash();
- updateOutput();
+ 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);
- input.oninput();
}
}(); |]