blunt 0.0.13 → 0.0.14

raw patch · 13 files changed

+156/−83 lines, 13 filesdep +wai-extraPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: wai-extra

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• blunt.cabal +9/−1
• library/Blunt.hs +22/−76
• library/Blunt/Actions.hs +51/−0
• library/Blunt/Application.hs +10/−0
• library/Blunt/Main.hs +8/−0
• library/Blunt/Markup.hs +2/−2
• library/Blunt/Middleware.hs +8/−0
• library/Blunt/Pointfree.hs +9/−0
• library/Blunt/Pointful.hs +13/−0
• library/Blunt/Router.hs +12/−0
• library/Blunt/Script.hs +5/−4
• library/Blunt/Style.hs +1/−0

@@ -1,5 +1,11 @@ # Change log +## 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.

@@ -1,5 +1,5 @@ name: blunt-version: 0.0.13+version: 0.0.14 cabal-version: >=1.10 build-type: Simple license: MIT@@ -22,7 +22,14 @@ 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:@@ -36,6 +43,7 @@         pointful >=1.0.6 && <2,         text ==1.*,         wai ==3.*,+        wai-extra ==3.*,         warp ==3.*,         wl-pprint-text ==1.*     default-language: Haskell2010

@@ -1,77 +1,23 @@-{-# LANGUAGE OverloadedStrings #-}--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 Lambdabot.Pointful (pointful)-import Network.HTTP.Types (notFound404, ok200)-import Network.Wai (Application, Request, Response, queryString, pathInfo,-    requestMethod, responseLBS)-import Network.Wai.Handler.Warp (runEnv)-import Pointfree (pointfree)--main :: IO ()-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", ["convert"]) -> convertAction-    _ -> notFoundAction--indexAction :: Action-indexAction _request = do-    let headers = [("Content-Type", "text/html")]-        body = markup-    return (responseLBS ok200 headers body)--data Result = Result-    { resultInput :: String-    , resultPointfree :: [String]-    , resultPointful :: String-    } deriving (Read, Show)--instance ToJSON Result where-    toJSON result = object-        [ "input" .= resultInput result-        , "pointfree" .= resultPointfree result-        , "pointful" .= resultPointful result-        ]--convertAction :: Action-convertAction request = do-    let input = case lookup "input" (queryString request) of-            Just (Just param) -> unpack param-            _ -> ""--    pf <- safePointfree input-    let pl = pointful input-        result = Result-            { resultInput = input-            , resultPointfree = pf-            , resultPointful = pl-            }--    let headers = [("Content-Type", "application/json")]-        body = encode result-    return (responseLBS ok200 headers body)--notFoundAction :: Action-notFoundAction _request = return (responseLBS notFound404 [] "")+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 -safePointfree :: String -> IO [String]-safePointfree = handle handler . evaluate . pointfree where-    handler :: SomeException -> IO [String]-    handler _ = return []+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

@@ -0,0 +1,51 @@+{-# 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 [] "")

@@ -0,0 +1,10 @@+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

@@ -0,0 +1,8 @@+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)

@@ -2,11 +2,11 @@  module Blunt.Markup where +import Lucid+ import Blunt.Script (script) import Blunt.Style (style)- import Data.ByteString.Lazy (ByteString)-import Lucid  markup :: ByteString markup = renderBS html

@@ -0,0 +1,8 @@+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

@@ -0,0 +1,9 @@+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 []

@@ -0,0 +1,13 @@+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

@@ -0,0 +1,12 @@+{-# 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

@@ -2,15 +2,16 @@  module Blunt.Script where -import Data.Text.Lazy (Text) 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|+js = [jmacro| \ {     var input = document.getElementById("input");     var pointfree = document.getElementById("pointfree");     var pointful = document.getElementById("pointful");@@ -36,9 +37,9 @@         updateHash();         updateOutput();     };-    +     if (window.location.hash.indexOf("#input=") === 0) {         input.value = window.location.hash.substring(7);         input.oninput();     }-|]+}(); |]

@@ -3,6 +3,7 @@ module Blunt.Style where  import Clay+ import Data.Monoid ((<>)) import Data.Text.Lazy (Text) import Prelude hiding (div)