aboutsummaryrefslogtreecommitdiff
path: root/server/src/Thermoprint/Server/QMConfig.hs
blob: 0cf7bebbfc1d823a338251106268eaa09bc0bf90 (plain)
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
34
35
36
37
38
39
40
41
42
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeOperators      #-}

module Thermoprint.Server.QMConfig
       ( QMConfig(..)
       ) where

import Control.Monad.Trans.Resource
import Control.Monad.Trans.Control
import Control.Monad.Trans.Identity
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.IO.Class
import Control.Monad.Morph
import Control.Category
import Prelude hiding (id, (.))
import Servant.Server.Internal.Enter (enter, (:~>)(..))

import Data.Default.Class

import Control.Concurrent.STM

import Thermoprint.Server.Queue

data QMConfig m where
  QMConfig :: ( MonadTrans t
              , MFunctor t
              , Monad (t STM)
              , MonadIO (t IO)
              ) => QueueManager t -> (t IO) :~> m -> QMConfig m
  QMConfig' :: ( MonadIO m
               ) => ( forall t. ( MonadTrans t
                                , MFunctor t
                                , Monad (t STM)
                                , MonadIO (t IO)
                                ) => QueueManager t
                    ) -> QMConfig m

instance MonadIO m => Default (QMConfig m) where
  def = QMConfig idQM $ Nat (liftIO . runIdentityT)