1 files changed, 12 insertions, 93 deletions

diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs
index d1ee6ee..419679c 100644
--- a/server/src/Thermoprint/Server.hs
+++ b/server/src/Thermoprint/Server.hs
@@ -14,47 +14,34 @@ module Thermoprint.Server
 import Data.Default.Class
 import qualified Config.Dyre as Dyre
 
-import System.IO (hPutStrLn, stderr)
-import System.Exit (exitFailure)
-
-import Control.Monad ((<=<), mapM_, liftM2)
-import Prelude hiding ((.), id)
-import Control.Category
+import Control.Monad (mapM_)
 
 import Data.Maybe (maybe)
 
+import Control.Monad.Trans.Resource
 import Control.Monad.Logger
 import Control.Monad.Reader
-import Control.Monad.Trans.Resource
-import Control.Monad.Trans.Either
 import Control.Monad.IO.Class
-
-import Data.Functor.Compose
-
-import Thermoprint.API hiding (JobId(..), DraftId(..))
-import qualified Thermoprint.API as API (JobId(..), DraftId(..))
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import Data.Map (Map)
-import qualified Data.Map as Map
-
+       
 import Data.Text (Text)
 import qualified Data.Text as T (pack)
 
 import qualified Network.Wai.Handler.Warp as Warp
 import Network.Wai (Application)
 
-import Servant
-import Servant.Server
-import Servant.Server.Internal.Enter
+import Servant.Server (serve)
+import Servant.Server.Internal.Enter (enter, (:~>)(..))
 
 import Database.Persist.Sql (runMigrationSilent, ConnectionPool, runSqlPool)
 
 
+import Thermoprint.API (thermoprintAPI)
+
 import Thermoprint.Server.Database
+import qualified Thermoprint.Server.API as API (thermoprintServer)
+import Thermoprint.Server.API hiding (thermoprintServer)
 
+  
 data Config = Config { dyreError    :: Maybe String -- ^ Set by 'Dyre' -- sent to log as an error
                      , warpSettings :: Warp.Settings -- ^ Configure 'Warp's behaviour
                      }
@@ -64,9 +51,6 @@ instance Default Config where
                , warpSettings = Warp.defaultSettings
                }
 
-data HandlerInput = HandlerInput { sqlPool :: ConnectionPool
-                                 }
-
 
 thermoprintServer :: ( MonadLoggerIO m
                      , MonadIO m
@@ -82,70 +66,5 @@ thermoprintServer io = Dyre.wrapMain $ Dyre.defaultParams
     where
       realMain Config{..} = unNat io $ do
         maybe (return ()) ($(logErrorS) "Dyre" . T.pack) dyreError
-        
-        sqlPool <- ask
-        logFunc <- askLoggerIO
-
-        runSqlPool (runMigrationSilent migrateAll) sqlPool >>= mapM_ ($(logWarnS) "DB")
-        
-        let
-          handlerInput = HandlerInput
-            { sqlPool = sqlPool
-            }
-          io' :: ProtoHandler :~> IO
-          io' = Nat (($ logFunc) . runLoggingT) . runReaderTNat handlerInput
-        liftIO . Warp.runSettings warpSettings . serve thermoprintAPI $ enter (hoistNat io') thermoprintServer'
-
-type ProtoHandler = ReaderT HandlerInput (LoggingT IO)
-type Handler      = EitherT ServantErr ProtoHandler
-
-(<||>) :: Monad m => m a -> m b -> m (a :<|> b)
-(<||>) = liftM2 (:<|>)
-infixr 9 <||>
-
-thermoprintServer' :: ServerT ThermoprintAPI Handler
-thermoprintServer' = listPrinters
-                     :<|> (listJobs :<|> queueJob)
-                     :<|> getJob <||> jobStatus <||> deleteJob
-                     :<|> (listDrafts :<|> addDraft)
-                     :<|> updateDraft <||> getDraft <||> deleteDraft <||> printDraft
-
-
-listPrinters :: Handler (Map PrinterId PrinterStatus)
-listPrinters = return $ Map.fromList [(1, Available), (7, Available), (3, Available)]
-
-queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId
-queueJob = return undefined
-
-printerStatus :: PrinterId -> Handler PrinterStatus
-printerStatus = return undefined
-
-listJobs :: Maybe PrinterId -> Maybe API.JobId -> Maybe API.JobId -> Handler (Seq (API.JobId, JobStatus))
-listJobs = return undefined
-
-getJob :: API.JobId -> Handler Printout
-getJob = return undefined
-
-jobStatus :: API.JobId -> Handler JobStatus
-jobStatus = return undefined
-
-deleteJob :: API.JobId -> Handler ()
-deleteJob = return undefined
-
-listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle))
-listDrafts = return undefined
-
-addDraft :: Maybe DraftTitle -> Printout -> Handler API.DraftId
-addDraft = return undefined
-
-updateDraft :: API.DraftId -> Maybe DraftTitle -> Printout -> Handler ()
-updateDraft = return undefined
-
-getDraft :: API.DraftId -> Handler (Maybe DraftTitle, Printout)
-getDraft = return undefined
-
-deleteDraft :: API.DraftId -> Handler ()
-deleteDraft = return undefined
-
-printDraft :: API.DraftId -> Maybe PrinterId -> Handler API.JobId
-printDraft = return undefined
+        mapM_ ($(logWarnS) "DB") =<< runSqlPool (runMigrationSilent migrateAll) =<< ask
+        liftIO . Warp.runSettings warpSettings . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat