bragi/thermoprint-server/thermoprint-server.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE ImpredicativeTypes #-}

module Main (main) where

import Thermoprint.Server

import Thermoprint.Server.Printer.Generic

import Control.Monad.Trans.Resource
import Control.Monad.Logger
import Control.Monad.Reader

import Database.Persist.Postgresql

type ServerM = ReaderT ConnectionPool (LoggingT IO)

main :: IO ()
main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueManagers }) <$> def `withPrinters` printers
  where
    runDb :: ServerM a -> IO a
    runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT

    printers :: [(ResourceT ServerM PrinterMethod, QMConfig (ResourceT ServerM))]
    printers = [ (pure $ genericPrint "/dev/usb/lp0", def)
               ]

    queueManagers _ = QMConfig
      { manager = union [ limitHistorySize 100
                        , limitHistoryAge 3600
                        ]
      , collapse = standardCollapse
      }