{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE ImpredicativeTypes #-}

module Thermoprint.ServerSpec (spec) where

import Test.Hspec

import Thermoprint.API
import Thermoprint.Server

import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Resource

import Database.Persist.Sqlite

import Control.Concurrent
import Control.Concurrent.STM

import System.IO
import System.IO.Temp

import qualified Data.Text as T

data TestPrinter = TestPrinter
  { outputChan :: TChan Printout
  , failSwitch :: TMVar PrintingError
  }

data TestManager = TestManager
  { manage :: TMVar (QueueManager IdentityT)
  }

setup :: IO (ThreadId, TestPrinter, TestManager)
setup = withSystemTempFile "thermoprint.sqlite" $ \fp h -> hClose h >> do
  tPrinter <- TestPrinter <$> newTChanIO <*> newEmptyTMVarIO
  tManager <- TestManager <$> newEmptyTMVarIO
  let
    runSqlite :: ReaderT ConnectionPool (LoggingT IO) a -> IO a
    runSqlite = runStderrLoggingT . withSqlitePool (T.pack fp) 1 . runReaderT

    printers = [ ( pure $ PM tPM
                 , QMConfig (join . lift $ takeTMVar (manage tManager)) (Nat $ liftIO . runIdentityT)
                 )
               ]

    tPM :: MonadIO m => Printout -> m (Maybe PrintingError)
    tPM printout = liftIO . atomically $ writeTChan (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter)
  (,,) <$> forkIO (thermoprintServer (Nat runSqlite) $ def `withPrinters` printers) <*> pure tPrinter <*> pure tManager

spec :: Spec
spec = beforeAll setup $ do
  describe "blubTests" $ do
    it "prints Blub." $ \(tId, _, _) -> do
      putStrLn "Blub."
      System.IO.print tId
      True `shouldSatisfy` id