{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      : Test.Fluent.Assertions.Maybe
-- Description : Set of assertions for Maybe type
-- Copyright   : (c) Pawel Nosal, 2021
-- License     : MIT
-- Maintainer  : p.nosal1986@gmail.com
-- Stability   : experimental
--
-- This library aims to provide a set of combinators to assert Maybe type.
module Test.Fluent.Assertions.Maybe (isNothing, isJust, extracting) where

import qualified Data.Maybe as Maybe
import GHC.Stack (HasCallStack)
import Test.Fluent.Assertions
  ( focus,
    forceError,
    inside,
    simpleAssertion,
  )
import Test.Fluent.Internal.Assertions (Assertion, Assertion')

-- | assert if subject under is empty
--
-- @
--  assertThat (Just 10) isNothing
-- @
isNothing :: HasCallStack => Assertion (Maybe a)
isNothing :: Assertion (Maybe a)
isNothing = (Maybe a -> Bool) -> Assertion Bool -> Assertion (Maybe a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing ((Bool -> Bool) -> (Bool -> String) -> Assertion Bool
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) Bool -> String
forall p p. IsString p => p -> p
assertionMessage)
  where
    assertionMessage :: p -> p
assertionMessage p
_ = p
"should be Nothing"

-- | assert if subject under is not empty
--
-- @
--  assertThat (Just 10) isJust
-- @
isJust :: HasCallStack => Assertion (Maybe a)
isJust :: Assertion (Maybe a)
isJust = (Maybe a -> Bool) -> Assertion Bool -> Assertion (Maybe a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isJust ((Bool -> Bool) -> (Bool -> String) -> Assertion Bool
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) Bool -> String
forall p p. IsString p => p -> p
assertionMessage)
  where
    assertionMessage :: p -> p
assertionMessage p
_ = p
"should be Just"

-- | assert if subject under is not empty and extract contained value
--
-- @
--  assertThat (Just 10) extracting
-- @
extracting :: HasCallStack => Assertion' (Maybe a) a
extracting :: Assertion' (Maybe a) a
extracting = Assertion (Maybe a) -> Assertion (Maybe a)
forall a. Assertion a -> Assertion a
forceError Assertion (Maybe a)
forall a. HasCallStack => Assertion (Maybe a)
isJust Assertion (Maybe a)
-> Assertion' (Maybe a) a -> Assertion' (Maybe a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a) -> Assertion' (Maybe a) a
forall a b. (a -> b) -> Assertion' a b
focus Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust