quickwebapp 2.1.1.0 → 3.0.0.1

raw patch · 2 files changed

+103/−77 lines, 2 filesdep +aesondep +containersdep +eitherdep −http-typesdep −scottyPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, containers, either, lucid, servant, servant-lucid, servant-server, warp

Dependencies removed: http-types, scotty

API changes (from Hackage documentation)

Files

• QuickWebApp.hs +92/−72
• quickwebapp.cabal +11/−5

@@ -1,88 +1,108 @@-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-| A quick-and-dirty api generator, for any function `a -> b` which can be wrapped-    inside a function `ByteString -> ByteString`.-    It is inspired from the 'interact' function from 'Prelude'.+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeOperators         #-}++{-| A quick-and-dirty api generator, for any function @a -> "Either" "String" b@.+ +If you only have a function @f :: a -> b@, simply run @interactWeb ("Right" .f)@ -}-module QuickWebApp where+module QuickWebApp (+    interactWeb+  ) where -import qualified Data.ByteString            as BS-import qualified Data.ByteString.Lazy       as BL-import qualified Data.ByteString.Lazy.Char8 as BC-import qualified Data.Text                  as TS-import qualified Data.Text.Lazy             as TL-import qualified Data.Text.Lazy.Encoding    as TL-import           Network.HTTP.Types.Status-import           Web.Scotty+import           Control.Monad.Trans.Either+import           Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BL8+import           Data.Either.Combinators+import qualified Data.Map                   as M+import           Data.Text                  (Text)+import           Data.Text.Lazy.Encoding    (decodeUtf8)+import           GHC.Generics+import           Network.Wai.Handler.Warp+import           System.Environment --- | Represents types which can be converted to a Lazy 'ByteString'-class ToLBS a where-    toLBS :: a -> BL.ByteString+import           Lucid+import           Servant+import           Servant.HTML.Lucid -instance ToLBS BL.ByteString where-    toLBS = id+type API = Get '[HTML] Home+       :<|> ReqBody '[JSON, FormUrlEncoded] Input :> Post '[JSON] Output -instance ToLBS BS.ByteString where-    toLBS = BL.fromStrict -instance ToLBS TL.Text where-    toLBS = TL.encodeUtf8+data Home = Home+instance ToHtml Home where+  toHtml Home = doctypehtml_ $ do+    head_ $ do+      title_ "Api powered by QuickWebApp"+      meta_ [charset_ "utf-8"]+      link_ [rel_ "stylesheet", type_ "text/css",  href_ "http://groundfloor.neocities.org/default.css"]+    body_ $ do+      header_ $ do+        h1_ "interactWeb :: (a -> Either String b) -> IO ()"+        p_ $ do+          "Powered by "+          a_ [href_ "http://hackage.haskell.org/package/servant"] "servant"+          " and "+          a_ [href_ "http://hackage.haskell.org/package/lucid"] "lucid"+      div_ [ style_ "width: 80%; margin: auto;"] $ do+        div_ [style_ "display: flex; flex-direction: row; align-items: flex-stretch"] $ do+          section_ [style_ "flex: 1 1 50%;",  class_ "input"] $ do+            h2_ "Try out your function here"+            form_ [action_ "/" , method_ "POST"] $ do+              textarea_ [ name_ "input" ] ""+              input_ [type_ "submit" , value_ "Test"]+          section_ [style_ "flex: 1 1 50%", class_ "output"] $ do+            h2_ "Results here"+            pre_ $ samp_ [id_ "output"] ""+        h2_ "You can also curl or httpie"+        kbd_ "http :8080 input=\"<your input string>\""+        kbd_ "curl localhost:8080 -d input=\"<your input string>\""+        h2_ "Where to go from here ?"+        p_ $ do+          "TODO: This is where I show you the boilerplate to kickstart \+          \ your api, but I've not done that yet. "+          a_ [href_ "http://github.com/jtanguy/quickwebapp/issues/2"] "Corresponding github issue"+        term "script" [src_ "//code.jquery.com/jquery-1.11.3.min.js"] ""+      script_ "$(function(){ \+        \ $('form').submit(function(){ \+        \    $.post($(this).attr('action'), $(this).serialize(), function(json) { \+        \         $('#output').html(json.output);\+        \             }, 'json');\+        \                 return false;\+        \                   });\+        \                   });"+  toHtmlRaw = toHtml -instance ToLBS TS.Text where-    toLBS = TL.encodeUtf8 . TL.fromStrict -instance ToLBS String where-    toLBS = BC.pack---- | Represents types which can be converted from a Lazy 'ByteString'--- This is intended for other String-like types-class FromLBS a where-    fromLBS :: BL.ByteString -> a--instance FromLBS BL.ByteString where-    fromLBS = id--instance FromLBS BS.ByteString where-    fromLBS = BL.toStrict--instance FromLBS TL.Text where-    fromLBS = TL.decodeUtf8+newtype Input = Input { input :: Text } deriving (Show, Eq, Generic) -instance FromLBS TS.Text where-    fromLBS = TL.toStrict . TL.decodeUtf8+instance FromJSON Input+instance FromFormUrlEncoded Input where+  fromFormUrlEncoded = eitherDecode . encode . M.fromList -instance FromLBS String where-    fromLBS = BC.unpack+newtype Output = Output { output :: Text } deriving (Show, Eq, Generic)+instance ToJSON Output --- | Unprocessable entity error code (temporary fix for a missing status in--- http-types)-err422 :: Status-err422 = mkStatus 422 "Unprocessable Entity"+{-| Tranform a function into a webapp.+The inputs and outputs must implement 'FromText' and 'ToText', respectively. --- | Equivalent to 'interactWebOn 3000'-interactWeb :: (FromLBS a, ToLBS b) => (a -> b) -> IO ()-interactWeb = interactWebOn 3000+You can query it via a browser at <http://localhost:8080> or by using+curl/httpie --- | Equivalent to 'interactWebEitherOn 3000'-interactWebEither :: (FromLBS a, ToLBS b, ToLBS e) => (a -> Either e b) -> IO ()-interactWebEither = interactWebEitherOn 3000+  > http :8080 input="<your input string>" --- | Create an API with a 'POST' endpoint-interactWebOn :: (FromLBS a, ToLBS b) => Int -> (a -> b) -> IO ()-interactWebOn port f = scotty port $ post "/" $ do-                c <- body-                setHeader "Content-Type" "text/plain"-                raw . toLBS . f . fromLBS $ c+  > curl localhost:8080 -d input="<your input string>"+-}+interactWeb :: (FromText a, ToText b) => (a -> Either String b) -> IO ()+interactWeb f = do+    port <- maybe 8080 read <$> lookupEnv "PORT"+    run port (serve (Proxy :: Proxy API) (return Home :<|> handler))+  where+    handler = maybe (left $ err "Could not convert from text")+                    (hoistEither . mapBoth err (Output . toText) . f) . fromText . input --- | Create an API with a 'POST' endpoint--- If the function fails and returns a 'Left' value, return a 422 response with--- the error in the body-interactWebEitherOn :: (FromLBS a, ToLBS b, ToLBS e) => Int -> (a -> Either e b) -> IO ()-interactWebEitherOn port f = scotty port $ post "/" $ do-                c <- body-                setHeader "Content-Type" "text/plain"-                case f . fromLBS $ c of-                    Right res -> raw . toLBS $ res-                    Left err -> status err422 >> (raw . toLBS $ err)+err :: String -> ServantErr+err e = ServantErr 422 "Unprocessable Entity" (BL8.pack (show e)) [] 

@@ -1,5 +1,5 @@ name:                quickwebapp-version:             2.1.1.0+version:             3.0.0.1 synopsis:            A quick webapp generator for any file processing tool description:     A quick-and-dirty api generator, inspired from the 'interact' function from@@ -7,7 +7,7 @@     .     > interactWeb reverse      .-    This creates a server listening on port 3000.+    This creates a server listening on port 8080, or environment value PORT.     . license:             GPL-3 license-file:        LICENSE@@ -29,9 +29,15 @@ library   exposed-modules:     QuickWebApp   build-depends:       base ==4.*,+                       containers,                        bytestring,                        text,-                       http-types,-                       scotty-  -- hs-source-dirs:      src+                       aeson,+                       either,+                       servant,+                       servant-server,+                       servant-lucid,+                       lucid,+                       warp+   default-language:    Haskell2010