Revert "Broken existentially quantified printer config"

This reverts commit 6434397a3d103547b563ada27fd64c38cb05e1f0.

3 files changed, 10 insertions, 82 deletions

diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index 4e8d962..39bf0a1 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -3,11 +3,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE ViewPatterns      #-}
 
 module Thermoprint.Server
        ( thermoprintServer
-       , Config(..), withPrinters
+       , Config(..)
        , module Data.Default.Class
        , module Servant.Server.Internal.Enter
        , module Thermoprint.Server.Printer
@@ -20,8 +19,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 
 import Data.Maybe (maybe)
-import Data.Foldable (mapM_, forM_, foldlM)
-import Data.Monoid
+import Data.Foldable (mapM_, forM_)
 
 import Control.Monad.Trans.Resource
 import Control.Monad.Trans.Control
@@ -29,8 +27,6 @@ import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Monad.IO.Class
 
-import Control.Monad.Writer
-
 import Control.Concurrent
        
 import Data.Text (Text)
@@ -66,9 +62,9 @@ instance Default Config where
 
 
 thermoprintServer :: ( MonadLoggerIO m
-                     , MonadReader ConnectionPool m
-                     , MonadResource m
+                     , MonadIO m
                      , MonadBaseControl IO m
+                     , MonadReader ConnectionPool m
                      ) => (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify the rest of it. Therefore we require a specification of how to enter the stack.
                      -> Config -> IO ()
 -- ^ Run the server
@@ -83,12 +79,3 @@ thermoprintServer io = Dyre.wrapMain $ Dyre.defaultParams
         mapM_ ($(logWarnS) "DB") =<< runSqlPool (runMigrationSilent migrateAll) =<< ask
         forM_ printers $ liftBaseDiscard forkIO . runPrinter
         liftIO . Warp.runSettings warpSettings . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers
-
-withPrinters :: MonadResource m => Config -> [PrinterSpec] -> m Config
--- ^ Helper for comfortably specifying a set of 'Printer's
-withPrinters cfg = fmap (\ps -> cfg { printers = printers cfg <> ps }) . foldlM (\ps p -> Map.insert (nextKey ps) <$> printer p <*> pure ps) Map.empty
-  where
-    nextKey :: Map PrinterId a -> PrinterId
-    nextKey (Map.keys -> keys)
-      | null keys = 0
-      | otherwise = succ $ maximum keys
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs
index cd12297..f34b2fa 100644
--- a/server/src/Thermoprint/Server/Printer.hs
+++ b/server/src/Thermoprint/Server/Printer.hs
@@ -1,18 +1,14 @@
 {-# LANGUAGE RankNTypes                    #-}
-{-# LANGUAGE ImpredicativeTypes            #-}
 {-# LANGUAGE MultiParamTypeClasses         #-}
 {-# LANGUAGE FlexibleContexts              #-}
 {-# LANGUAGE RecordWildCards               #-}
 {-# LANGUAGE OverloadedStrings             #-}
 {-# LANGUAGE TemplateHaskell               #-}
 {-# LANGUAGE StandaloneDeriving            #-}
-{-# LANGUAGE ExistentialQuantification     #-}
-{-# LANGUAGE RecordWildCards               #-}
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 
 module Thermoprint.Server.Printer
        ( Printer(..), printer
-       , IsPrinter(..), PrinterSpec(..)
        , Queue(..)
        , runPrinter
        ) where
@@ -45,23 +41,8 @@ import Control.Monad (forever)
 
 import Control.Concurrent.STM
 
-import Data.Default.Class
-
-import Prelude hiding (print)
-
-class IsPrinter a where
-  toMethod :: forall m. (MonadResource m) => a -> (forall m1. (MonadResource m1) => m (Printout -> m1 (Maybe PrintingError)))
-
-instance (MonadResource m) => IsPrinter (Printer m) where
-  toMethod Printer{..} = return print
-
-instance (MonadResource m) => IsPrinter (PrinterSpec m) where
-  toMethod (PS p) = toMethod p
-
-data PrinterSpec m = forall p. IsPrinter p => PS p 
-
-data Printer m = Printer
-  { print :: Printout -> m (Maybe PrintingError)
+data Printer = Printer
+  { print :: forall m. (MonadIO m) => Printout -> m (Maybe PrintingError)
   , queue :: TVar Queue
   }
 
@@ -73,25 +54,17 @@ data Queue = Queue
   }
   deriving (Typeable, Generic, NFData)
 
-instance Default Queue where
-  def = Queue
-    { pending = Seq.empty
-    , current = Nothing
-    , history = Seq.empty
-    }
-
-printer :: (MonadResource m, MonadResource m1, IsPrinter p) => p -> m (Printer m1)
--- ^ Version of 'Printer' handling the initialisation of the 'TVar'
-printer p = Printer <$> toMethod p <*> liftIO (newTVarIO def)
+printer :: (MonadIO m) => (forall m. (MonadIO m) => Printout -> m (Maybe PrintingError)) -> m Printer
+printer f = Printer f <$> liftIO (newTVarIO $ Queue Seq.empty Nothing Seq.empty)
 
 atomically' :: MonadIO m => STM a -> m a
 atomically' = liftIO . atomically
 
 runPrinter :: ( MonadReader ConnectionPool m
+              , MonadIO m
               , MonadLogger m
-              , MonadResource m
               , MonadBaseControl IO m
-              ) => Printer m -> m ()
+              ) => Printer -> m ()
 -- ^ Loop 'forever' pushing entries from the 'Queue' associated to a 'Printer' into its 'print'-method
 runPrinter Printer{..} = forever $ do
   jobId <- atomically' $ do
diff --git a/server/src/Thermoprint/Server/Printer/Debug.hs b/server/src/Thermoprint/Server/Printer/Debug.hs
deleted file mode 100644
index 81e43a3..0000000
--- a/server/src/Thermoprint/Server/Printer/Debug.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE EmptyDataDecls    #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
-
-module Thermoprint.Server.Printer.Debug
-       ( Debug
-       ) where
-
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Resource
-
-import Data.Text.Lazy (Text)
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.IO as TL
-
-import Thermoprint.Printout
-import Thermoprint.Server.Printer
-
-import Data.List (intersperse)
-import Data.Foldable (toList)
-import Data.Monoid
-
-data Debug
-
--- instance IsPrinter Debug where
---   toMethod _ = (>> return Nothing) . liftIO . TL.putStrLn . cotext'
-
--- cotext' :: Printout -> Text
--- cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList) . toList
---   where
---     cotext'' (Cooked b) = cotext b
---     cotext'' (Raw _)    = "[Raw]"