From 9d9bad89241bfa14255361dd8452ad40291a9684 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Mon, 25 Jan 2016 13:25:18 +0000
Subject: Cleaned up printer declaration

---
 server/src/Thermoprint/Server.hs               |  2 +-
 server/src/Thermoprint/Server/Printer.hs       | 20 ++++----------------
 server/src/Thermoprint/Server/Printer/Debug.hs | 14 +++-----------
 3 files changed, 8 insertions(+), 28 deletions(-)

(limited to 'server/src')

diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index ed20983..3d0e97e 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -84,7 +84,7 @@ thermoprintServer io = Dyre.wrapMain $ Dyre.defaultParams
         forM_ printers $ resourceForkIO . runPrinter
         liftIO . Warp.runSettings warpSettings . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers
 
-withPrinters :: MonadResource m => Config -> [PrinterSpec m] -> m Config
+withPrinters :: MonadResource m => Config -> [m PrinterMethod] -> m Config
 withPrinters cfg pss = (\map -> cfg { printers = map }) <$> foldlM (\map spec -> Map.insert (nextKey map) <$> printer spec <*> pure map) Map.empty pss
   where
     nextKey map
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs
index 46b8a53..5b1b7b0 100644
--- a/server/src/Thermoprint/Server/Printer.hs
+++ b/server/src/Thermoprint/Server/Printer.hs
@@ -1,7 +1,4 @@
 {-# LANGUAGE RankNTypes                    #-}
-{-# LANGUAGE TypeSynonymInstances          #-}
-{-# LANGUAGE MultiParamTypeClasses         #-}
-{-# LANGUAGE FlexibleInstances             #-}
 {-# LANGUAGE FlexibleContexts              #-}
 {-# LANGUAGE RecordWildCards               #-}
 {-# LANGUAGE OverloadedStrings             #-}
@@ -12,7 +9,8 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 
 module Thermoprint.Server.Printer
-       ( PrinterMethod(..), PrinterSpec(..), IsPrinter(..), Printer(..), printer
+       ( PrinterMethod(..), Printer(..)
+       , printer
        , Queue(..)
        , runPrinter
        , addToQueue
@@ -48,16 +46,6 @@ import Control.Monad (forever)
 import Control.Concurrent.STM
 
 newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) }
-data PrinterSpec m = forall p. IsPrinter p m => PS p
-
-class IsPrinter p m where
-  printMethod :: p -> m PrinterMethod
-
-instance Applicative m => IsPrinter PrinterMethod m where
-  printMethod = pure
-
-instance IsPrinter (PrinterSpec m) m where
-  printMethod (PS p) = printMethod p
 
 data Printer = Printer
   { print :: PrinterMethod
@@ -79,8 +67,8 @@ instance Default Queue where
     , history = Seq.empty
     }
 
-printer :: (MonadResource m, IsPrinter p m) => p -> m Printer
-printer spec = Printer <$> printMethod spec <*> liftIO (newTVarIO def)
+printer :: MonadResource m => m PrinterMethod -> m Printer
+printer p = Printer <$> p <*> liftIO (newTVarIO def)
 
 atomically' :: MonadIO m => STM a -> m a
 atomically' = liftIO . atomically
diff --git a/server/src/Thermoprint/Server/Printer/Debug.hs b/server/src/Thermoprint/Server/Printer/Debug.hs
index b8c1430..721ec84 100644
--- a/server/src/Thermoprint/Server/Printer/Debug.hs
+++ b/server/src/Thermoprint/Server/Printer/Debug.hs
@@ -1,11 +1,8 @@
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances     #-}
 
 module Thermoprint.Server.Printer.Debug
-       ( Debug(..)
+       ( debugPrint
        ) where
 
 import Control.Monad.IO.Class
@@ -24,13 +21,8 @@ import Data.List (intersperse)
 import Data.Foldable (toList)
 import Data.Monoid
 
-data Debug = Debug
-
-instance Applicative m => IsPrinter Debug m where
-  printMethod _ = printMethod debugPrinter
-
-debugPrinter :: PrinterMethod
-debugPrinter = PM $ (>> return Nothing) . $(logDebugS) "Printer.Debug" . T.pack . show . cotext' 
+debugPrint :: PrinterMethod
+debugPrint = PM $ (>> return Nothing) . $(logDebugS) "Printer.Debug" . T.pack . show . cotext' 
 
 cotext' :: Printout -> Text
 cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList) . toList
-- 
cgit v1.2.3