packages feed

blunt 0.0.14 → 0.0.15

raw patch · 12 files changed

+99/−158 lines, 12 filesdep +wai-websocketsdep +websocketsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: wai-websockets, websockets

API changes (from Hackage documentation)

- Blunt.Actions: Result :: String -> [String] -> Maybe String -> Result
- Blunt.Actions: convertAction :: Request -> IO Response
- Blunt.Actions: data Result
- Blunt.Actions: indexAction :: Request -> IO Response
- Blunt.Actions: instance Read Result
- Blunt.Actions: instance Show Result
- Blunt.Actions: instance ToJSON Result
- Blunt.Actions: notFoundAction :: Request -> IO Response
- Blunt.Actions: resultInput :: Result -> String
- Blunt.Actions: resultPointfree :: Result -> [String]
- Blunt.Actions: resultPointful :: Result -> Maybe String
- Blunt.Application: application :: Application
- Blunt.Main: main :: IO ()
- Blunt.Middleware: middleware :: Middleware
- Blunt.Pointfree: safePointfree :: String -> IO [String]
- Blunt.Pointful: safePointful :: String -> Maybe String
- Blunt.Router: route :: Request -> (Request -> IO Response)
+ Blunt: Conversion :: String -> [String] -> Maybe String -> Conversion
+ Blunt: application :: Application
+ Blunt: conversionInput :: Conversion -> String
+ Blunt: conversionPointfree :: Conversion -> [String]
+ Blunt: conversionPointful :: Conversion -> Maybe String
+ Blunt: convert :: Text -> IO Conversion
+ Blunt: data Conversion
+ Blunt: handler :: SomeException -> IO [String]
+ Blunt: http :: Application
+ Blunt: instance Read Conversion
+ Blunt: instance Show Conversion
+ Blunt: instance ToJSON Conversion
+ Blunt: main :: IO ()
+ Blunt: safePointfree :: String -> IO [String]
+ Blunt: safePointful :: String -> Maybe String
+ Blunt: ws :: ServerApp

Files

CHANGELOG.md view
@@ -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.
blunt.cabal view
@@ -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 @@ 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 @@         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
library/Blunt.hs view
@@ -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+{-# LANGUAGE OverloadedStrings #-} -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+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+        ]
− library/Blunt/Actions.hs
@@ -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 [] "")
− library/Blunt/Application.hs
@@ -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
− library/Blunt/Main.hs
@@ -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)
library/Blunt/Markup.hs view
@@ -14,7 +14,6 @@ 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"
− library/Blunt/Middleware.hs
@@ -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
− library/Blunt/Pointfree.hs
@@ -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 []
− library/Blunt/Pointful.hs
@@ -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
− library/Blunt/Router.hs
@@ -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
library/Blunt/Script.hs view
@@ -16,30 +16,24 @@     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 socket = new WebSocket(window.location.origin.replace('http', 'ws')); -            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();     } }(); |]