delayed debugging printer

3 files changed, 18 insertions, 0 deletions

diff --git a/server/default-conf/Main.hs b/server/default-conf/Main.hs
index cbfc476..f0b7f43 100644
--- a/server/default-conf/Main.hs
+++ b/server/default-conf/Main.hs
@@ -20,4 +20,5 @@ main = thermoprintServer True (Nat runSqlite) $ def `withPrinters` printers
     runSqlite = runStderrLoggingT . withSqlitePool "thermoprint.sqlite" 1 . runReaderT
 
     printers = [ (pure debugPrint, def)
+               , (pure $ delayedDebugPrint (10 * 10^6), def)
                ]
diff --git a/server/src/Thermoprint/Server/Printer/Debug/Delayed.hs b/server/src/Thermoprint/Server/Printer/Debug/Delayed.hs
new file mode 100644
index 0000000..c002d43
--- /dev/null
+++ b/server/src/Thermoprint/Server/Printer/Debug/Delayed.hs
@@ -0,0 +1,16 @@
+-- | A printer which blocks for a certain time and writes to log
+module Thermoprint.Server.Printer.Debug.Delayed
+       ( delayedDebugPrint
+       ) where
+
+import Control.Monad.IO.Class
+import Control.Applicative
+
+import Control.Concurrent (threadDelay)
+
+import Thermoprint.Server.Printer
+import Thermoprint.Server.Printer.Debug
+
+delayedDebugPrint :: Int -> PrinterMethod
+-- ^ Wait the given number of microseconds before invoking 'debugPrint'
+delayedDebugPrint wait = PM $ \po -> let (PM debugPrint') = debugPrint in liftIO (threadDelay wait) *> debugPrint' po
diff --git a/server/thermoprint-server.cabal b/server/thermoprint-server.cabal
index bc3650b..f98cac1 100644
--- a/server/thermoprint-server.cabal
+++ b/server/thermoprint-server.cabal
@@ -25,6 +25,7 @@ library
                      , Thermoprint.Server.Queue
                      , Thermoprint.Server.Printer
                      , Thermoprint.Server.Printer.Debug
+                     , Thermoprint.Server.Printer.Debug.Delayed
                      , Thermoprint.Server.Printer.Generic
   other-modules:       Thermoprint.Server.Database.Instances
                      , Paths_thermoprint_server