From f64e26726ce5468069093aa86fe973ad4be4816c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 26 Feb 2016 22:57:30 +0000
Subject: Split QMConfig into own module

---
 server/src/Thermoprint/Server.hs | 15 +++------------
 1 file changed, 3 insertions(+), 12 deletions(-)

(limited to 'server/src/Thermoprint/Server.hs')

diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index 446c63e..cd3a4ed 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE TypeOperators             #-}
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE ImpredicativeTypes        #-}
-{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ViewPatterns              #-}
 {-# LANGUAGE DataKinds                 #-}
 
@@ -16,6 +15,7 @@ module Thermoprint.Server
        , module Servant.Server.Internal.Enter
        , module Thermoprint.Server.Printer
        , module Thermoprint.Server.Queue
+       , module Thermoprint.Server.QMConfig
        ) where
 
 import Data.Default.Class
@@ -79,6 +79,7 @@ import Thermoprint.Server.Push
 import Thermoprint.Server.Database
 import Thermoprint.Server.Printer
 import Thermoprint.Server.Queue
+import Thermoprint.Server.QMConfig
 import qualified Thermoprint.Server.API as API (thermoprintServer)
 import Thermoprint.Server.API hiding (thermoprintServer)
 
@@ -91,14 +92,6 @@ data Config m = Config { dyreError     :: Maybe String -- ^ Set by 'Dyre' -- sen
                        , queueManagers :: API.PrinterId -> QMConfig m
                        }
 
-data QMConfig m = forall t. ( MonadTrans t
-                            , MFunctor t
-                            , Monad (t STM)
-                            , MonadIO (t IO)
-                            ) => QMConfig { manager  :: QueueManager t
-                                          , collapse :: (t IO) :~> m
-                                          }
-  
 instance MonadIO m => Default (Config m) where
   def = Config { dyreError     = Nothing
                , warpSettings  = Warp.defaultSettings
@@ -106,9 +99,6 @@ instance MonadIO m => Default (Config m) where
                , queueManagers = const def
                }
 
-instance MonadIO m => Default (QMConfig m) where
-  def = QMConfig idQM $ Nat (liftIO . runIdentityT)
-
 withPrinters :: MonadResource m => Config m -> [(m PrinterMethod, QMConfig m)] -> m (Config m)
 -- ^ Add a list of printers to a 'Config'
 withPrinters cfg = fmap updateCfg . foldlM mapInsert (Map.mapWithKey (\k a -> (a, queueManagers cfg k)) $ printers cfg)
@@ -151,6 +141,7 @@ thermoprintServer dyre io = Dyre.wrapMain $ Dyre.defaultParams
           fork tMgr $ jobGC gcChan
           let
             runQM' (queueManagers -> QMConfig qm nat) printer = unNat nat $ runQM gcChan qm printer
+            runQM' (queueManagers -> QMConfig' qm) printer = hoist liftIO $ runQM gcChan qm printer
           mapM_ (fork tMgr . uncurry runQM') $ Map.toList printers
           nChan <- liftIO $ newBroadcastTChanIO
           let
-- 
cgit v1.2.3