{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} import Data.Map (Map) import qualified Data.Map as Map import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as LCBS import Data.Time import Data.Foldable import Data.List import Data.Monoid import Data.Maybe import Data.Either import Control.Monad import Control.Monad.Catch import Text.Show.Pretty (dumpStr) import Data.Aeson.Encode.Pretty (encodePretty) import System.IO import Thermoprint.Printout.BBCode import Thermoprint.Client import Options import Debug.Trace main :: IO () main = withArgs (main' <=< dumpOpts) where dumpOpts c@(TPrint{..}) = c <$ when (dumpOptions) (hPutStrLn stderr $ dumpStr c) main' config@(TPrint{..}) = withOutput config $ tprint config (mkClient' baseUrl) withOutput :: TPrint -> (Handle -> IO a) -> IO a withOutput TPrint{..} | (_, WriteFile f) <- output = withFile f WriteMode | otherwise = ($ stdout) withInput :: Input -> (Handle -> IO a) -> IO a withInput (_, Stdin) = ($ stdin) withInput (_, ReadFile f) = withFile f ReadMode humanJobStatus :: JobStatus -> Maybe PrinterId -> String humanJobStatus (Queued (PrinterId n)) Nothing = "queued at printer #" ++ show n humanJobStatus (Queued _) _ = "queued" humanJobStatus (Printing (PrinterId n)) Nothing = "printing on printer #" ++ show n humanJobStatus (Printing _) _ = "printing" humanJobStatus (Done) _ = "finished successfully" humanJobStatus (Failed err) _ = "failed: " ++ show err tprint :: TPrint -> Client IO -> Handle -> IO () tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format where format ps | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps | (JSON , _) <- output = LCBS.hPutStrLn out $ encodePretty ps | otherwise = hPutStrLn out . dumpStr $ Map.toAscList ps humanStatus (Busy (JobId n)) = "busy printing job #" ++ show n humanStatus (Available) = "available" tprint TPrint{ operation = Jobs{..}, ..} Client{..} out = jobs printer jobRange timeRange >>= format where format js | (Human, _) <- output = mapM_ (\((JobId n), created, status) -> hPutStrLn out $ show n ++ "\t" ++ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" created ++ "\t" ++ humanJobStatus status printer) . sortBy jSort $ toList js | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty js | otherwise = hPutStrLn out . dumpStr $ toList js jSort (id, time, status) (id', time', status') = queueSort status status' <> compare time' time <> compare id id' tprint TPrint{ operation = Drafts, ..} Client{..} out = drafts >>= format where format ds | (Human, _) <- output = mapM_ (\(DraftId n, fromMaybe "" . fmap T.unpack -> t) -> hPutStrLn out $ show n ++ "\t" ++ t) $ Map.toAscList ds | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty ds | otherwise = hPutStrLn out . dumpStr $ Map.toAscList ds tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format where format p | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) tprint _ _ _ = undefined