TypeSpec.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Test.Util.TypeSpec
  ( ExactlyIs
  ) where

import Data.Singletons.Prelude.Eq (DefaultEq)
import Morley.Util.Type (If)
import Morley.Util.TypeLits (ErrorMessage(..))
import Test.TypeSpec.Core (EvalExpectation, FAILED, OK, PrettyTypeSpec(..))

-- | Like 'Is' but ensures that arguments match in kind.
data ExactlyIs (actual :: k) (expected :: k)
type instance EvalExpectation (ExactlyIs actual expected) =
  If (DefaultEq actual expected)
      (OK (ExactlyIs actual expected))
      (FAILED
        ('Text "Expected type: " ':<>: 'ShowType expected
          ':$$: 'Text "Actual type:   " ':<>: 'ShowType actual))

instance PrettyTypeSpec (ExactlyIs a b) where
  prettyTypeSpec _px = "Equal"