{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE OverloadedLists  #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}

module Thermoprint.ServerSpec (spec) where

import           Test.Hspec
import           Test.Hspec.QuickCheck
import qualified Test.Hspec as Hspec

import           Test.QuickCheck

import           Thermoprint.API
import qualified Thermoprint.Server as S
import           Thermoprint.Client

import           Data.Monoid
import           Data.Function
import           Control.Monad
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Trans.Identity
import           Control.Monad.Trans.Resource
import           Control.Monad.Catch (finally)

import           Database.Persist.Sqlite

import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Concurrent.STM.TSem

import           System.IO
import           System.IO.Temp

import qualified Data.Text as T

import           Network.Wai.Handler.Warp (defaultSettings, setBeforeMainLoop)

import qualified Data.Map as Map

deriving instance Eq PrintingError
deriving instance Eq JobStatus
deriving instance Eq PrinterStatus

-- Equality via cotext on Block
instance Eq Block where
  (==) = (==) `on` cotext
-- Structural equality for Chunk 
deriving instance Eq Chunk

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

data TestManager = TestManager
  { manage :: TMVar (S.QueueManager IdentityT)
  , ran :: TSem
  }

data RunningServer = RunningServer
  { thread :: ThreadId
  , termination :: QSem
  , printer :: TestPrinter
  , manager :: TestManager
  }

setup :: QSem -> IO RunningServer
setup startup = withSystemTempFile "thermoprint.sqlite" $ \fp h -> hClose h >> do
  tPrinter <- TestPrinter <$> newEmptyTMVarIO <*> newEmptyTMVarIO
  tManager <- TestManager <$> newEmptyTMVarIO <*> atomically (newTSem 0)
  termSem <- newQSem 0
  let
    runSqlite :: ReaderT ConnectionPool (LoggingT IO) a -> IO a
    runSqlite = runStderrLoggingT . filterLogger (const (> LevelDebug)) . withSqlitePool (T.pack fp) 1 . runReaderT

    printers = [ ( pure $ S.PM tPM
                 , S.QMConfig ((join . lift $ takeTMVar (manage tManager) <* signalTSem (ran tManager)) >> return 0) (Nat $ liftIO . runIdentityT)
                 )
               ]

    tPM :: MonadIO m => Printout -> m (Maybe PrintingError)
    tPM printout = liftIO . atomically $ putTMVar (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter)
  RunningServer <$> forkFinally (S.thermoprintServer False (Nat runSqlite) $ def' `S.withPrinters` printers) (const $ signalQSem termSem) <*> pure termSem <*> pure tPrinter <*> pure tManager
  where
    def' :: MonadIO m => S.Config m
    def' = S.def { S.warpSettings = setBeforeMainLoop (signalQSem startup) $ defaultSettings }

withSetup :: SpecWith RunningServer -> Spec
withSetup = beforeAll setup' . afterAll teardown
  where
    setup' = do
      startup <- newQSem 0
      setup startup <* waitQSem startup
    teardown RunningServer{..} = killThread thread >> waitQSem termination

spec :: Spec
spec = withSetup $ do
  it "Reports initial server state" $ \RunningServer{..} -> do
    printers                     `shouldReturn` [(0, Available)]
    jobs Nothing Nothing Nothing `shouldReturn` []
    drafts                       `shouldReturn` []
  it "Reports printing errors" $ \RunningServer{..} -> do
    let
      err = IOError "test"
    atomically $ putTMVar (failSwitch printer) err
    jId <- jobCreate Nothing mempty
    atomically . takeTMVar $ outputChan printer
    jobStatus jId `shouldReturn` (Failed err)
  -- it "Queues any Printout" $ \RunningServer{..} -> property $ \p -> do
  --   jId <- jobCreate (Just 0) p
  --   (atomically . takeTMVar . outputChan $ printer) `shouldReturn` p
  it "Reports qualitative queue position" $ \RunningServer{..} -> do
    jids <- replicateM 3 $ jobCreate (Just 0) mempty
    zipWithM_ (\jid ret -> jobStatus jid `shouldReturn` ret) jids
      [ Done
      , Printing 0
      , Queued 0
      ]
    replicateM_ (length jids) . atomically . takeTMVar . outputChan $ printer
    zipWithM_ (\jid ret -> jobStatus jid `shouldReturn` ret) jids (replicate (length jids) Done)
  it "Keeps history" $ \RunningServer{..} -> do
    jobs Nothing Nothing Nothing `shouldNotReturn` []
  it "Runs queue managers" $ \RunningServer{..} -> do
    atomically $ putTMVar (manage manager) S.nullQM
    atomically $ waitTSem (ran manager)
    jobs Nothing Nothing Nothing `shouldReturn` []
  it "Handles drafts" $ \RunningServer{..} -> do
    drafts `shouldReturn` []
    dId <- draftCreate Nothing mempty
    draft dId `shouldReturn` (Nothing, mempty)
    drafts `shouldReturn` [(dId, mempty)]
    p <- generate arbitrary
    draftReplace dId (Just "Title") p
    draft dId `shouldReturn` (Just "Title", p)
    jId <- draftPrint dId Nothing
    (atomically . takeTMVar $ outputChan printer) `shouldReturn` p
    draftDelete dId
    drafts `shouldReturn` []
  where
    Client{..} = mkClient' $ BaseUrl Http "localhost" 3000