module Database.Seakale.Tests.Mock where

import           Control.Applicative

import           Data.Functor.Foldable
import           Data.Maybe
import qualified Data.ByteString.Lazy as BSL

data QueryPredicate
  = QPredPlain BSL.ByteString
  | QPredFunction (BSL.ByteString -> Bool)

runQueryPredicate :: QueryPredicate -> BSL.ByteString -> Bool
runQueryPredicate p req = case p of
  QPredPlain req' -> req == req'
  QPredFunction f -> f req

instance Show QueryPredicate where
  show = \case
    QPredPlain bsl  -> show bsl
    QPredFunction _ -> "predicate"

instance Eq QueryPredicate where
  (==) qp1 qp2 = case (qp1, qp2) of
    (QPredPlain q1, QPredPlain q2)     -> q1 == q2
    (QPredPlain q, QPredFunction f)    -> f q
    (QPredFunction f, QPredPlain q)    -> f q
    (QPredFunction _, QPredFunction _) -> False

data Mock sub a
  = Action sub
  | Or (Mock sub a) (Mock sub a)
  | And (Mock sub a) (Mock sub a)
  | After (Mock sub a) (Mock sub a)
  | None (Maybe a)
  deriving (Show, Eq)

mockConsumed :: Mock sub a -> Bool
mockConsumed = \case
  None _ -> True
  _ -> False

notMonadError :: a
notMonadError = error "Mock not intended as an actual monad"

instance Monoid (Mock sub a) where
  mempty = None Nothing
  mappend = And

instance Functor (Mock sub) where
  fmap f = \case
    Action sub  -> Action sub
    Or    m1 m2 -> Or    (fmap f m1) (fmap f m2)
    And   m1 m2 -> And   (fmap f m1) (fmap f m2)
    After m1 m2 -> After (fmap f m1) (fmap f m2)
    None mx -> None (fmap f mx)

instance Applicative (Mock sub) where
  pure = None . Just
  None f <*> fx = fromMaybe notMonadError f <$> fx
  ff <*> None x = ($ fromMaybe notMonadError x) <$> ff
  ff <*> fx = And (castMock ff) (castMock fx)

instance Monad (Mock sub) where
  None mx >>= f = f $ fromMaybe notMonadError mx
  mx >>= f = After (castMock mx) (f notMonadError)

instance Alternative (Mock sub) where
  empty = None Nothing
  mx <|> my = Or mx my

data MockF sub f
  = FAction sub
  | FOr f f
  | FAnd f f
  | FAfter f f
  | FNone
  deriving Functor

type instance Base (Mock sub a) = MockF sub

instance Recursive (Mock sub a) where
  project = \case
    Action sub  -> FAction sub
    Or    m1 m2 -> FOr    m1 m2
    And   m1 m2 -> FAnd   m1 m2
    After m1 m2 -> FAfter m1 m2
    None _ -> FNone

consumeMock :: (sub -> Maybe b) -> Mock sub a -> Maybe (b, Mock sub a)
consumeMock = para . phi
  where
    phi :: (sub -> Maybe a) -> MockF sub (Mock sub c, Maybe (a, Mock sub c))
        -> Maybe (a, Mock sub c)
    phi f = \case
      FAction sub -> (, None Nothing) <$> f sub
      FOr (_, mRes1) (_, mRes2) -> mRes1 <|> mRes2
      FAnd (m1, mRes1) (m2, mRes2) ->
        case (mRes1, mRes2) of
          (Just (x, m1'), _) -> Just (x, noNone And m1' m2)
          (_, Just (x, m2')) -> Just (x, noNone And m1 m2')
          _ -> Nothing
      FAfter (_, mRes1) (m2, _) ->
        fmap (\(x, m1') -> (x, noNone After m1' m2)) mRes1
      FNone -> Nothing

    noNone :: (Mock sub a -> Mock sub a -> Mock sub a)
           -> Mock sub a -> Mock sub a -> Mock sub a
    noNone _ (None _) m = m
    noNone g m1 m2 = g m1 m2

castMock :: Mock sub a -> Mock sub b
castMock = cata cast
  where
    cast :: MockF sub (Mock sub b) -> Mock sub b
    cast = \case
      FAction sub  -> Action sub
      FOr    m1 m2 -> Or    m1 m2
      FAnd   m1 m2 -> And   m1 m2
      FAfter m1 m2 -> After m1 m2
      FNone -> None Nothing

mor :: Mock sub a -> Mock sub a -> Mock sub a
mor = Or

mand :: Mock sub a -> Mock sub a -> Mock sub a
mand = And

after, andThen :: Mock sub a -> Mock sub a -> Mock sub a
after   = After
andThen = After

anyOf, allOf :: [Mock sub a] -> Mock sub a
anyOf = foldr mor  (None Nothing)
allOf = foldr mand (None Nothing)

fixAfter :: Mock sub a -> Mock sub a
fixAfter mock = After mock (fixAfter mock)

times :: Int -> Mock sub a -> Mock sub a
times n mock
  | n <= 0 = None Nothing
  | n == 1 = mock
  | otherwise = After mock $ times (n - 1) mock