webcloud (empty) → 0.1.0.1

raw patch · 7 files changed

+195/−0 lines, 7 filesdep +basedep +bytestringdep +cgisetup-changed

Dependencies added: base, bytestring, cgi, optparse-applicative, webcloud

Files

• LICENSE +26/−0
• README.md +12/−0
• Setup.hs +2/−0
• src/Web/Cloud.hs +79/−0
• stack.yaml +6/−0
• testcloud.hs +30/−0
• webcloud.cabal +40/−0

@@ -0,0 +1,26 @@+Copyright (c) 2014, Maxwell Swadling+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,12 @@+webcloud+========++Turn an optparse-applicative program into a CGI program!++## Usage++1. `import Web.Cloud`+2. Change `execParser` to `execParserWebCloud`+3. Done!++![Web Cloud in Action](http://i.imgur.com/d48WKKc.png)

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,79 @@+module Web.Cloud where++import Data.List+import Data.IORef+import Data.ByteString.Lazy.Char8 (pack, unpack)+import System.Environment+import Options.Applicative+import Options.Applicative.Types+import Options.Applicative.Help.Chunk+import Network.CGI+import Network.CGI.Monad+import Network.CGI.Protocol+import System.Exit++execParserWebCloud :: ParserInfo a -> IO a+execParserWebCloud pinfo = do+  ref <- newIORef Nothing+  title <- (\x -> "<title>" ++ x ++ "</title>") `fmap` getProgName+  runCGI . handleErrors $ do+    setHeader "Content-Type" "text/html; charset=utf-8" +    clouds <- cgiGet (execParserPure (prefs idm) pinfo . getCloud . cgiInputs)+    val <- mkWebCloud clouds+    case val of+      Left e -> do+        output $ title+                 ++ "<code><pre>"+                 ++ e+                 ++ "</code></pre>"+                 ++ "<form action=\"\" method=\"get\">" ++ form (infoParser pinfo) ++ "<input type=submit></form>"+      Right v -> do+        liftIO $ writeIORef ref (Just v)+        output $ title ++ "<code><pre>"+  r <- readIORef ref+  case r of+    Just v -> return v+    Nothing -> exitWith ExitSuccess -- it's ok to error! :)++-- getCloud :: [(String, Input)]+getCloud =+  flip (>>=) $ \(k, v) ->+    if unpack (inputValue v) == ""+      then []+      else if unpack (inputValue v) == "on"+        then ["--" ++ k]+        else ["--" ++ k, show (inputValue v)]++mkWebCloud :: Monad m => ParserResult a -> m (Either String a)+mkWebCloud (Success a) = return (Right a)+mkWebCloud (Failure failure) = return (Left (fst (renderFailure failure "cloud")))+mkWebCloud (CompletionInvoked _) = return (Left "not web")++form :: Parser a -> String+form (NilP _) = ""+form (OptP opt) = formatOpt (optProps opt) (optMain opt)+form (MultP pf pa) = form pf ++ form pa+form (AltP pa pb) = form pa ++ form pb+form (BindP px pf) = form px -- TODO: bind... ++ form pf++formatOpt (OptProperties vis halp metavar def) (OptReader names _ _) =+  fmt metavar halp names (getName names == "help")+formatOpt (OptProperties vis halp metavar def) (FlagReader names _) =+  fmt metavar halp names True+formatOpt (OptProperties vis halp metavar def) (ArgReader _) =+  "TODO"+formatOpt (OptProperties vis halp metavar def) (CmdReader cmd _) =+  "TODO"++fmt metavar halp names isFlag =+     "<p>"+  ++ "<strong>--"+  ++ getName names+  ++ "</strong><br/>"+  ++ maybe "" show (unChunk halp)+  ++ "<br/><input type=\"" ++ (if isFlag then "checkbox" else "text") ++ "\" name=\"" ++ getName names ++ "\" placeholder=\"" ++ metavar ++ "\"></input><br/></p>"++getName = head . sortBy (\x y -> length y `compare` length x) . map n+   where+     n (OptShort c) = return c+     n (OptLong s) = s

@@ -0,0 +1,6 @@+resolver: lts-5.15+packages:+- '.'+extra-deps: []+flags: {}+extra-package-dbs: []

@@ -0,0 +1,30 @@+module Main where++import Options.Applicative+import Web.Cloud++data Sample = Sample+  { hello :: String+  , quiet :: Bool }++sample :: Parser Sample+sample = Sample+  <$> strOption+      ( long "hello"+     <> metavar "TARGET"+     <> help "Target for the greeting" )+  <*> switch+      ( long "quiet"+     <> help "Whether to be quiet" )++greet :: Sample -> IO ()+greet (Sample h False) = putStrLn $ "Hello, " ++ h+greet _ = return ()++main :: IO ()+main = execParserWebCloud opts >>= greet+  where+    opts = info (helper <*> sample)+      ( fullDesc+     <> progDesc "Print a greeting for TARGET"+     <> header "hello - a test for optparse-applicative" )

@@ -0,0 +1,40 @@+name:                webcloud+version:             0.1.0.1+synopsis:            Turn an optparse-applicative program into a CGI program!+description:         Automatically generate a web interface for your existing+                     optparse-applicative command line applications.+license:             BSD2+license-file:        LICENSE+author:              Maxwell Swadling+maintainer:          maxwellswadling@gmail.com+-- copyright:           +category:            Web+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:  README.md+                   , stack.yaml++source-repository HEAD+  type: git+  location: https://github.com/mxswd/webcloud/++library+  exposed-modules:     Web.Cloud+  -- other-modules:       +  -- other-extensions:    +  ghc-options:         -Wall+  build-depends:       base >=4.7 && <5+                     , optparse-applicative >=0.10 && <0.13+                     , cgi >=3001.2 && <3001.3+                     , bytestring >=0.10 && <0.11+  hs-source-dirs:      src+  default-language:    Haskell2010++executable testcloud+  main-is:             testcloud.hs+  ghc-options:         -Wall+  build-depends:       base+                     , optparse-applicative+                     , webcloud+  default-language:    Haskell2010+