{-# 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

import           Debug.Trace

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

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

setup :: IO (ThreadId, QSem, TestPrinter, TestManager)
setup = withSystemTempFile "thermoprint.sqlite" $ \fp h -> hClose h >> do
  tPrinter <- TestPrinter <$> newTChanIO <*> newEmptyTMVarIO
  tManager <- TestManager <$> newEmptyTMVarIO
  termSem <- newQSem 0
  let
    runSqlite :: ReaderT ConnectionPool (LoggingT IO) a -> IO a
    runSqlite = runNoLoggingT . 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)
  (,,,) <$> forkFinally (thermoprintServer False (Nat runSqlite) $ def `withPrinters` printers) (const $ signalQSem termSem) <*> pure termSem <*> pure tPrinter <*> pure tManager

withSetup :: SpecWith (ThreadId, QSem, TestPrinter, TestManager) -> Spec
withSetup = beforeAll setup . afterAll (\(tId, termSem, _, _) -> killThread tId >> waitQSem termSem)

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