rate limiting output to generic printer

1 files changed, 10 insertions, 1 deletions

diff --git a/server/src/Thermoprint/Server/Printer/Generic.hs b/server/src/Thermoprint/Server/Printer/Generic.hs
index 2c88b55..2945dd0 100644
--- a/server/src/Thermoprint/Server/Printer/Generic.hs
+++ b/server/src/Thermoprint/Server/Printer/Generic.hs
@@ -52,6 +52,8 @@ import Data.Monoid
 
 import Data.Int (Int64)
 
+import Control.Concurrent (threadDelay)
+
 import Prelude hiding (mapM_, sequence_, lines)
 
 genericPrint :: FilePath -> PrinterMethod
@@ -65,10 +67,17 @@ genericPrint' path = flip catches handlers . withFile path . print
                , Handler $ return . Just . EncError
                , Handler $ return . Just
                ]
-    print printout handle = $(logDebug) (T.pack $ show printout') >> liftIO (LBS.hPutStr handle printout' >> return Nothing)
+    print printout handle = $(logDebug) (T.pack $ show printout') >> liftIO (slowPut handle printout' >> return Nothing)
       where
         printout' = runPut $ initialize >> render printout >> finalize
 
+slowPut :: Handle -> Lazy.ByteString -> IO ()
+slowPut h = slowPut' . LBS.split (LBS.last newl)
+  where
+    slowPut' []     = return ()
+    slowPut' [t]    = LBS.hPutStr h t
+    slowPut' (x:xs) = slowPut' [x] >> LBS.hPutStr h (LBS.singleton $ LBS.last newl) >> threadDelay (50 * 10^3) >> slowPut' xs
+
 encode' :: ByteSink m => String -> m ()
 encode' = encode CP437