type-assertions (empty) → 0.1.0.0

raw patch · 9 files changed

+349/−0 lines, 9 filesdep +basedep +hspecdep +test-fixturesetup-changed

Dependencies added: base, hspec, test-fixture, type-assertions

Files

• LICENSE +13/−0
• README.md +8/−0
• Setup.hs +7/−0
• library/Test/TypeAssertions.hs +120/−0
• package.yaml +38/−0
• stack.yaml +11/−0
• test-suite/Main.hs +1/−0
• test-suite/Test/TypeAssertionsSpec.hs +98/−0
• type-assertions.cabal +53/−0

@@ -0,0 +1,13 @@+Copyright (c) 2016, Alexis King <lexi.lambda@gmail.com>++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.

@@ -0,0 +1,8 @@+# type-assertions [![Build Status](https://travis-ci.org/lexi-lambda/type-assertions.svg?branch=master)](https://travis-ci.org/lexi-lambda/type-assertions)++This module provides a set of runtime assertions about types that propogates information back to the type system, using `Data.Typeable` and `Data.Type.Equality`. These assertions are intended to be used in a test suite (and exclusively in a test suite) to create monomorphic implementations of polymorphic functions. Specifically, this is intended to be used with a package like [test-fixture][] to stub out polymorphic typeclass methods with monomorphic implementations.++For more information, [see the documentation on Hackage][type-assertions].++[test-fixture]: http://hackage.haskell.org/package/test-fixture+[type-assertions]: http://hackage.haskell.org/package/type-assertions

