├── Setup.hs ├── stack.yaml ├── .gitignore ├── src └── Test │ ├── TypeSpec │ ├── Internal │ │ ├── Equality.hs │ │ ├── Either.hs │ │ ├── Result.hs │ │ └── Apply.hs │ ├── Label.hs │ ├── Group.hs │ ├── Core.hs │ └── ShouldBe.hs │ ├── TypeSpec.hs │ └── TypeSpecCrazy.hs ├── .travis.yml ├── LICENSE ├── README.md ├── type-spec.cabal └── examples └── Main.hs /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.3 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | /TAGS 21 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Internal/Equality.hs: -------------------------------------------------------------------------------- 1 | -- | Type Equality 2 | module Test.TypeSpec.Internal.Equality (type EqExtra) where 3 | 4 | import Data.Type.Equality 5 | 6 | -- | Operator 'Data.Equality.(==)' expects both arguments to have the 7 | -- same kind. 8 | type family EqExtra (a :: ak) (b :: bk) :: Bool where 9 | EqExtra ('Left x) ('Left y) = EqExtra x y 10 | EqExtra ('Right x) ('Right y) = EqExtra x y 11 | EqExtra a a = 'True 12 | EqExtra (a :: k) (b :: k) = a == b 13 | EqExtra a b = 'False 14 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Internal/Either.hs: -------------------------------------------------------------------------------- 1 | -- | Useful abstractions for type level programming using 'Either'. 2 | module Test.TypeSpec.Internal.Either (type FromLeft) where 3 | 4 | import Test.TypeSpec.Internal.Apply 5 | 6 | -- * Either instances for '>>=' 7 | 8 | type instance (>>=) ('Right a) f = Apply f a 9 | type instance (>>=) ('Left b) f = 'Left b 10 | 11 | -- * Either instances for '<$>' 12 | 13 | type instance (<$>) f ('Right a) = 'Right (Apply f a) 14 | type instance (<$>) f ('Left a) = 'Left a 15 | 16 | -- | Return the left type of a promoted 'Either' 17 | type family 18 | FromLeft (e :: Either a b) :: a where 19 | FromLeft ('Left a) = a 20 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | sudo: false 4 | cache: 5 | directories: 6 | - $HOME/.stack/ 7 | 8 | matrix: 9 | include: 10 | - env: CABALVER=1.22 GHCVER=8.0.1 11 | addons: {apt: {packages: [cabal-install-1.22,ghc-8.0.1],sources: [hvr-ghc]}} 12 | 13 | before_install: 14 | - mkdir -p ~/.local/bin 15 | - export PATH=~/.local/bin:$PATH 16 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar -xzO --wildcards '*/stack' > ~/.local/bin/stack 17 | - chmod a+x ~/.local/bin/stack 18 | 19 | install: 20 | - stack -j 2 setup --no-terminal --resolver nightly 21 | - stack -j 2 build --only-snapshot --no-terminal 22 | 23 | script: 24 | - stack -j 2 test --no-terminal 25 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Label.hs: -------------------------------------------------------------------------------- 1 | -- | Labels for expectations. 2 | module Test.TypeSpec.Label 3 | ( It ) 4 | where 5 | 6 | import Data.Kind 7 | import Data.Typeable 8 | import GHC.TypeLits 9 | import Test.TypeSpec.Core 10 | import Test.TypeSpec.Internal.Apply 11 | import Test.TypeSpec.Internal.Either () 12 | import Text.PrettyPrint 13 | 14 | -- | Add a type level string as label or longer descripton around expectations. 15 | -- This is analog to the @it@ function in the @hspec@ package. 16 | data It :: Symbol -> expectation -> Type 17 | 18 | type instance 19 | EvalExpectation (It message expectation) = 20 | PrependToError 21 | ('Text message ':$$: 'Text " ") 22 | (EvalExpectation expectation) 23 | >> (OK (It message expectation)) 24 | 25 | 26 | instance (KnownSymbol msg, PrettyTypeSpec x) => PrettyTypeSpec (It msg x) where 27 | prettyTypeSpec _ = 28 | (text (symbolVal (Proxy :: Proxy msg))) 29 | $$ nest prettyIndentation (prettyTypeSpec (Proxy :: Proxy x)) 30 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Group.hs: -------------------------------------------------------------------------------- 1 | -- | Composed Expectations. 2 | module Test.TypeSpec.Group 3 | ( type (-/-) ) 4 | where 5 | 6 | import Data.Proxy 7 | import Test.TypeSpec.Core 8 | import Test.TypeSpec.Internal.Apply 9 | import Test.TypeSpec.Internal.Either () 10 | import Text.PrettyPrint 11 | 12 | {-| Combine two expectations. 13 | 14 | Make a collection of expectations: 15 | 16 | > (2 + 2) `Is` 4 17 | > -/- 18 | > (4 + 4) `Is` 8 19 | > -/- 20 | > 'True `IsNot` 'False 21 | -} 22 | data expectation1 -/- expectation2 23 | infixr 1 -/- 24 | 25 | type instance 26 | EvalExpectation (expectation -/- expectations) = 27 | TyCon2 (-/-) <$> EvalExpectation expectation <*> EvalExpectation expectations 28 | 29 | -- | Pretty Printing Instance. 30 | instance 31 | ( PrettyTypeSpec expectation1 32 | , PrettyTypeSpec expectation2 ) 33 | => PrettyTypeSpec (expectation1 -/- expectation2) 34 | where 35 | prettyTypeSpec _ = 36 | prettyTypeSpec pe1 $+$ prettyTypeSpec pe2 37 | where pe1 = Proxy :: Proxy expectation1 38 | pe2 = Proxy :: Proxy expectation2 39 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Sven Heyll (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Sven Heyll nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /src/Test/TypeSpec/Internal/Result.hs: -------------------------------------------------------------------------------- 1 | -- | A result type used in constraints inside 'TypeSpec' to chain computations 2 | -- that may fail with a 'TypeError'. 3 | module Test.TypeSpec.Internal.Result 4 | ( 5 | -- * Results that with 'TypeErrors' 6 | type Result 7 | , type FAILED 8 | , type OK 9 | -- * Error propagation 10 | , type Try 11 | , type DontTry 12 | -- * Extending Error Messages 13 | , type PrependToError 14 | ) where 15 | 16 | import GHC.TypeLits 17 | import Data.Kind 18 | import Test.TypeSpec.Internal.Apply () 19 | import Test.TypeSpec.Internal.Either () 20 | 21 | -- | When a type level expectation is tested, it might be that compound 22 | -- expectations fail. In order to have a small, precise error message, the type 23 | -- level assertion results are made to have kind 'Result'. 24 | type Result = Either ErrorMessage 25 | 26 | -- | A nice alias for 'Left' 27 | type OK = 'Right 28 | -- | A nice alias for 'Right' 29 | type FAILED = 'Left 30 | 31 | -- | Return the result or fail with a 'TypeError' 32 | type family 33 | Try (e :: Result k) :: k where 34 | Try (OK (d :: k)) = d 35 | Try (FAILED m) = TypeError m 36 | 37 | -- | A constraint that is satisfied if the parameter is 'Left'. Fails with a 38 | -- 'TypeError' otherwise. 39 | type family 40 | DontTry (e :: Result r) :: Constraint where 41 | DontTry (FAILED e) = () 42 | DontTry (OK okIsNotOk) = 43 | TypeError ('Text "You specified this wasn't okay: " 44 | ':$$: 45 | 'Text " " ':<>: 'ShowType okIsNotOk 46 | ':$$: 47 | 'Text "... turns out it actually is!") 48 | 49 | -- | In case of @'Left' 'ErrorMessage'@ prepend a message to the message, if the 50 | -- parameter was @'Right' x@ just return @'Right' x@. 51 | type family 52 | PrependToError 53 | (message :: ErrorMessage) 54 | (result :: Result a) 55 | :: Result a 56 | where 57 | PrependToError message (OK x) = OK x 58 | PrependToError message (FAILED otherMessage) = 59 | FAILED (message ':<>: otherMessage) 60 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Core.hs: -------------------------------------------------------------------------------- 1 | -- | Core of the TypeSpec abstractions. Import to add custom instances. 2 | module Test.TypeSpec.Core 3 | ( 4 | -- * Core Data Type 5 | TypeSpec (..) 6 | -- * Expectations 7 | , type EvalExpectation 8 | -- * Pretty Printing Support 9 | , PrettyTypeSpec(..) 10 | , prettyIndentation 11 | , module ReExport 12 | ) 13 | where 14 | 15 | import Data.Proxy 16 | import Test.TypeSpec.Internal.Either () 17 | import Test.TypeSpec.Internal.Apply 18 | import Test.TypeSpec.Internal.Result as ReExport 19 | import Text.PrettyPrint 20 | 21 | -- | A type specification. 22 | data TypeSpec expectation where 23 | -- | Expect the given expectations to hold. If the compiler does not reject it - 24 | -- the expectation seem plausible. 25 | Valid :: (Try (EvalExpectation expectation) ~ expectation) 26 | => TypeSpec expectation 27 | -- | Expect the given expectations to **NOT** hold. If the compiler does not 28 | -- reject it - the expectation seem indeed implausible. 29 | Invalid :: (DontTry (EvalExpectation expectation)) 30 | => TypeSpec expectation 31 | 32 | -- | An open family of type level expectation evaluators, that return either @()@ 33 | -- or an @ErrorMessage@. 34 | type family EvalExpectation (expectation :: k) :: Result k 35 | 36 | -- | Given a pair @(expectation1, expectation2)@ try to evaluate the first then, 37 | -- if no error was returned, the second. 38 | type instance EvalExpectation '(a, b) = 39 | Pair'' <$> EvalExpectation a <*> EvalExpectation b 40 | 41 | -- | Given a list @(expectation : rest)@ try to evaluate the @expectation@ then, 42 | -- if no error was returned, the @rest@. 43 | type instance EvalExpectation '[] = OK '[] 44 | type instance EvalExpectation (expectation ': rest) = 45 | Cons'' <$> EvalExpectation expectation <*> EvalExpectation rest 46 | 47 | 48 | -- | A class for pretty printing via the 'Show' instance of 'TypeSpec'. 49 | class PrettyTypeSpec (t :: k) where 50 | prettyTypeSpec :: proxy t -> Doc 51 | 52 | instance PrettyTypeSpec t => Show (TypeSpec t) where 53 | show px@Valid = 54 | render 55 | $ hang (text "Valid:") 5 (prettyTypeSpec px) 56 | show px@Invalid = 57 | render 58 | $ hang (text "Invalid:") 5 (prettyTypeSpec px) 59 | 60 | -- | The default indention to use when 'nest'ing 'Doc'uments. 61 | prettyIndentation :: Int 62 | prettyIndentation = 2 63 | 64 | instance 65 | ( PrettyTypeSpec expectation1 66 | , PrettyTypeSpec expectation2 ) 67 | => PrettyTypeSpec '(expectation1, expectation2) 68 | where 69 | prettyTypeSpec _ = 70 | prettyTypeSpec pe1 <+> prettyTypeSpec pe2 71 | where pe1 = Proxy :: Proxy expectation1 72 | pe2 = Proxy :: Proxy expectation2 73 | 74 | instance 75 | PrettyTypeSpec '[] 76 | where 77 | prettyTypeSpec _ = empty 78 | 79 | instance 80 | ( PrettyTypeSpec expectation 81 | , PrettyTypeSpec rest ) 82 | => PrettyTypeSpec (expectation ': rest) 83 | where 84 | prettyTypeSpec _ = 85 | (prettyTypeSpec pe1) <+> (prettyTypeSpec pe2) 86 | where pe1 = Proxy :: Proxy expectation 87 | pe2 = Proxy :: Proxy rest 88 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/Internal/Apply.hs: -------------------------------------------------------------------------------- 1 | -- | Useful abstractions for type level programming using. This reimplements 2 | -- parts of the singletons library, which is just too heavy of a dependency to 3 | -- carry around, when only three small types are used of it. 4 | module Test.TypeSpec.Internal.Apply where 5 | 6 | import Data.Kind 7 | 8 | -- | Bind to actions. 9 | type family 10 | (>>=) (ma :: monad a) 11 | (f :: a ~> ((monad b) :: Type)) 12 | :: monad b 13 | 14 | -- | Execute one action and then the next, ignore the result of the first. 15 | type (>>) ma mb = ma >>= Const' mb 16 | 17 | -- | Execute an action that returns a function than map function over the result 18 | -- of the next action. 19 | type family 20 | (f :: m (a ~> b)) <*> (ma :: m a) :: m b where 21 | mf <*> mx = mf >>= Apply (Flip (<$>$$)) mx 22 | 23 | -- * Tuple construction 24 | data Pair'' :: a ~> b ~> (a, b) 25 | data Pair' :: a -> b ~> (a, b) 26 | type instance Apply Pair'' x = Pair' x 27 | type instance Apply (Pair' x) y = '(x, y) 28 | 29 | -- * List construction 30 | data Cons'' :: a ~> [a] ~> [a] 31 | data Cons' :: a -> [a] ~> [a] 32 | type instance Apply Cons'' x = Cons' x 33 | type instance Apply (Cons' x) xs = x ': xs 34 | 35 | -- * Convert data types to Partially applicable type functions 36 | data TyCon1 :: (a -> b) -> a ~> b 37 | data TyCon2 :: (a -> b -> c) -> a ~> b ~> c 38 | type instance Apply (TyCon1 f) x = f x 39 | type instance Apply (TyCon2 f) x = (TyCon1 (f x)) 40 | 41 | -- * Execute an action and map a pure function over the result. 42 | data (<$>$$) :: (a ~> b) ~> m a ~> m b 43 | data (<$>$) :: (a ~> b) -> m a ~> m b 44 | type instance Apply (<$>$$) f = (<$>$) f 45 | type instance Apply ((<$>$) f) x = f <$> x 46 | type family 47 | (f :: (a ~> b)) <$> (ma :: m a) :: m b 48 | 49 | -- * Flip Type Functions 50 | data Flip' :: (a ~> b ~> c) ~> b ~> a ~> c 51 | data Flip :: (a ~> b ~> c) -> b ~> a ~> c 52 | data Flip_ :: (a ~> b ~> c) -> b -> a ~> c 53 | type instance Apply Flip' f = Flip f 54 | type instance Apply (Flip f) y = Flip_ f y 55 | type instance Apply (Flip_ f y) x = Flip__ f y x 56 | type family 57 | Flip__ (f :: (a ~> b ~> c)) (y :: b) (x :: a) :: c where 58 | Flip__ f y x = Apply (Apply f x) y 59 | 60 | -- * Type Function composition 61 | data Compose'' :: (b ~> c) ~> (a ~> b) ~> (a ~> c) 62 | data Compose' :: (b ~> c) -> (a ~> b) ~> (a ~> c) 63 | data Compose :: (b ~> c) -> (a ~> b) -> (a ~> c) 64 | type instance Apply Compose'' f = Compose' f 65 | type instance Apply (Compose' f) g = (Compose f g) 66 | type instance Apply (Compose f g) x = Compose_ f g x 67 | type family 68 | Compose_ (f :: b ~> c) (g :: a ~> b) (x :: a) :: c where 69 | Compose_ f g x = Apply f (Apply g x) 70 | 71 | 72 | -- * Type-Level 'const' 73 | type family Const (a :: t) (b :: t') :: t where Const a b = a 74 | data Const' :: a -> (b ~> a) 75 | data Const'' :: a ~> (b ~> a) 76 | type instance Apply Const'' a = Const' a 77 | type instance Apply (Const' a) b = Const a b 78 | 79 | -- * Defunctionalization 80 | data TyFun :: Type -> Type -> Type 81 | type a ~> b = TyFun a b -> Type 82 | infixr 0 ~> 83 | type family Apply (f :: a ~> b) (x :: a) :: b 84 | -------------------------------------------------------------------------------- /src/Test/TypeSpec.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Test.TypeSpec 3 | Description : Type-Level eDSL for Type-Unit-Tests 4 | Copyright : (c) Sven Heyll, 2016 5 | License : BSD-3 6 | Maintainer : sven.heyll@gmail.com 7 | Stability : experimental 8 | 9 | A tiny EDSL to write type-level-unit tests. 10 | 11 | A simple example: 12 | 13 | > specHelloWorld :: Expect (Int `Isn't` Bool) 14 | > specHelloWorld = Valid 15 | 16 | We can also /expect/ a bit more using lists and tuples: 17 | 18 | > specGrouped 19 | > :: Expect '[ Int `Isn't` Bool 20 | > , Int `Is` Int 21 | > , Bool `Is` Bool `ButNot` String 22 | > ] 23 | > specGrouped = Valid 24 | 25 | The expectations are /executed/ by the compiler when solving the constraints of 26 | 'TypeSpec's constructors. 27 | 28 | A 'TypeSpec' also has a 'Show' instance, which can be used in real unit tests 29 | to print the expectations. 30 | 31 | This module contains mainly re-exports of. 32 | 33 | * "Test.TypeSpec.Core" 34 | 35 | * "Test.TypeSpec.Group" 36 | 37 | * "Test.TypeSpec.Label" 38 | 39 | * "Test.TypeSpec.ShouldBe" 40 | 41 | -} 42 | module Test.TypeSpec 43 | ( 44 | -- * 'TypeSpec' Aliases 45 | 46 | type Expect, 47 | type Explain, 48 | 49 | -- * 'ShouldBe' aliases 50 | 51 | type Is, 52 | type IsTheSameAs, 53 | type TheseAreEqual, 54 | 55 | -- * 'ShouldNotBe' aliases 56 | 57 | type IsNot, 58 | type Isn't, 59 | type IsNotTheSameAs, 60 | type IsDifferentFrom, 61 | type TheseAreNotEqual, 62 | 63 | -- * 'ShouldBeTrue' aliases 64 | 65 | type IsTrue, 66 | type And, 67 | type Therefore, 68 | type That, 69 | 70 | -- * 'ShouldBeFalse' aliases 71 | 72 | type IsFalse, 73 | type Not, 74 | 75 | -- * Labelling Aliases 76 | 77 | type They, 78 | type Describe, 79 | type Context, 80 | type It's, 81 | 82 | -- * Reexports 83 | 84 | module Test.TypeSpec.Core, 85 | module Test.TypeSpec.Group, 86 | module Test.TypeSpec.Label, 87 | module Test.TypeSpec.ShouldBe 88 | 89 | ) 90 | where 91 | 92 | import Test.TypeSpec.Core 93 | import Test.TypeSpec.Group 94 | import Test.TypeSpec.Label 95 | import Test.TypeSpec.ShouldBe 96 | 97 | -- * 'TypeSpec' Aliases 98 | 99 | type Expect = TypeSpec 100 | type Explain does this = TypeSpec (It does this) 101 | 102 | -- * 'ShouldBe' aliases 103 | 104 | type Is = ShouldBe 105 | type IsTheSameAs = ShouldBe 106 | type TheseAreEqual = ShouldBe 107 | 108 | -- * 'ShouldNotBe' aliases 109 | 110 | type IsNot = ShouldNotBe 111 | type Isn't = ShouldNotBe 112 | type IsNotTheSameAs = ShouldNotBe 113 | type IsDifferentFrom = ShouldNotBe 114 | type TheseAreNotEqual = ShouldNotBe 115 | 116 | -- * 'ShouldBeTrue' aliases 117 | 118 | type IsTrue = ShouldBeTrue 119 | type And = ShouldBeTrue 120 | type Therefore = ShouldBeTrue 121 | type That = ShouldBeTrue 122 | 123 | -- * 'ShouldBeFalse' aliases 124 | 125 | type IsFalse = ShouldBeFalse 126 | type Not = ShouldBeTrue 127 | 128 | -- * Labelling Aliases 129 | 130 | type They message expectations = It message expectations 131 | type Describe = It 132 | type Context = It 133 | type It's = It 134 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [![Build Status](https://travis-ci.org/sheyll/type-spec.svg?branch=master)](https://travis-ci.org/sheyll/type-spec) 3 | 4 | [![Hackage](https://img.shields.io/badge/type-spec-green.svg?style=flat)](http://hackage.haskell.org/package/type-spec) 5 | 6 | 7 | # A tiny EDSL to write type-level-unit tests. 8 | 9 | 10 | A small example: 11 | 12 | import Test.TypeSpec 13 | 14 | main :: IO () 15 | main = print spec0 16 | 17 | spec :: Expect "Expect something..." (Int `Isn't` Bool) 18 | spec = Valid 19 | 20 | This will output: 21 | 22 | Valid: 23 | Expect something... 24 | (✓ Different) 25 | 26 | Using the operators from _TypeSpecCrazy_: 27 | 28 | specCrazy :: 29 | 30 | "Higher kinded assertions" 31 | ########################### 32 | 33 | "ShouldBe accepts types of kind * -> *" 34 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 35 | 36 | ShouldBe Maybe Maybe 37 | -* ShouldBe [] [] 38 | -* ShouldBe (->) (->) 39 | 40 | specCrazy = Valid 41 | main = print specCrazy 42 | 43 | The output: 44 | 45 | Valid: 46 | Higher kinded assertions 47 | ShouldBe accepts types of kind * -> * 48 | (✓ Equal) 49 | (✓ Equal) 50 | (✓ Equal) 51 | 52 | If you like Lisp, this might be for you: 53 | 54 | type ALot = 1000 55 | 56 | specAliases :: 57 | (Explain "There are a variety aliases for the basic combinators." 58 | (Context "Basic Combinators" 59 | (Describe "Context" 60 | (It "labels expectations using 'It'" 61 | (Describe "Describe" 62 | (It's "an alias for It, just like They" 63 | (It's "time for the first assertion" 64 | (1000 `Is` ALot)))))))) 65 | specAliases = Valid 66 | 67 | main = print specAliases 68 | 69 | This will output: 70 | 71 | Valid: 72 | There are a variety aliases for the basic combinators. 73 | Basic Combinators 74 | Context 75 | labels expectations using 'It' 76 | Describe 77 | an alias for It, just like They 78 | time for the first assertion 79 | (✓ Equal) 80 | 81 | The key feature is that the compiler checks the assertions and expectations made 82 | in a 'TypeSpec' and right away rejects invalid types. 83 | 84 | When compiling this example: 85 | 86 | specFailing :: 87 | TypeSpec 88 | (It "counts the number of elements in a tuple" 89 | (Count ((),(),()) `ShouldBe` 4)) 90 | specFailing = Valid 91 | 92 | type family Count a :: Nat where 93 | Count (a,b) = 2 94 | Count (a,b,c) = 3 95 | Count (a,b,c,d) = 4 96 | 97 | The compiler complains: 98 | 99 | error: 100 | • counts the number of elements in a tuple 101 | Expected type: 3 102 | Actual type: 4 103 | • In the expression: Valid 104 | In an equation for ‘specFailing’: specFailing = Valid 105 | 106 | 107 | After all, with `TypeError` GHC is quite a test-runner. 108 | 109 | If you accept to defer type checking and have invalid specs checked during test execution, use 110 | (should-not-typecheck)[https://github.com/CRogers/should-not-typecheck]. 111 | -------------------------------------------------------------------------------- /src/Test/TypeSpec/ShouldBe.hs: -------------------------------------------------------------------------------- 1 | -- | Type level assertions on type equality. 2 | module Test.TypeSpec.ShouldBe 3 | ( ShouldBe 4 | , ShouldNotBe 5 | , ShouldBeTrue 6 | , ShouldBeFalse 7 | , ButNot 8 | ) 9 | where 10 | 11 | import Data.Kind 12 | import Data.Type.Bool 13 | import GHC.TypeLits 14 | import Test.TypeSpec.Core 15 | import Test.TypeSpec.Internal.Apply () 16 | import Test.TypeSpec.Internal.Either () 17 | import Test.TypeSpec.Internal.Equality 18 | import Text.PrettyPrint 19 | 20 | -- | State that a type is equal to the type level @True@. 21 | data ShouldBeTrue :: expectation -> Type 22 | 23 | type instance EvalExpectation (ShouldBeTrue t) = 24 | If (EqExtra t 'True) 25 | (OK (ShouldBeTrue t)) 26 | (FAILED 27 | ('Text "Should have been 'True: " ':<>: 'ShowType t)) 28 | 29 | -- | State that a type is equal to the type level @False@. 30 | data ShouldBeFalse :: expectation -> Type 31 | 32 | type instance EvalExpectation (ShouldBeFalse t) = 33 | If (EqExtra t 'False) 34 | (OK (ShouldBeFalse t)) 35 | (FAILED 36 | ('Text "Should have been 'False: " ':<>: 'ShowType t)) 37 | 38 | -- | State that one type is different to two other types. This must always be 39 | -- used right next to a 'ShouldBe' pair, otherwise this will not work. 40 | data ButNot :: shouldBe -> shouldntBe -> Type 41 | 42 | type instance 43 | EvalExpectation (ButNot (ShouldBe actual expected) other) = 44 | If (EqExtra actual expected) 45 | (If (EqExtra other expected) 46 | (FAILED 47 | ('Text "Expected type: " 48 | ':$$: 'Text " " ':<>: 'ShowType expected 49 | ':$$: 'Text "to be different from: " 50 | ':$$: 'Text " " ':<>: 'ShowType other)) 51 | (OK (ButNot (ShouldBe actual expected) other))) 52 | (FAILED 53 | ('Text "Expected type: " ':<>: 'ShowType expected 54 | ':$$: 'Text "Actual type: " ':<>: 'ShowType actual)) 55 | 56 | -- | State that two types or type constructs are boiled down to the same type. 57 | data ShouldBe :: actual -> expected -> Type 58 | 59 | type instance 60 | EvalExpectation (ShouldBe actual expected) = 61 | If (EqExtra actual expected) 62 | (OK (ShouldBe actual expected)) 63 | (FAILED 64 | ('Text "Expected type: " ':<>: 'ShowType expected 65 | ':$$: 'Text "Actual type: " ':<>: 'ShowType actual)) 66 | 67 | -- | State that two types or type constructs are NOT the same type. 68 | data ShouldNotBe :: actual -> expected -> Type 69 | 70 | type instance 71 | EvalExpectation (ShouldNotBe actual expected) = 72 | If (EqExtra expected actual) 73 | (FAILED 74 | ('Text "Expected type: " 75 | ':$$: 'Text " " ':<>: 'ShowType expected 76 | ':$$: 'Text "to be different from: " 77 | ':$$: 'Text " " ':<>: 'ShowType actual)) 78 | (OK (ShouldNotBe actual expected)) 79 | 80 | instance PrettyTypeSpec (ShouldBeTrue a) where 81 | prettyTypeSpec _px = 82 | prettyCheck "True" 83 | 84 | instance PrettyTypeSpec (ShouldBeFalse a) where 85 | prettyTypeSpec _px = 86 | prettyCheck "False" 87 | 88 | instance PrettyTypeSpec (ShouldBe a b) where 89 | prettyTypeSpec _px = 90 | prettyCheck "Equal" 91 | 92 | instance PrettyTypeSpec (ShouldNotBe a b) where 93 | prettyTypeSpec _px = 94 | prettyCheck "Different" 95 | 96 | instance 97 | (a ~ (ShouldBe a0 a1)) 98 | => PrettyTypeSpec (ButNot a b) where 99 | prettyTypeSpec _ = 100 | prettyCheck "Restricted" 101 | 102 | -- | Pretty print a test prefix by a bullet-point. 103 | prettyCheck :: String -> Doc 104 | prettyCheck doc = parens (text "OK" <+> text doc) 105 | -------------------------------------------------------------------------------- /type-spec.cabal: -------------------------------------------------------------------------------- 1 | name: type-spec 2 | version: 0.4.0.0 3 | synopsis: Type Level Specification by Example 4 | description: Please see README.md 5 | homepage: https://github.com/sheyll/type-spec#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Sven Heyll 9 | maintainer: sven.heyll@gmail.com 10 | copyright: 2016-2019 Sven Heyll 11 | category: Testing 12 | build-type: Simple 13 | extra-source-files: examples/Main.hs 14 | , README.md 15 | , stack.yaml 16 | , .travis.yml 17 | cabal-version: >=1.10 18 | 19 | library 20 | hs-source-dirs: src 21 | exposed-modules: Test.TypeSpec 22 | , Test.TypeSpecCrazy 23 | , Test.TypeSpec.Core 24 | , Test.TypeSpec.Group 25 | , Test.TypeSpec.Label 26 | , Test.TypeSpec.ShouldBe 27 | , Test.TypeSpec.Internal.Apply 28 | , Test.TypeSpec.Internal.Either 29 | , Test.TypeSpec.Internal.Equality 30 | , Test.TypeSpec.Internal.Result 31 | build-depends: base >= 4.9 && < 5 32 | , pretty >= 1.1.3 && < 1.2 33 | default-language: Haskell2010 34 | default-extensions: ConstraintKinds 35 | , CPP 36 | , DataKinds 37 | , DefaultSignatures 38 | , DeriveDataTypeable 39 | , DeriveFunctor 40 | , DeriveGeneric 41 | , FlexibleInstances 42 | , FlexibleContexts 43 | , FunctionalDependencies 44 | , GADTs 45 | , GeneralizedNewtypeDeriving 46 | , KindSignatures 47 | , MultiParamTypeClasses 48 | , OverloadedStrings 49 | , PolyKinds 50 | , QuasiQuotes 51 | , RecordWildCards 52 | , RankNTypes 53 | , ScopedTypeVariables 54 | , StandaloneDeriving 55 | , TemplateHaskell 56 | , TupleSections 57 | , TypeFamilies 58 | , TypeInType 59 | , TypeOperators 60 | , TypeSynonymInstances 61 | , UndecidableInstances 62 | ghc-options: -Wall 63 | 64 | test-suite examples 65 | type: exitcode-stdio-1.0 66 | ghc-options: -Wall 67 | hs-source-dirs: examples 68 | main-is: Main.hs 69 | build-depends: base >= 4.9 && < 5 70 | , type-spec 71 | default-language: Haskell2010 72 | default-extensions: ConstraintKinds 73 | , CPP 74 | , DataKinds 75 | , DefaultSignatures 76 | , DeriveDataTypeable 77 | , DeriveFunctor 78 | , DeriveGeneric 79 | , FlexibleInstances 80 | , FlexibleContexts 81 | , FunctionalDependencies 82 | , GADTs 83 | , GeneralizedNewtypeDeriving 84 | , KindSignatures 85 | , MultiParamTypeClasses 86 | , OverloadedStrings 87 | , QuasiQuotes 88 | , RecordWildCards 89 | , RankNTypes 90 | , ScopedTypeVariables 91 | , StandaloneDeriving 92 | , TemplateHaskell 93 | , TupleSections 94 | , TypeFamilies 95 | , TypeInType 96 | , TypeOperators 97 | , TypeSynonymInstances 98 | 99 | source-repository head 100 | type: git 101 | location: https://github.com/sheyll/type-spec 102 | -------------------------------------------------------------------------------- /examples/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Some examples for 'Test.TypeSpec' 2 | module Main where 3 | 4 | import GHC.TypeLits 5 | import Test.TypeSpecCrazy 6 | 7 | main :: IO () 8 | main = do 9 | print specHelloWorld 10 | print specGrouped 11 | print specAliases 12 | print specTuple 13 | print specFamilyInstancesSuperCrazy 14 | print spec1 15 | print specCrazy 16 | print specInvalidCrazy 17 | print specCrazyMoreNested 18 | 19 | -- * TypeSpec Examples 20 | 21 | -- | Let's start off simple: 22 | specHelloWorld :: Explain "Expect something..." (Int `Isn't` Bool) 23 | specHelloWorld = Valid 24 | 25 | -- | We can also expect a bit more using lists and tuples: 26 | specGrouped 27 | :: Expect '[ Int `Isn't` Bool 28 | , Int `Is` Int 29 | , Bool `Is` Bool `ButNot` String 30 | ] 31 | specGrouped = Valid 32 | 33 | specTuple :: 34 | Explain "Type level tuples can also be used to group tests." 35 | (They "accept only two elments" 36 | '( (5 - 4) `Is` 1, (3 + 3) `Is` 6 `ButNot` (3 - 3) ) ) 37 | specTuple = Valid 38 | 39 | -- * Some nice aliases 40 | 41 | type ALot = 1000 42 | 43 | specAliases :: 44 | (Explain "There are a variety aliases for the basic combinators." 45 | (Context "Basic Combinators" 46 | (Describe "Context" 47 | (It "labels expectations using 'It'" 48 | (Describe "Describe" 49 | (It's "an alias for It, just like They" 50 | (It's "time for the first assertion" 51 | (1000 `Is` ALot)))))))) 52 | specAliases = Valid 53 | 54 | 55 | -- * More complex example 56 | 57 | type family Swap a 58 | type instance Swap (a,b) = (b,a) 59 | 60 | type family SwapT (a :: (k1, k2)) :: (k2, k1) 61 | type instance SwapT '(a,b) = '(b,a) 62 | 63 | type family Fst a where 64 | Fst (a,b) = a 65 | 66 | type family Count a :: Nat where 67 | Count (a,b) = 2 68 | Count (a,b,c) = 3 69 | Count (a,b,c,d) = 4 70 | 71 | -- A failing test case example: 72 | -- specFailing :: 73 | -- TypeSpec 74 | -- (It "counts the number of elements in a tuple" 75 | -- (Count ((),(),()) `ShouldBe` 4)) 76 | -- specFailing = Valid 77 | 78 | specFamilyInstancesSuperCrazy :: 79 | 80 | "Only one title like this" 81 | ########################### 82 | 83 | "Describe the following expectations" 84 | 85 | --* Swap (Int, Bool) `Isn't` (Int, Int) 86 | -* Swap (Int, Bool) `Is` (Bool, Int) 87 | -* Swap (Int, Bool) `Isn't` Swap (Swap (Int, Bool)) 88 | -* (Int, Bool) `Is` Swap (Swap (Int, Bool)) 89 | -* 90 | ("... now there is maybe a nested block" 91 | 92 | --* Count (Int,Int,Int,Int) `ShouldBe` 4 93 | -* SwapT '(0,1) `ShouldBe` '(1,0) 94 | -* And (Count (Int,Int,Int) <=? 4)) 95 | 96 | -/- 97 | 98 | "Here there is another top-level block" 99 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 100 | 101 | [ Count (Int,Int,Int,Int) `Is` 4 102 | , SwapT '(0,1) `Is` '(1,0) 103 | , And (Count (Int,Int,Int) <=? 4) 104 | ] 105 | 106 | 107 | specFamilyInstancesSuperCrazy = Valid 108 | 109 | -- * More examples 110 | 111 | spec1 :: 112 | Explain "TypeSpec" 113 | (It "Allows explanations of types" (ShouldBe Int Int)) 114 | spec1 = Valid 115 | 116 | specCrazy :: 117 | 118 | "Higher kinded assertions" 119 | ########################### 120 | 121 | "ShouldBe accepts types of kind * -> *" 122 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 123 | 124 | ShouldBe Maybe Maybe 125 | -* ShouldBe [] [] 126 | -* ShouldBe (->) (->) 127 | 128 | specCrazy = Valid 129 | 130 | -- -------------------------------------------------------- 131 | 132 | type SpecInvalidCrazy = 133 | 134 | "One of the following specs is not OK" 135 | ####################################### 136 | 137 | "This should be ok" 138 | ~~~~~~~~~~~~~~~~~~~~~ 139 | 140 | TheseAreEqual Bool Bool 141 | 142 | -/- 143 | 144 | "This should also be ok" 145 | ~~~~~~~~~~~~~~~~~~~~~~~~ 146 | 147 | TheseAreNotEqual (Maybe Int) (Maybe Int) 148 | 149 | -/- 150 | 151 | "But this looks bad:" 152 | ~~~~~~~~~~~~~~~~~~~~~ 153 | 154 | TheseAreEqual Maybe (Either Int) 155 | 156 | specInvalidCrazy :: SpecInvalidCrazy 157 | specInvalidCrazy = Invalid 158 | 159 | 160 | specCrazyMoreNested :: 161 | 162 | "Title" 163 | ###### 164 | 165 | "Top-level " 166 | ~~~~~~~~~~~~ 167 | 168 | "Nested:" 169 | ~~~~~~~~~ 170 | Int `Is` Int 171 | -*- 172 | Int `Is` Int 173 | -*- 174 | Int `Is` Int 175 | 176 | -/- 177 | 178 | "Top-level " 179 | ~~~~~~~~~~~~ 180 | 181 | "Nested:" 182 | ~~~~~~~~~ 183 | Int `Is` Int 184 | -*- 185 | "Nested:" 186 | ~~~~~~~~~ 187 | Int `Is` Int 188 | -*- 189 | Int `Is` Int 190 | 191 | specCrazyMoreNested = Valid 192 | -------------------------------------------------------------------------------- /src/Test/TypeSpecCrazy.hs: -------------------------------------------------------------------------------- 1 | -- | Funny operators that are mere type aliases for the constructs in 'TypeSpec' 2 | module Test.TypeSpecCrazy 3 | ( 4 | -- * Crazy Type operators for 'It' 5 | type (--*) 6 | , type (~~~) 7 | , type (~~~~~~) 8 | , type (~~~~~~~~~) 9 | , type (~~~~~~~~~~~~) 10 | , type (~~~~~~~~~~~~~~~) 11 | , type (~~~~~~~~~~~~~~~~~~) 12 | , type (~~~~~~~~~~~~~~~~~~~~~) 13 | , type (~~~~~~~~~~~~~~~~~~~~~~~~) 14 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~) 15 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 16 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 17 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 18 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 19 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 20 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 21 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 22 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 23 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 24 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 25 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 26 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 27 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 28 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 29 | , type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) 30 | -- * Crazy Type operators for 'TypeSpec' 31 | , type (###) 32 | , type (######) 33 | , type (#########) 34 | , type (############) 35 | , type (###############) 36 | , type (##################) 37 | , type (#####################) 38 | , type (########################) 39 | , type (###########################) 40 | , type (##############################) 41 | , type (#################################) 42 | , type (####################################) 43 | , type (#######################################) 44 | , type (##########################################) 45 | , type (#############################################) 46 | , type (################################################) 47 | , type (###################################################) 48 | , type (######################################################) 49 | , type (#########################################################) 50 | , type (############################################################) 51 | , type (###############################################################) 52 | , type (##################################################################) 53 | , type (#####################################################################) 54 | , type (########################################################################) 55 | 56 | -- * Grouping Aliases 57 | , type (-*) 58 | , type (-*-) 59 | 60 | , module ReExport) 61 | where 62 | 63 | import Test.TypeSpec as ReExport 64 | 65 | {-| Alias for 'It', note that the number of @~@s is alway a multiple of 3. This 66 | provides the impression of an underlined title followed by other expectations. 67 | 68 | It allows to write the following type: 69 | 70 | > 71 | > type ExpectationWithTitle = 72 | > TypeSpec ( 73 | > 74 | > "This is a title for some assertions:" 75 | > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 76 | > 77 | > (2 + 2) `Is` 4 78 | > 79 | > ) 80 | -} 81 | type (--*) title expr = It title expr 82 | type (~~~) title expr = It title expr 83 | type (~~~~~~) title expr = It title expr 84 | type (~~~~~~~~~) title expr = It title expr 85 | type (~~~~~~~~~~~~) title expr = It title expr 86 | type (~~~~~~~~~~~~~~~) title expr = It title expr 87 | type (~~~~~~~~~~~~~~~~~~) title expr = It title expr 88 | type (~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 89 | type (~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 90 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 91 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 92 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 93 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 94 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr 95 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 96 | It title expr 97 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 98 | It title expr 99 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 100 | It title expr 101 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 102 | It title expr 103 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 104 | It title expr 105 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 106 | It title expr 107 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 108 | It title expr 109 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 110 | It title expr 111 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 112 | It title expr 113 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 114 | It title expr 115 | type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = 116 | It title expr 117 | 118 | infixr 3 --* 119 | infixr 3 ~~~ 120 | infixr 3 ~~~~~~ 121 | infixr 3 ~~~~~~~~~ 122 | infixr 3 ~~~~~~~~~~~~ 123 | infixr 3 ~~~~~~~~~~~~~~~ 124 | infixr 3 ~~~~~~~~~~~~~~~~~~ 125 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~ 126 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~ 127 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 128 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 129 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 130 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 131 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 132 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 133 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 134 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 135 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 137 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 139 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 140 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 141 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 142 | infixr 3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 143 | 144 | {-| Create a 'TypeSpec' with an initial description or title followed by some 145 | expectations. Note that the number of @#@s is alway a multiple of 3. 146 | 147 | It allows to rewrite the example above in a shorter way: 148 | 149 | > 150 | > type ExpectationWithTitleShorter = 151 | > 152 | > "This is a title for some assertions:" 153 | > ###################################### 154 | > 155 | > (2 + 2) `Is` 4 156 | > 157 | 158 | -} 159 | type (###) title expr = Explain title expr 160 | type (######) title expr = Explain title expr 161 | type (#########) title expr = Explain title expr 162 | type (############) title expr = Explain title expr 163 | type (###############) title expr = Explain title expr 164 | type (##################) title expr = Explain title expr 165 | type (#####################) title expr = Explain title expr 166 | type (########################) title expr = Explain title expr 167 | type (###########################) title expr = Explain title expr 168 | type (##############################) title expr = Explain title expr 169 | type (#################################) title expr = Explain title expr 170 | type (####################################) title expr = Explain title expr 171 | type (#######################################) title expr = Explain title expr 172 | type (##########################################) title expr = 173 | Explain title expr 174 | type (#############################################) title expr = 175 | Explain title expr 176 | type (################################################) title expr = 177 | Explain title expr 178 | type (###################################################) title expr = 179 | Explain title expr 180 | type (######################################################) title expr = 181 | Explain title expr 182 | type (#########################################################) title expr = 183 | Explain title expr 184 | type (############################################################) title expr = 185 | Explain title expr 186 | type (###############################################################) title expr = 187 | Explain title expr 188 | type (##################################################################) title expr = 189 | Explain title expr 190 | type (#####################################################################) title expr = 191 | Explain title expr 192 | type (########################################################################) title expr = 193 | Explain title expr 194 | 195 | infixr 1 ### 196 | infixr 1 ###### 197 | infixr 1 ######### 198 | infixr 1 ############ 199 | infixr 1 ############### 200 | infixr 1 ################## 201 | infixr 1 ##################### 202 | infixr 1 ######################## 203 | infixr 1 ########################### 204 | infixr 1 ############################## 205 | infixr 1 ################################# 206 | infixr 1 #################################### 207 | infixr 1 ####################################### 208 | infixr 1 ########################################## 209 | infixr 1 ############################################# 210 | infixr 1 ################################################ 211 | infixr 1 ################################################### 212 | infixr 1 ###################################################### 213 | infixr 1 ######################################################### 214 | infixr 1 ############################################################ 215 | infixr 1 ############################################################### 216 | infixr 1 ################################################################## 217 | infixr 1 ##################################################################### 218 | infixr 1 ######################################################################## 219 | 220 | {-| Crazy operator alias for '-/-' with higher precedence. 221 | 222 | It allows to group expectations more beautiful than using type level lists. 223 | 224 | > specCrazyMoreNested :: 225 | > 226 | > "Title" 227 | > ###### 228 | > 229 | > "Top-level " 230 | > ~~~~~~~~~~~~ 231 | > 232 | > "Nested:" 233 | > ~~~~~~~~~ 234 | > Int `Is` Int 235 | > -*- 236 | > Int `Is` Int 237 | > -*- 238 | > Int `Is` Int 239 | > 240 | > -/- 241 | > 242 | > "Top-level " 243 | > ~~~~~~~~~~~~ 244 | > 245 | > "Nested:" 246 | > ~~~~~~~~~ 247 | > Int `Is` Int 248 | > -*- 249 | > "Nested:" 250 | > ~~~~~~~~~ 251 | > Int `Is` Int 252 | > -*- 253 | > Int `Is` Int 254 | > 255 | > specCrazyMoreNested = Valid 256 | 257 | -} 258 | type expectation1 -*- expectation2 = expectation1 -/- expectation2 259 | infixr 3 -*- 260 | 261 | -- | Crazy operator alias for '-/-'. 262 | -- 263 | -- Make a list of expectations. The precedence of this operator is even higher 264 | -- than that of '-*-'. 265 | type expectation1 -* expectation2 = expectation1 -/- expectation2 266 | infixr 4 -* 267 | --------------------------------------------------------------------------------