From e65e1eaac335a4738abb9e8ee8da7a229f96c2c0 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 17 Oct 2015 21:23:45 +0200 Subject: Drafts --- tprint/src/Main.hs | 222 +++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 181 insertions(+), 41 deletions(-) (limited to 'tprint/src') diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index 565295b..0f88a86 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs @@ -1,72 +1,178 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, RankNTypes #-} import Thermoprint import Thermoprint.Api -import qualified BBCode (parse) +import qualified BBCode (parse, make) import Options.Applicative import Data.Either +import Data.Maybe import Control.Monad import Control.Monad.Trans.Either import System.IO +import qualified System.IO as IO import System.Exit +import System.Environment import Data.Proxy +import Servant.API import Servant.Client +import Data.Int (Int64) + thermoprintApi :: Proxy ThermoprintApi thermoprintApi = Proxy -data Options = Options - { baseUrl :: BaseUrl - , printerId :: Integer - , dryRun :: Bool - } - -options :: Parser Options -options = Options - <$> option baseUrlReader ( - long "url" - <> short 'u' - <> metavar "URL" - <> help "The base url of the api" - <> value (BaseUrl Http "localhost" 8080) - <> showDefaultWith showBaseUrl - ) - <*> option auto ( - long "printer" - <> short 'p' - <> metavar "INT" - <> help "The number of the printer to use" - <> value 0 - <> showDefault - ) - <*> flag False True ( - long "dry-run" - <> short 'd' - <> help "Instead of sending data to printer output the parsed stream to stderr" - <> showDefault - ) - where - baseUrlReader = str >>= either readerError return . parseBaseUrl +data TPrint = TPrint TPrintMode TPrintOptions + +data TPrintOptions = TPrintOptions + { baseUrl :: BaseUrl + } + +data TPrintMode = Print PrintOptions + | PrintDraft PrintDraftOptions + | Query QueryOptions + | Add AddOptions + | Get GetOptions + | Write WriteOptions + | Del DelOptions + +data PrintOptions = PrintOptions + { printerId :: Integer + , dryRun :: Bool + } + +data PrintDraftOptions = PrintDraftOptions + { printOptions :: PrintOptions + , pDraftId :: Int64 + , deleteAfter :: Bool + } + +data QueryOptions = QueryOptions + +data AddOptions = AddOptions + { title :: String + } + +data GetOptions = GetOptions + { gDraftId :: Int64 + , getTitle :: Bool + } + +data WriteOptions = WriteOptions + { wDraftId :: Int64 + , newTitle :: Maybe String + } + +data DelOptions = DelOptions + { dDraftId :: Int64 + } + main :: IO () -main = execParser opts >>= main' +main = do + envUrl <- lookupEnv "TPRINT" + let + defaultUrl = fromMaybe (BaseUrl Http "localhost" 8080) (envUrl >>= either (const Nothing) Just . parseBaseUrl) + execParser (opts defaultUrl) >>= main' where - opts = info (helper <*> options) ( + opts url = info (helper <*> opts' url) ( fullDesc <> header "tprint - A cli tool for interfacing with the REST api as provided by thermoprint-servant" ) + opts' url = TPrint + <$> modeSwitch + <*> commonOpts url + commonOpts url = TPrintOptions + <$> option baseUrlReader ( + long "url" + <> short 'u' + <> metavar "URL" + <> help "The base url of the api. Also reads TPRINT from environment." + <> value url + <> showDefaultWith showBaseUrl + ) + baseUrlReader = str >>= either readerError return . parseBaseUrl + modeSwitch = subparser $ mconcat $ map (\(n, f, h) -> command n $ info (helper <*> f) $ progDesc h) + [ ("print", print, "Read bbcode from stdin and send it to be printed") + , ("print-draft", printD, "Send a draft to be printed") + , ("query", query, "List drafts") + , ("add", add, "Read bbcode from stdin and add it as a draft") + , ("get", get, "Get a draft and print it as bbcode to stdout") + , ("write", write, "Read bbcode from stdin and overwrite an existing draft") + , ("del", del, "Delete a draft") + ] + draftN s = option auto ( + long "draft" + <> short 'n' + <> metavar "INT" + <> help s + ) + print = Print <$> print' + print' = PrintOptions + <$> option auto ( + long "printer" + <> short 'p' + <> metavar "INT" + <> help "The number of the printer to use" + <> value 0 + <> showDefault + ) + <*> flag False True ( + long "dry-run" + <> short 'd' + <> help "Instead of sending data to printer output the parsed stream to stderr" + <> showDefault + ) + printD = (PrintDraft <$>) $ PrintDraftOptions + <$> print' + <*> draftN "The number of the draft to print" + <*> flag False True ( + long "delete" + <> help "Delete the draft after printing" + ) + query = (Query <$>) $ pure QueryOptions + add = (Add <$>) $ AddOptions + <$> strArgument ( + metavar "TITLE" + <> help "The human readable title for the new draft" + ) + get = (Get <$>) $ GetOptions + <$> draftN "The number of the draft to retrieve" + <*> flag False True ( + long "title" + <> short 't' + <> help "Get title instead of content" + ) + write = (Write <$>) $ WriteOptions + <$> draftN "The number of the draft to overwrite" + <*> optional ( strArgument ( + metavar "TITLE" + <> help "The human readable title for the updated draft (defaults to retrieving the old one before overwriting)" + ) + ) + del = (Del <$>) $ DelOptions + <$> draftN "The number of the draft to delete" + +either' :: (a -> String) -> EitherT a IO b -> IO b +either' f a = either (die . f) return =<< runEitherT a - main' Options{..} = do - let - print :: Integer -> Block String -> EitherT ServantError IO () - print = client thermoprintApi baseUrl +main' (TPrint mode TPrintOptions{..}) = do + let + -- print :: Integer -> Block String -> EitherT ServantError IO () + -- queryDrafts :: EitherT ServantError IO [(Integer, String)] + -- addDraft :: (String, Block String) -> EitherT ServantError IO Int64 + -- getDraft :: Int64 -> EitherT ServantError IO (String, Block String) + -- writeDraft :: Int64 -> (String, Block String) -> EitherT ServantError IO Int64 + -- delDraft :: Int64 -> EitherT ServantError IO () + (print :<|> queryDrafts :<|> addDraft :<|> getDraft :<|> writeDraft :<|> delDraft) = client thermoprintApi baseUrl + case mode of + Print PrintOptions{..} -> do input <- BBCode.parse `liftM` getContents - input' <- either (\err -> hPutStrLn stderr ("Parse error: " ++ err) >> exitFailure) return input + input' <- either (die . ("Parse error: " ++)) return input case dryRun of False -> do res <- runEitherT $ print printerId input' @@ -75,3 +181,37 @@ main = execParser opts >>= main' Right _ -> exitSuccess True -> do hPutStrLn stderr $ show input' + PrintDraft PrintDraftOptions{..} -> do + let PrintOptions{..} = printOptions + (_, input) <- either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft pDraftId + case dryRun of + False -> do + res <- runEitherT $ print printerId input + case res of + Left err -> hPutStrLn stderr $ show err + Right _ -> when deleteAfter $ either' (\e -> "Error while deleting draft: " ++ show e) $ delDraft pDraftId + True -> do + hPutStrLn stderr $ show input + Query QueryOptions -> do + drafts <- either' (\e -> "Error while retrieving drafts: " ++ show e) queryDrafts + mapM_ (\(n, t) -> putStrLn $ "[" ++ show n ++ "]\n" ++ (unlines $ map (\s -> " " ++ s) $ lines t)) drafts + when (null drafts) $ hPutStrLn stderr "No drafts" + Add AddOptions{..} -> do + input <- BBCode.parse `liftM` getContents + input' <- either (die . ("Parse error: " ++)) return input + n <- either' (\e -> "Error while saving draft: " ++ show e) $ addDraft (title, input') + IO.print n + Get GetOptions{..} -> do + (title, draft) <- either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft gDraftId + case getTitle of + False -> putStr $ BBCode.make draft + True -> putStrLn title + Write WriteOptions{..} -> do + input <- BBCode.parse `liftM` getContents + input' <- either (die . ("Parse error: " ++)) return input + title <- case newTitle of + Just new -> return new + Nothing -> fst <$> (either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft wDraftId) + either' (\e -> "Error while overwriting draft: " ++ show e) $ writeDraft wDraftId (title, input') + Del DelOptions{..} -> either' (\e -> "Error while deleting draft: " ++ show e) $ delDraft dDraftId + _ -> undefined -- cgit v1.2.3