@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,120 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++-- | This module provides a set of runtime assertions about types that+-- propogates information back to the type system, using 'Typeable' and ':~:'.+-- These are intended to be used in a test suite (and exclusively in a test+-- suite) to create monomorphic implementations of polymorphic functions.+-- Specifically, this is intended to be used with a package like+-- <http://hackage.haskell.org/package/test-fixture test-fixture> to stub out+-- polymorphic typeclass methods with monomorphic implementations.+--+-- For example, consider the following typeclass:+--+-- > class Monad m => MonadDB m where+-- >   get :: DBRecord r => Id r -> m [r]+-- >   ...+--+-- The @get@ method might be used in another function to retrieve a record of a+-- specific type, such as a @User@. In a test, it might be useful to stub out+-- the @get@ method to provide a well-known user:+--+-- > let fixture = def { _get = \_ -> User { ... } }+--+-- However, this will not typecheck, since the type of record should be chosen+-- by the /caller/ of @get@. We might know that the type is guaranteed to be+-- @User@ in this particular case, but GHC cannot prove that, and it will reject+-- attempts to write a stubbed implementation.+--+-- To work around this issue, we can effectively defer the type error to runtime+-- by using the functions in this module. For example, we can use+-- 'withAssertEqT' to assert that the types are the same:+--+-- > {-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+-- >+-- > let fixture = def { _get = \(_ :: Id r) ->+-- >       withAssertEqT @r @User $+-- >         User { ... } }+--+-- This will properly convince GHC that the @User@ value will only be returned+-- when the argument is actually an @Id User@. If it isn’t, 'withAssertEqT' will+-- throw.+module Test.TypeAssertions+  ( assertHasT+  , withAssertHasT+  , assertEqT+  , withAssertEqT+  , (:~:)(..)+  ) where++import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Proxy (Proxy(..))+import Data.Typeable (Typeable, (:~:)(Refl), eqT, typeRep)+import Data.Type.Equality (gcastWith)+import GHC.Stack (HasCallStack, withFrozenCallStack)++-- | Asserts that a value has a particular type, and raises an exception if it+-- does not.+--+-- >>> assertHasT @Bool True+-- Refl+-- >>> assertHasT @Bool "hello"+-- *** Exception: expected value of type ‘Bool’, but got ‘"hello"’, which is of type ‘[Char]’+assertHasT :: forall b a. (HasCallStack, Show a, Typeable a, Typeable b) => a -> (a :~: b)+assertHasT x = withFrozenCallStack $ fromMaybe (error errorMessage) eqT+  where errorMessage =+            "expected value of type ‘" <> show (typeRep (Proxy :: Proxy b))+         <> "’, but got ‘" <> show x+         <> "’, which is of type ‘" <> show (typeRep (Proxy :: Proxy a)) <> "’"++-- | Like 'assertHasT', but instead of returning a witness upon success,+-- 'withAssertHasT' returns its second argument. The second argument can be an+-- expression that typechecks under the assumption that @a ~ b@.+--+-- > foo :: (Show a, Typeable a) => a -> a+-- > foo x = withAssertHasT @String x $ map toUpper x+--+-- >>> foo "hello"+-- "HELLO"+-- >>> foo True+-- *** Exception: expected value of type ‘[Char]’, but got ‘True’, which is of type ‘Bool’+-- CallStack (from HasCallStack):+--   withAssertHasT, called at <interactive>:17:13 in interactive:Ghci1+withAssertHasT :: forall b a c. (HasCallStack, Show a, Typeable a, Typeable b) => a -> ((a ~ b) => c) -> c+withAssertHasT x = withFrozenCallStack $ gcastWith (assertHasT x :: (a :~: b))++-- | Like 'assertHasT', but asserts that two types are the same instead of+-- asserting that a value has a type. Generally, prefer 'assertHasT' when+-- possible, since it will produce better error messages, but 'assertEqT' can be+-- necessary when the type does not have a runtime representation (such as if it+-- is phantom).+--+-- >>> assertEqT @Bool @Bool+-- Refl+-- >>> assertEqT @Bool @Int+-- *** Exception: expected type ‘Int’, but got type ‘Bool’+assertEqT :: forall a b. (HasCallStack, Typeable a, Typeable b) => (a :~: b)+assertEqT = withFrozenCallStack $ fromMaybe (error errorMessage) eqT+  where errorMessage =+            "expected type ‘" <> show (typeRep (Proxy :: Proxy b))+         <> "’, but got type ‘" <> show (typeRep (Proxy :: Proxy a)) <> "’"++-- | Like 'assertEqT' but with the type propogation behavior of+-- 'withAssertHasT'. Generally, prefer 'withAssertHasT' when possible, since it+-- will produce better error messages, but 'withAssertEqT' can be necessary when+-- the type does not have a runtime representation (such as if it is phantom).+--+-- > foo :: forall a proxy. (Show a, Typeable a) => proxy a -> a+-- > foo _ = withAssertEqT @Bool @a True+--+-- >>> foo (Proxy @Bool)+-- True+-- >>> foo (Proxy @Int)+-- *** Exception: expected type ‘Int’, but got type ‘Bool’+withAssertEqT :: forall a b c. (HasCallStack, Typeable a, Typeable b) => ((a ~ b) => c) -> c+withAssertEqT = withFrozenCallStack $ gcastWith (assertEqT :: (a :~: b))

@@ -0,0 +1,38 @@+name: type-assertions+version: 0.1.0.0+category: Testing+synopsis: Runtime type assertions for testing+description: |+  This package provides a way to make runtime assertions about types that+  cooperate with the typechecker, intended for use in testing. For more+  information, see the module documentation for "Test.TypeAssertions".+maintainer: Alexis King+license: ISC+github: lexi-lambda/type-assertions++extra-source-files:+- LICENSE+- package.yaml+- README.md+- stack.yaml++ghc-options: -Wall++library:+  dependencies:+  - base >= 4.9.0.0 && < 5+  source-dirs: library++tests:+  type-assertions-test-suite:+    dependencies:+    - base+    - hspec+    - test-fixture+    - type-assertions+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: test-suite

@@ -0,0 +1,11 @@+resolver: lts-7.11++packages:+- '.'++extra-deps:+- test-fixture-0.5.0.0++flags: {}++extra-package-dbs: []

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,98 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Test.TypeAssertionsSpec (spec) where++import Test.Hspec+import Test.TypeAssertions++import Control.Exception (evaluate)+import Data.Typeable (Typeable)++import Control.Monad.TestFixture+import Control.Monad.TestFixture.TH++newtype Id a = Id Int+  deriving (Eq, Show, Num)++class (Show a, Typeable a) => DBRecord a++data User = User+  deriving (Eq, Show)+instance DBRecord User++data Post = Post+  deriving (Eq, Show)+instance DBRecord Post++class Monad m => DB m where+  fetchRecord :: DBRecord a => Id a -> m (Maybe a)+  insertRecord :: DBRecord a => a -> m (Maybe (Id a))++mkFixture "Fixture" [ts| DB |]++spec :: Spec+spec = do+  describe "assertEq" $ do+    let fixture :: FixturePure = def {+          _insertRecord = \record -> case assertHasT @Post record of+            Refl -> return $ Just 3 }++    it "produces a witness if the provided value matches the given type" $ do+      let result = unTestFixture (insertRecord Post) fixture+      result `shouldBe` Just 3++    it "throws an exception if the provided value does not match the given type" $ do+      let result = unTestFixture (insertRecord User) fixture+      let message = "expected value of type ‘Post’, but got ‘User’, which is of type ‘User’"+      evaluate result `shouldThrow` errorCall message++  describe "withAssertEq" $ do+    let fixture :: FixturePure = def {+          _insertRecord = \record -> withAssertHasT @Post record $+            return $ Just 3 }++    it "produces a witness if the provided value matches the given type" $ do+      let result = unTestFixture (insertRecord Post) fixture+      result `shouldBe` Just 3++    it "throws an exception if the provided value does not match the given type" $ do+      let result = unTestFixture (insertRecord User) fixture+      let message = "expected value of type ‘Post’, but got ‘User’, which is of type ‘User’"+      evaluate result `shouldThrow` errorCall message++  describe "assertEqT" $ do+    let fixture :: FixturePure = def {+          _fetchRecord = \(_ :: Id record) -> case assertEqT @record @Post of+            Refl -> return $ Just Post }++    it "gains type information when the given types match" $ do+      let result = unTestFixture (fetchRecord 0) fixture+      result `shouldBe` Just Post++    it "throws an exception if the given types do not match" $ do+      let result = unTestFixture (fetchRecord (0 :: Id User)) fixture+      let message = "expected type ‘Post’, but got type ‘User’"+      evaluate result `shouldThrow` errorCall message++  describe "withAssertEqT" $ do+    let fixture :: FixturePure = def {+          _fetchRecord = \(_ :: Id record) -> withAssertEqT @record @Post $+            return $ Just Post }++    it "gains type information when the given types match" $ do+      let result = unTestFixture (fetchRecord 0) fixture+      result `shouldBe` Just Post++    it "throws an exception if the given types do not match" $ do+      let result = unTestFixture (fetchRecord (0 :: Id User)) fixture+      let message = "expected type ‘Post’, but got type ‘User’"+      evaluate result `shouldThrow` errorCall message

@@ -0,0 +1,53 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           type-assertions+version:        0.1.0.0+synopsis:       Runtime type assertions for testing+description:    This package provides a way to make runtime assertions about types that+                cooperate with the typechecker, intended for use in testing. For more+                information, see the module documentation for "Test.TypeAssertions".+category:       Testing+homepage:       https://github.com/lexi-lambda/type-assertions#readme+bug-reports:    https://github.com/lexi-lambda/type-assertions/issues+maintainer:     Alexis King+license:        ISC+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    LICENSE+    package.yaml+    README.md+    stack.yaml++source-repository head+  type: git+  location: https://github.com/lexi-lambda/type-assertions++library+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      base >= 4.9.0.0 && < 5+  exposed-modules:+      Test.TypeAssertions+  default-language: Haskell2010++test-suite type-assertions-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , hspec+    , test-fixture+    , type-assertions+  other-modules:+      Test.TypeAssertionsSpec+  default-language: Haskell2010