module Test.TypeSpec.ShouldBe
( ShouldBe
, ShouldNotBe
, ShouldBeTrue
, ShouldBeFalse
, ButNot
)
where
import Data.Kind
import Data.Type.Bool
import GHC.TypeLits
import Test.TypeSpec.Core
import Test.TypeSpec.Internal.Apply ()
import Test.TypeSpec.Internal.Either ()
import Test.TypeSpec.Internal.Equality
import Text.PrettyPrint
data ShouldBeTrue :: expectation -> Type
type instance EvalExpectation (ShouldBeTrue t) =
If (EqExtra t 'True)
(OK (ShouldBeTrue t))
(FAILED
('Text "Should have been 'True: " ':<>: 'ShowType t))
data ShouldBeFalse :: expectation -> Type
type instance EvalExpectation (ShouldBeFalse t) =
If (EqExtra t 'False)
(OK (ShouldBeFalse t))
(FAILED
('Text "Should have been 'False: " ':<>: 'ShowType t))
data ButNot :: shouldBe -> shouldntBe -> Type
type instance
EvalExpectation (ButNot (ShouldBe actual expected) other) =
If (EqExtra actual expected)
(If (EqExtra other expected)
(FAILED
('Text "Expected type: "
':$$: 'Text " " ':<>: 'ShowType expected
':$$: 'Text "to be different from: "
':$$: 'Text " " ':<>: 'ShowType other))
(OK (ButNot (ShouldBe actual expected) other)))
(FAILED
('Text "Expected type: " ':<>: 'ShowType expected
':$$: 'Text "Actual type: " ':<>: 'ShowType actual))
data ShouldBe :: actual -> expected -> Type
type instance
EvalExpectation (ShouldBe actual expected) =
If (EqExtra actual expected)
(OK (ShouldBe actual expected))
(FAILED
('Text "Expected type: " ':<>: 'ShowType expected
':$$: 'Text "Actual type: " ':<>: 'ShowType actual))
data ShouldNotBe :: actual -> expected -> Type
type instance
EvalExpectation (ShouldNotBe actual expected) =
If (EqExtra expected actual)
(FAILED
('Text "Expected type: "
':$$: 'Text " " ':<>: 'ShowType expected
':$$: 'Text "to be different from: "
':$$: 'Text " " ':<>: 'ShowType actual))
(OK (ShouldNotBe actual expected))
instance PrettyTypeSpec (ShouldBeTrue a) where
prettyTypeSpec _px =
prettyCheck "True"
instance PrettyTypeSpec (ShouldBeFalse a) where
prettyTypeSpec _px =
prettyCheck "False"
instance PrettyTypeSpec (ShouldBe a b) where
prettyTypeSpec _px =
prettyCheck "Equal"
instance PrettyTypeSpec (ShouldNotBe a b) where
prettyTypeSpec _px =
prettyCheck "Different"
instance
(a ~ (ShouldBe a0 a1))
=> PrettyTypeSpec (ButNot a b) where
prettyTypeSpec _ =
prettyCheck "Restricted"
prettyCheck :: String -> Doc
prettyCheck doc = parens (text "OK" <+> text doc)