1 files changed, 13 insertions, 3 deletions

diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index 0d96de0..39bf0a1 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -9,19 +9,25 @@ module Thermoprint.Server
        , Config(..)
        , module Data.Default.Class
        , module Servant.Server.Internal.Enter
+       , module Thermoprint.Server.Printer
        ) where
 
 import Data.Default.Class
 import qualified Config.Dyre as Dyre
 
-import Control.Monad (mapM_)
+import Data.Map (Map)
+import qualified Data.Map as Map
 
 import Data.Maybe (maybe)
+import Data.Foldable (mapM_, forM_)
 
 import Control.Monad.Trans.Resource
+import Control.Monad.Trans.Control
 import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Monad.IO.Class
+
+import Control.Concurrent
        
 import Data.Text (Text)
 import qualified Data.Text as T (pack)
@@ -35,20 +41,23 @@ import Servant.Server.Internal.Enter (enter, (:~>)(..))
 import Database.Persist.Sql (runMigrationSilent, ConnectionPool, runSqlPool)
 
 
-import Thermoprint.API (thermoprintAPI)
+import Thermoprint.API (thermoprintAPI, PrinterId)
 
 import Thermoprint.Server.Database
+import Thermoprint.Server.Printer
 import qualified Thermoprint.Server.API as API (thermoprintServer)
 import Thermoprint.Server.API hiding (thermoprintServer)
 
 -- | Compile-time configuration for 'thermoprintServer'
 data Config = Config { dyreError    :: Maybe String -- ^ Set by 'Dyre' -- sent to log as an error
                      , warpSettings :: Warp.Settings -- ^ Configure 'Warp's behaviour
+                     , printers     :: Map PrinterId Printer
                      }
 
 instance Default Config where
   def = Config { dyreError    = Nothing
                , warpSettings = Warp.defaultSettings
+               , printers     = Map.empty
                }
 
 
@@ -68,4 +77,5 @@ thermoprintServer io = Dyre.wrapMain $ Dyre.defaultParams
       realMain Config{..} = unNat io $ do
         maybe (return ()) ($(logErrorS) "Dyre" . T.pack) dyreError
         mapM_ ($(logWarnS) "DB") =<< runSqlPool (runMigrationSilent migrateAll) =<< ask
-        liftIO . Warp.runSettings warpSettings . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat
+        forM_ printers $ liftBaseDiscard forkIO . runPrinter
+        liftIO . Warp.runSettings warpSettings . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers