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 -> "
"
++ e
++ "
"
++ ""
Right v -> do
liftIO $ writeIORef ref (Just v)
output $ title ++ ""
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 =
""
++ "--"
++ getName names
++ "
"
++ maybe "" show (unChunk halp)
++ "
"
getName = head . sortBy (\x y -> length y `compare` length x) . map n
where
n (OptShort c) = return c
n (OptLong s) = s