PartialMockSpec.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}

module Test.MockCat.PartialMockSpec (spec) where

import Data.Text (Text)
import Test.Hspec (Spec)
import Data.List (find)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Class (lift)
import Test.MockCat
import Test.MockCat.SharedSpecDefs
import qualified Test.MockCat.PartialMockCommonSpec as PartialMockCommonSpec
import Test.MockCat.Impl ()
import Prelude hiding (readFile, writeFile)
import Data.Data
import GHC.TypeLits (KnownSymbol, symbolVal)
import Unsafe.Coerce (unsafeCoerce)

import qualified Test.MockCat.Verify as Verify


ensureVerifiable ::
  ( MonadIO m
  , Verify.ResolvableMock target
  ) =>
  target ->
  m ()
ensureVerifiable target =
  liftIO $
    Verify.resolveForVerification target >>= \case
      Just _ -> pure ()
      Nothing -> Verify.verificationFailure


instance UserInputGetter IO where
  getInput = getLine
  toUserInput "" = pure Nothing
  toUserInput a = pure . Just . UserInput $ a

instance ExplicitlyReturnMonadicValuesPartialTest IO where
  echoExplicitPartial _ = pure ()
  getByExplicitPartial s = pure (length s)


instance (MonadIO m, FileOperation m) => FileOperation (MockT m) where
  readFile path = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "readFile") defs of
      Just mockFn -> do
        let !result = mockFn path
        pure result
      Nothing -> lift $ readFile path

  writeFile path content = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "writeFile") defs of
      Just mockFn -> do
        let !result = mockFn path content
        pure result
      Nothing -> lift $ writeFile path content

instance (MonadIO m, UserInputGetter m) => UserInputGetter (MockT m) where
  getInput = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "getInput") defs of
      Just mockFn -> do
        let !result = mockFn
        pure result
      Nothing -> lift getInput

  toUserInput str = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "toUserInput") defs of
      Just mockFn -> do
        let !result = mockFn str
        lift result
      Nothing -> lift $ toUserInput str

instance
  ( MonadIO m
  , ExplicitlyReturnMonadicValuesPartialTest m
  ) =>
  ExplicitlyReturnMonadicValuesPartialTest (MockT m) where
  getByExplicitPartial label = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "getBy") defs of
      Just mockFn -> do
        let !result = mockFn label
        lift result
      Nothing -> lift $ getByExplicitPartial label

  echoExplicitPartial label = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "echo") defs of
      Just mockFn -> do
        let !result = mockFn label
        lift result
      Nothing -> lift $ echoExplicitPartial label

_readFile ::
  ( MockBuilder params (FilePath -> Text) (Param FilePath)
  , MonadIO m
  ) =>
  params ->
  MockT m (FilePath -> Text)
_readFile p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "readFile" p
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance NoVerification)
  pure mockInstance

_writeFile ::
  ( MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text)
  , MonadIO m
  ) =>
  params ->
  MockT m (FilePath -> Text -> ())
_writeFile p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "writeFile" p
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)
  pure mockInstance

_getInput ::
  ( Verify.ResolvableParamsOf r ~ ()
  , MonadIO m
  , Typeable r
  , Show r
  , Eq r
  ) =>
  r ->
  MockT m r
_getInput value = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "getInput" (Head :> param value)
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "getInput") mockInstance NoVerification)
  pure mockInstance

_toUserInput ::
  ( MockBuilder params (String -> m (Maybe UserInput)) (Param String)
  , MonadIO m
  , Typeable m
  , Verify.ResolvableParamsOf (String -> m (Maybe UserInput)) ~ Param String
  ) =>
  params ->
  MockT m (String -> m (Maybe UserInput))
_toUserInput p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "toUserInput" p
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "toUserInput") mockInstance NoVerification)
  pure mockInstance

_getByPartial ::
  ( MockBuilder params (String -> IO Int) (Param String)
  ) =>
  params ->
  MockT IO (String -> IO Int)
_getByPartial p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "getBy" p
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "getBy") mockInstance NoVerification)
  pure mockInstance

_echoPartial ::
  ( MockBuilder params (String -> IO ()) (Param String)
  ) =>
  params ->
  MockT IO (String -> IO ())
_echoPartial p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "echo" p
  ensureVerifiable mockInstance
  addDefinition (Definition (Proxy :: Proxy "echo") mockInstance NoVerification)
  pure mockInstance

findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a
findParam pa definitions = do
  let definition = find (\(Definition s _ _) -> symbolVal s == symbolVal pa) definitions
  fmap (\(Definition _ mockFunction _) -> unsafeCoerce mockFunction) definition

instance (MonadIO m, Finder a b m) => Finder a b (MockT m) where

  findIds = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "_findIds") defs of
      Just mockFn -> do
        let !result = mockFn
        pure result
      Nothing -> lift findIds

  findById id = MockT do
    defs <- getDefinitions
    case findParam (Proxy :: Proxy "_findById") defs of
      Just mockFn -> do
        let !result = mockFn id
        pure result
      Nothing -> lift $ findById id



_findIds ::
  ( Verify.ResolvableParamsOf r ~ ()
  , MonadIO m
  , Typeable r
  , Show r
  , Eq r
  ) =>
  r ->
  MockT m r
_findIds p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "_findIds" (Head :> param p)
  ensureVerifiable mockInstance
  addDefinition
    ( Definition
        (Proxy :: Proxy "_findIds")
        mockInstance
        NoVerification
    )
  pure mockInstance

_findById ::
  ( MockBuilder params (Int -> String) (Param Int)
  , MonadIO m
  ) =>
  params ->
  MockT m (Int -> String)
_findById p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "_findById" p
  ensureVerifiable mockInstance
  addDefinition
    ( Definition
        (Proxy :: Proxy "_findById")
        mockInstance
        NoVerification
    )
  pure mockInstance

_findByIdNI ::
  ( MockBuilder params (Int -> IO String) (Param Int)
  ) =>
  params ->
  MockT IO (Int -> IO String)
_findByIdNI p = MockT $ do
  mockInstance <- liftIO $ createNamedMockFnWithParams "_findByIdNI" p
  ensureVerifiable mockInstance
  addDefinition
    ( Definition
        (Proxy :: Proxy "_findByIdNI")
        mockInstance
        NoVerification
    )
  pure mockInstance

spec :: Spec
spec = PartialMockCommonSpec.spec deps (program "input.txt" "output.text")
  where
    deps = PartialMockCommonSpec.PartialMockDeps
      { PartialMockCommonSpec._getInput = _getInput
      , PartialMockCommonSpec._getBy = _getByPartial
      , PartialMockCommonSpec._echo = _echoPartial
      , PartialMockCommonSpec._writeFile = _writeFile
      , PartialMockCommonSpec._findIds = _findIds
      , PartialMockCommonSpec._findById = _findById
      , PartialMockCommonSpec._findByIdNI = _findByIdNI
      }