{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
--------------------------------------------------------------------------------
-- |
-- Module : Test.EventSource.Store.Specification
-- Copyright : (C) 2016 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Test.EventSource.Store.Specification (specification) where

--------------------------------------------------------------------------------
import Control.Exception (Exception, throwIO)
import Control.Monad (unless)
import Data.Foldable (for_)

--------------------------------------------------------------------------------
import           Control.Concurrent.Async (wait)
import           Control.Monad.Base (MonadBase, liftBase)
import           Data.Aeson.Types (object, withObject, (.=), (.:))
import           Data.Text (Text)
import           Data.UUID (toText)
import           Data.UUID.V4 (nextRandom)
import           EventSource
import           Streaming (Stream, Of)
import qualified Streaming.Prelude as Streaming
import           Test.Tasty.Hspec

--------------------------------------------------------------------------------
newtype TestEvent = TestEvent Int deriving (Eq, Show)

--------------------------------------------------------------------------------
instance EncodeEvent TestEvent where
  encodeEvent (TestEvent v) = do
    setEventType "test-event"
    setEventPayload $ dataFromJson $ object [ "value" .= v ]

--------------------------------------------------------------------------------
instance DecodeEvent TestEvent where
  decodeEvent Event{..} = do
    unless (eventType == "test-event") $
      Left "Wrong event type"

    dataAsParse eventPayload $ withObject "" $ \o ->
      fmap TestEvent (o .: "value")

--------------------------------------------------------------------------------
newtype Test = Test Int deriving (Eq, Show)

--------------------------------------------------------------------------------
data TestError = TestError deriving (Eq, Show)

--------------------------------------------------------------------------------
instance Exception TestError

--------------------------------------------------------------------------------
freshStreamName :: MonadBase IO m => m StreamName
freshStreamName = liftBase $ fmap (StreamName . toText) nextRandom

--------------------------------------------------------------------------------
defaultBatch :: Batch
defaultBatch =
  Batch'
  { batchFrom = 0
  , batchSize = 1
  }

--------------------------------------------------------------------------------
decodeAs :: (Traversable t, DecodeEvent a) => t SavedEvent -> Either Text (t a)
decodeAs = traverse (decodeEvent . savedEvent)

--------------------------------------------------------------------------------
streamDecodeAs :: DecodeEvent a
               => Stream (Of SavedEvent) IO ()
               -> Stream (Of a) IO ()
streamDecodeAs = Streaming.mapM go
  where
    go e =
      case decodeEvent (savedEvent e) of
        Left _  -> throwIO TestError
        Right a -> pure a

--------------------------------------------------------------------------------
specification :: Store store => store -> Spec
specification store = do
  specify "API - Add event" $ do
    let expected = TestEvent 1
    name <- freshStreamName
    _ <- wait =<< appendEvent store name AnyVersion expected
    let stream = unhandled $ readStream store name defaultBatch

    evts <- Streaming.toList_ stream
    for_ (zip [0..] evts) $ \(num, e) ->
      eventNumber e `shouldBe` num

    decodeAs evts `shouldBe` Right [expected]

  specify "API - Read events in batch" $ do
    let expected = fmap TestEvent [1..3]
    name <- freshStreamName
    _ <- wait =<< appendEvents store name AnyVersion
                         expected
    let stream = unhandled $ readStream store name defaultBatch

    got <- Streaming.toList_ stream

    decodeAs got `shouldBe` Right expected

  specify "API - readStream should not panic if asking for a stream that doesn't exist" $ do
    name <- freshStreamName
    let stream = unhandled $ readStream store name defaultBatch

    Streaming.print stream

    True `shouldBe` True

  specify "API - Subscription working" $ do
    let expected = TestEvent 1
    name <- freshStreamName
    sub <- subscribe store name

    _ <- wait =<< appendEvent store name AnyVersion expected

    let stream = Streaming.take 1
                           $ streamDecodeAs
                           $ subscriptionStream sub

    [got] <- Streaming.toList_ stream
    got `shouldBe` expected