packages feed

type-spec (empty) → 0.1.0.0

raw patch · 14 files changed

+985/−0 lines, 14 filesdep +basedep +prettydep +show-typesetup-changed

Dependencies added: base, pretty, show-type, type-spec

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Sven Heyll (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Sven Heyll nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Main.hs view
@@ -0,0 +1,157 @@+-- | Some examples for 'Test.TypeSpec'+module Main where++import Data.Kind+import GHC.TypeLits+import Test.TypeSpecCrazy++main :: IO ()+main = do+  print specHelloWorld+  print specGrouped+  print specAliases+  print specTuple+  print specFamilyInstancesSuperCrazy+  print spec1+  print specCrazy+  print specInvalidCrazy++-- * TypeSpec Examples++-- | Let's start off simple:+specHelloWorld :: Expect (Int `Isn't` Bool)+specHelloWorld = Valid++-- | We can also expect a bit more using lists and tuples:+specGrouped+  :: Expect '[ Int  `Isn't` Bool+             , Int  `Is`    Int+             , Bool `Is`    Bool  `ButNot`  String+             ]+specGrouped = Valid++specTuple ::+  Explain "Type level tuples can also be used to group tests."+    (They "accept only two elments"+      '( (5 - 4) `Is` 1, (3 + 3) `Is` 6 `ButNot` (3 - 3) ) )+specTuple = Valid++-- * Some nice aliases++type ALot = 1000++specAliases ::+  (Explain "There are a variety aliases for the basic combinators."+    (Context "Basic Combinators"+      (Describe "Context"+        (It "labels expectations using 'It'"+          (Describe "Describe"+            (It's "an alias for It, just like They"+              (It's "time for the first assertion"+                (1000 `Is` ALot))))))))+specAliases = Valid+++-- * More complex example++type family Swap a+type instance Swap (a,b) = (b,a)++type family SwapT (a :: (k1, k2)) :: (k2, k1)+type instance SwapT '(a,b) = '(b,a)++type family Fst a where+  Fst (a,b) = a++type family Count a :: Nat where+  Count (a,b) = 2+  Count (a,b,c) = 3+  Count (a,b,c,d) = 4++-- A failing test case example:+-- specFailing ::+--     TypeSpec+--       (It "counts the number of elements in a tuple"+--           (Count ((),(),()) `ShouldBe` 4))+-- specFailing = Valid++specFamilyInstancesSuperCrazy ::++    "Only one title like this"+    ###########################++    "Describe the following expectations"++     --* Swap (Int, Bool) `Isn't` (Int, Int)+      -* Swap (Int, Bool) `Is`    (Bool, Int)+      -* Swap (Int, Bool) `Isn't` Swap (Swap (Int, Bool))+      -* (Int, Bool)      `Is`    Swap (Swap (Int, Bool))+      -*+         ("... now there is maybe a nested block"++           --* Count    (Int,Int,Int,Int) `ShouldBe`      4+            -* SwapT               '(0,1) `ShouldBe` '(1,0)+            -* And   (Count (Int,Int,Int)     <=?         4))++    -/-++    "Here there is another top-level block"+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++     [ Count (Int,Int,Int,Int)    `Is`  4+     , SwapT '(0,1)               `Is`  '(1,0)+     , And   (Count (Int,Int,Int)  <=?   4)+     ]+++specFamilyInstancesSuperCrazy = Valid++-- * More examples++spec1 ::+  Explain "TypeSpec"+    (It "Allows explanations of types"  (ShouldBe Int Int))+spec1 = Valid++specCrazy ::++    "Higher kinded assertions"+   ###########################++   "ShouldBe accepts types of kind * -> *"+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++       ShouldBe  Maybe Maybe+    -* ShouldBe  []    []+    -* ShouldBe  (->)  (->)++specCrazy = Valid++-- --------------------------------------------------------++type SpecInvalidCrazy =++  "One of the following specs is not OK"+ #######################################++ "This should be ok"+ ~~~~~~~~~~~~~~~~~~~~~++ TheseAreEqual    Bool Bool++ -/-++ "This should also be ok"+ ~~~~~~~~~~~~~~~~~~~~~~~~++ TheseAreNotEqual (Maybe Int) (Maybe Int)++ -/-++ "But this looks bad:"+ ~~~~~~~~~~~~~~~~~~~~~++ TheseAreEqual    Maybe (Either Int)++specInvalidCrazy :: SpecInvalidCrazy+specInvalidCrazy = Invalid
+ src/Test/TypeSpec.hs view
@@ -0,0 +1,66 @@+-- | A tiny EDSL to write type-level-unit tests.+module Test.TypeSpec+  ( type Expect+  , type Explain+  , type It's+  , type IsTheSameAs+  , type Is+  , type TheseAreEqual+  , type IsNot+  , type Isn't+  , type IsNotTheSameAs+  , type IsDifferentFrom+  , type TheseAreNotEqual+  , type IsTrue+  , type Therefore+  , type And+  , type IsFalse+  , type They+  , type Describe+  , type Context+  , module ReExport)+  where++import Test.TypeSpec.Core as ReExport+import Test.TypeSpec.Group as ReExport+import Test.TypeSpec.Label as ReExport+import Test.TypeSpec.ShouldBe as ReExport++-- * 'TypeSpec' Aliases++-- | An alias for 'TypeSpec'.+type Expect = TypeSpec++-- | Another alias for 'TypeSpec' (and also 'It')+type Explain does this = TypeSpec (It does this)++-- * 'ShouldBe' aliases++type Is = ShouldBe+type IsTheSameAs = ShouldBe+type TheseAreEqual = ShouldBe++-- * 'ShouldNotBe' aliases++type IsNot = ShouldNotBe+type Isn't = ShouldNotBe+type IsNotTheSameAs = ShouldNotBe+type IsDifferentFrom = ShouldNotBe+type TheseAreNotEqual = ShouldNotBe++-- * 'ShouldBeTrue' aliases++type IsTrue = ShouldBeTrue+type And = ShouldBeTrue+type Therefore = ShouldBeTrue++-- * 'ShouldBeFalse' aliases++type IsFalse = ShouldBeFalse++-- * Labelling Aliases++type They message expectations = It message expectations+type Describe = It+type Context = It+type It's = It
+ src/Test/TypeSpec/Core.hs view
@@ -0,0 +1,106 @@+-- | Core of the TypeSpec abstractions. Import to add custom instances.+module Test.TypeSpec.Core+  ( TypeSpec (..)+  , type EvalExpectation+  , PrettyTypeSpec(..)+  , prettyIndentation+  , nest'+  , sentence+  , module ReExport+  )+  where++import Data.Proxy+import Test.TypeSpec.Internal.Either ()+import Test.TypeSpec.Internal.Apply+import Test.TypeSpec.Internal.Result as ReExport+import Text.PrettyPrint++-- * Type Level Specifcations++-- | A type specification.+data TypeSpec expectation  where+  -- | Expect the given expectations to hold. If the compiler does not reject it -+  -- the expectation seem plausible.+  Valid :: (Try (EvalExpectation expectation) ~ expectation)+        => TypeSpec expectation+  -- | Expect the given expectations to **NOT** hold. If the compiler does not+  -- reject it - the expectation seem indeed implausible.+  Invalid :: (DontTry (EvalExpectation expectation))+        => TypeSpec expectation++-- * Expectations++-- | An open family of type level expectation evaluators, that return  either @()@+-- or an @ErrorMessage@.+type family EvalExpectation (expectation :: k) :: Result k++-- ** Combining/Grouping collections++-- | Given a pair @(expectation1, expectation2)@ try to evaluate the first then,+-- if no error was returned, the second.+type instance EvalExpectation '(a, b) =+  Pair'' <$> EvalExpectation a <*> EvalExpectation b++-- | Given a list @(expectation : rest)@ try to evaluate the @expectation@ then,+-- if no error was returned, the @rest@.+type instance EvalExpectation '[] = OK '[]+type instance EvalExpectation (expectation ': rest) =+  Cons'' <$> EvalExpectation expectation <*> EvalExpectation rest++-- * Pretty Printing++-- | A class for pretty printing via the 'Show' instance of 'TypeSpec'.+class PrettyTypeSpec (t :: k) where+  prettyTypeSpec :: proxy t -> Doc++-- * Printing/Showing++instance PrettyTypeSpec t => Show (TypeSpec t) where+  show px@Valid =+    render+      $ hang (text "Valid:") 5 (prettyTypeSpec px)+  show px@Invalid =+    render+      $ hang (text "Invalid:") 5 (prettyTypeSpec px)++-- | The default indention to use when 'nest'ing 'Doc'uments.+prettyIndentation :: Int+prettyIndentation = 2++-- | Nest using the default indention `prettyIndentation`.+nest' :: Doc -> Doc+nest' = nest prettyIndentation++-- | Print a /sentence/ with the second part 'hang'ing from the first.+-- Generate: @predicate: object@+sentence :: String -> Doc -> Doc+sentence predicate object =+  hang (text predicate <> colon <> space) 5 object++-- * Default instances++instance+    ( PrettyTypeSpec expectation1+    , PrettyTypeSpec expectation2 )+  => PrettyTypeSpec '(expectation1, expectation2)+  where+    prettyTypeSpec _ =+        prettyTypeSpec pe1 $+$ prettyTypeSpec pe2 +      where pe1 = Proxy :: Proxy expectation1+            pe2 = Proxy :: Proxy expectation2++instance+    PrettyTypeSpec '[]+  where+    prettyTypeSpec _ = empty++instance+    ( PrettyTypeSpec expectation+    , PrettyTypeSpec rest )+  => PrettyTypeSpec (expectation ': rest)+  where+    prettyTypeSpec _ =+        (prettyTypeSpec pe1) $+$ (prettyTypeSpec pe2)+      where pe1 = Proxy :: Proxy expectation+            pe2 = Proxy :: Proxy rest
+ src/Test/TypeSpec/Group.hs view
@@ -0,0 +1,42 @@+-- | Group expectations+module Test.TypeSpec.Group+    ( type (-/-), type (-*) )+  where++import Data.Proxy+import Test.TypeSpec.Core+import Test.TypeSpec.Internal.Apply+import Test.TypeSpec.Internal.Either ()+import Text.PrettyPrint++-- * Composed Expectations++-- | A @cons@ like operator.+-- Make a list of expectations. Use this to chain together any expectations+-- especially those using '(~~~)' or '(-*)', since it has a lower precedence+-- than both.+data expectation1 -/- expectation2+infixr 1 -/-++type instance+  EvalExpectation (expectation -/- expectations) =+    TyCon2 ((-/-)) <$> EvalExpectation expectation <*> EvalExpectation expectations++-- | A @cons@ like operator.+-- Make a list of expectations. Use this to chain together anything /below/ or+-- inside '(-/-)' and '(~~~)' parts. The precedence of this operator is higher+-- that that of '(-/-)'.+type expectation1 -* expectation2 = expectation1 -/- expectation2+infixr 3 -*++-- * Pretty Printing Instances++instance+    ( PrettyTypeSpec expectation1+    , PrettyTypeSpec expectation2 )+  => PrettyTypeSpec (expectation1 -/- expectation2)+  where+    prettyTypeSpec _ =+        (prettyTypeSpec pe1) $+$ (prettyTypeSpec pe2)+      where pe1 = Proxy :: Proxy expectation1+            pe2 = Proxy :: Proxy expectation2
+ src/Test/TypeSpec/Internal/Apply.hs view
@@ -0,0 +1,116 @@+-- | Useful abstractions for type level programming using. This reimplements+-- parts of the singletons library, which is just too heavy of a dependency to+-- carry around, when only three small types are used of it.+module Test.TypeSpec.Internal.Apply+    ( type (>>=)+    , type (>>)+    , type (<*>)+    , type (<$>$$)+    , type (<$>$)+    , type (<$>)+    , type TyCon1+    , type TyCon2+    , type Apply+    , TyFun, type TyFunData+    , type (~>)+    , type Cons''+    , type Cons'+    , type Pair''+    , type Pair'+    , type Const+    , type Const'+    , type Const''+    , Flip'+    , Flip+    , Flip_+    , type Flip__+    , Compose''+    , Compose'+    , Compose+    , type Compose_+    )+    where++import Data.Kind++-- | Bind to actions.+type family+ (>>=) (ma :: monad a)+       (f :: TyFunData (a :: Type) ((monad b) :: Type))+       :: monad b++-- | Execute one action and then the next, ignore the result of the first.+type (>>) ma mb = ma >>= Const' mb++-- | Execute an action that returns a function than map function over the result+-- of the next action.+type family+  (f :: m (a ~> b)) <*> (ma :: m a) :: m b where+  mf <*> mx = mf >>= Apply (Flip (<$>$$)) mx++-- | Tuple construction+data Pair'' :: a ~> b ~> (a, b)+data Pair'  :: a -> b ~> (a, b)+type instance Apply Pair'' x = Pair' x+type instance Apply (Pair' x) y = '(x, y)++-- | List construction+data Cons'' :: a ~> [a] ~> [a]+data Cons' :: a -> [a] ~> [a]+type instance Apply Cons'' x = Cons' x+type instance Apply (Cons' x) xs = x ': xs++-- | Convert data types to Partially applicable type functions+data TyCon1 :: (a -> b) -> a ~> b+data TyCon2 :: (a -> b -> c) -> a ~> b ~> c+type instance Apply (TyCon1 f) x = f x+type instance Apply (TyCon2 f) x = (TyCon1 (f x))++-- | Execute an action and map a pure function over the result.+data (<$>$$) :: (a ~> b) ~> m a ~> m b+data (<$>$) :: (a ~> b) -> m a ~> m b+type instance Apply (<$>$$) f = (<$>$) f+type instance Apply ((<$>$) f) x = f <$> x+type family+  (f :: (a ~> b)) <$> (ma :: m a) :: m b++-- * Flip Type Functions++data Flip' :: (a ~> b ~> c) ~> b ~> a ~> c+data Flip :: (a ~> b ~> c) -> b ~> a ~> c+data Flip_ :: (a ~> b ~> c) -> b -> a ~> c+type instance Apply Flip' f = Flip f+type instance Apply (Flip f) y = Flip_ f y+type instance Apply (Flip_ f y) x = Flip__ f y x+type family+  Flip__ (f :: (a ~> b ~> c)) (y :: b) (x :: a) :: c where+  Flip__ f y x = Apply (Apply f x) y++-- * Type Function composition++data Compose'' :: (b ~> c) ~> (a ~> b) ~> (a ~> c)+data Compose' :: (b ~> c) -> (a ~> b) ~> (a ~> c)+data Compose :: (b ~> c) -> (a ~> b) -> (a ~> c)+type instance Apply Compose'' f = Compose' f+type instance Apply (Compose' f) g = (Compose f g)+type instance Apply (Compose f g) x = Compose_ f g x+type family+  Compose_ (f :: b ~> c) (g :: a ~> b) (x :: a) :: c where+  Compose_ f g x = Apply f (Apply g x)+++-- * Type-Level 'const'++type family Const (a :: t) (b :: t') :: t where Const a b = a+data Const' :: a -> (TyFunData b a)+data Const'' :: TyFunData a (TyFunData b a)+type instance Apply Const'' a = Const' a+type instance Apply (Const' a) b = Const a b++-- * Defunctionalization++data TyFun :: Type -> Type -> Type+type TyFunData a b = TyFun a b -> Type+type a ~> b = TyFun a b -> Type+infixr 0 ~>+type family Apply (f :: a ~> b) (x :: a) :: b
+ src/Test/TypeSpec/Internal/Either.hs view
@@ -0,0 +1,16 @@+-- | Useful abstractions for type level programming using 'Either'.+module Test.TypeSpec.Internal.Either (type FromLeft) where++import Test.TypeSpec.Internal.Apply ++-- * Either instances++type instance (>>=) ('Right a) f = Apply f a+type instance (>>=) ('Left b)  f = 'Left b++type instance (<$>) f ('Right a) = 'Right (Apply f a)+type instance (<$>) f ('Left a) = 'Left a++type family+  FromLeft (e :: Either a b) :: a where+  FromLeft ('Left a) = a
+ src/Test/TypeSpec/Internal/Equality.hs view
@@ -0,0 +1,8 @@+-- | Type Equality+module Test.TypeSpec.Internal.Equality (type PolyKindEq) where++  -- | Operator 'Data.Equality.(==)' expects both arguments to have the+  -- same kind.+  type family PolyKindEq (a :: ak) (b :: bk) :: Bool where+    PolyKindEq a a = 'True+    PolyKindEq a b = 'False
+ src/Test/TypeSpec/Internal/Result.hs view
@@ -0,0 +1,50 @@+-- | Result type used in constraints inside 'TypeSpec' to propagate type errors.+module Test.TypeSpec.Internal.Result+  ( type Result+  , type Try+  , type DontTry+  , type FAILED+  , type OK+  , type PrependToError+  ) where++import GHC.TypeLits+import Data.Kind+import Test.TypeSpec.Internal.Apply ()+import Test.TypeSpec.Internal.Either ()++--  * Type error propagation++-- | When a type level expectation is tested, it might be that compound+-- expectations fail. In order to have a small, precise error message, the type+-- level assertion results are made to have kind 'Result'.+type Result = Either ErrorMessage++type family+  Try (e :: Result k) :: k where+  Try (OK     (d :: k)) = d+  Try (FAILED m) = TypeError m++type family+  DontTry (e :: Result r) :: Constraint where+  DontTry (FAILED e)     = ()+  DontTry (OK okIsNotOk) =+    TypeError ('Text "You specified this wasn't okay: "+               ':$$:+               'Text "    " ':<>: 'ShowType okIsNotOk+               ':$$:+               'Text "... turns out it actually is!")++-- | A nice name than 'Left'+type OK     = 'Right+type FAILED = 'Left++type family+    PrependToError+      (message :: ErrorMessage)+      (result :: Result a)+      :: Result a+  where+    PrependToError message (OK x) = OK x+    PrependToError message (FAILED otherMessage) =+      FAILED (message ':<>: otherMessage)
+ src/Test/TypeSpec/Label.hs view
@@ -0,0 +1,29 @@+-- | Label expectations+module Test.TypeSpec.Label+    ( It )+  where++import Data.Kind+import Data.Typeable+import GHC.TypeLits+import Test.TypeSpec.Core+import Test.TypeSpec.Internal.Apply+import Test.TypeSpec.Internal.Either ()+import Text.PrettyPrint++-- | Add a type level string as label or longer descripton around expectations.+-- This is analog to the @it@ function in the @hspec@ package.+data It :: Symbol -> expectation -> Type++type instance+  EvalExpectation (It message expectation) =+    PrependToError+      ('Text message ':$$: 'Text "    ")+      (EvalExpectation expectation)+    >> (OK (It message expectation))+++instance (KnownSymbol msg, PrettyTypeSpec x) => PrettyTypeSpec (It msg x) where+  prettyTypeSpec _ =+    (text (symbolVal (Proxy :: Proxy msg)))+    $+$ nest prettyIndentation (prettyTypeSpec (Proxy :: Proxy x))
+ src/Test/TypeSpec/ShouldBe.hs view
@@ -0,0 +1,123 @@+-- | Type level assertions on type equality.+module Test.TypeSpec.ShouldBe+    (   ShouldBe+      , ShouldNotBe+      , ShouldBeTrue+      , ShouldBeFalse+      , ButNot+    )+  where++import Data.Kind+import Data.Type.Bool+import Data.Type.Equality+import Data.Typeable+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+import Type.Showtype++-- | State that a type is equal to the type level @True@.+data ShouldBeTrue :: expectation -> Type++type instance EvalExpectation (ShouldBeTrue t) =+    If (PolyKindEq t 'True)+        (OK (ShouldBeTrue t))+        (FAILED+          ('Text "Should have been 'True: " ':<>: 'ShowType t))++-- | State that a type is equal to the type level @False@.+data ShouldBeFalse :: expectation -> Type++type instance EvalExpectation (ShouldBeFalse t) =+    If (PolyKindEq t 'False)+        (OK (ShouldBeFalse t))+        (FAILED+          ('Text "Should have been 'False: " ':<>: 'ShowType t))++-- | State that one type is different to two other types. This must always be+-- used right next to a 'ShouldBe' pair, otherwise this will not work.+data ButNot :: shouldBe -> actual -> Type++type instance+  EvalExpectation (ButNot (ShouldBe expected actual) other) =+    If (expected == actual)+      (If (expected == other)+          (FAILED+            ('Text "Expected type: "+             ':$$: 'Text "   " ':<>: 'ShowType expected+             ':$$: 'Text "to be different from: "+             ':$$: 'Text "   " ':<>: 'ShowType other))+          (OK (ButNot (ShouldBe expected actual) other)))+      (FAILED+        ('Text "Expected type: " ':<>: 'ShowType expected+         ':$$: 'Text "Actual type:   " ':<>: 'ShowType actual))++-- | State that two types or type constructs are boiled down to the same type.+data ShouldBe :: expected -> actual -> Type++type instance+  EvalExpectation (ShouldBe expected actual) =+    If (PolyKindEq expected actual)+        (OK (ShouldBe expected actual))+        (FAILED+          ('Text "Expected type: " ':<>: 'ShowType expected+           ':$$: 'Text "Actual type:   " ':<>: 'ShowType actual))++-- | State that two types or type constructs are NOT the same type.+data ShouldNotBe :: expected -> actual -> Type++type instance+  EvalExpectation (ShouldNotBe expected actual) =+    If (PolyKindEq expected actual)+        (FAILED+          ('Text "Expected type: "+           ':$$: 'Text "   " ':<>: 'ShowType expected+           ':$$: 'Text "to be different from: "+           ':$$: 'Text "   " ':<>: 'ShowType actual))+        (OK (ShouldNotBe expected actual))++-- * PrettyTypeSpec instances++instance PrettyTypeSpec (ShouldBeTrue a) where+  prettyTypeSpec _px =+    prettyBulletPoint $ text "Type == True"++instance PrettyTypeSpec (ShouldBeFalse a) where+  prettyTypeSpec _px =+    prettyBulletPoint $ text "Type == False"++instance PrettyTypeSpec (ShouldBe a b) where+  prettyTypeSpec _px =+    prettyBulletPoint $ text "Types are equal"++instance (Showtype a, Showtype b) => PrettyTypeSpec (ShouldNotBe a b) where+  prettyTypeSpec _px =+      prettyBulletPoint+        $ sentence "Type"  (text expected)+        $$ sentence "differs from" (text actual)+    where+      expected = showtype (Proxy :: Proxy a)+      actual = showtype (Proxy :: Proxy b)++instance+    (a ~ (ShouldBe a0 a1)+    , Showtype a0+    , Showtype a1+    , Showtype b )+  => PrettyTypeSpec (ButNot a b) where+    prettyTypeSpec _ =+      prettyBulletPoint+        $ (sentence "Type"+                 (text (showtype (Proxy :: Proxy a0))))+        $$ (sentence "is equal to"+                 (text (showtype (Proxy :: Proxy a1))))+        $$ (sentence "but not to"+                 (text (showtype (Proxy :: Proxy b))))++-- | Pretty print a test prefix by a bullet-point.+prettyBulletPoint :: Doc -> Doc+prettyBulletPoint doc = text "•" <+> doc
+ src/Test/TypeSpecCrazy.hs view
@@ -0,0 +1,140 @@+-- | Funny operators that are mere type aliases for the constructs in+-- 'TypeSpec'+module Test.TypeSpecCrazy+      ( module Test.TypeSpecCrazy+      , module ReExport)+    where++import Test.TypeSpec as ReExport++-- * Crazy Type operators++-- | Create a 'TypeSpec' with an initial description or title followed by some+-- expectations. Note that the number of @#@s is alway a multiple of 3.+type (###) title expr = Explain title expr+type (######) title expr = Explain title expr+type (#########) title expr = Explain title expr+type (############) title expr = Explain title expr+type (###############) title expr = Explain title expr+type (##################) title expr = Explain title expr+type (#####################) title expr = Explain title expr+type (########################) title expr = Explain title expr+type (###########################) title expr = Explain title expr+type (##############################) title expr = Explain title expr+type (#################################) title expr = Explain title expr+type (####################################) title expr = Explain title expr+type (#######################################) title expr = Explain title expr+type (##########################################) title expr =+  Explain title expr+type (#############################################) title expr =+  Explain title expr+type (################################################) title expr =+  Explain title expr+type (###################################################) title expr =+  Explain title expr+type (######################################################) title expr =+  Explain title expr+type (#########################################################) title expr =+  Explain title expr+type (############################################################) title expr =+  Explain title expr+type (###############################################################) title expr =+  Explain title expr+type (##################################################################) title expr =+  Explain title expr+type (#####################################################################) title expr =+  Explain title expr+type (########################################################################) title expr =+  Explain title expr++infixr 0 ###+infixr 0 ######+infixr 0 #########+infixr 0 ############+infixr 0 ###############+infixr 0 ##################+infixr 0 #####################+infixr 0 ########################+infixr 0 ###########################+infixr 0 ##############################+infixr 0 #################################+infixr 0 ####################################+infixr 0 #######################################+infixr 0 ##########################################+infixr 0 #############################################+infixr 0 ################################################+infixr 0 ###################################################+infixr 0 ######################################################+infixr 0 #########################################################+infixr 0 ############################################################+infixr 0 ###############################################################+infixr 0 ##################################################################+infixr 0 #####################################################################+infixr 0 ########################################################################++-- | Specify an expectation using an underlined title using 'It'.+type (--*) title expr = It title expr+type (~~~) title expr = It title expr+type (~~~~~~) title expr = It title expr+type (~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr = It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr+type (~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~) title expr =+  It title expr++infixl 2 --*+infixl 2 ~~~+infixr 2 ~~~~~~+infixr 2 ~~~~~~~~~+infixr 2 ~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+infixr 2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++type expectation1 -*- expectation2 = expectation1 -/- expectation2+infixl 2 -*-
+ type-spec.cabal view
@@ -0,0 +1,100 @@+name:                 type-spec+version:              0.1.0.0+synopsis:             Type Level Specification by Example+description:          Please see README.md+homepage:             https://github.com/sheyll/type-spec#readme+license:              BSD3+license-file:         LICENSE+author:               Sven Heyll+maintainer:           sven.heyll@gmail.com+copyright:            2016 Sven Heyll+category:             expring+build-type:           Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Test.TypeSpec+                     , Test.TypeSpecCrazy+                     , Test.TypeSpec.Core+                     , Test.TypeSpec.Group+                     , Test.TypeSpec.Label+                     , Test.TypeSpec.ShouldBe+                     , Test.TypeSpec.Internal.Apply+                     , Test.TypeSpec.Internal.Either+                     , Test.TypeSpec.Internal.Equality+                     , Test.TypeSpec.Internal.Result+  build-depends:       base >= 4.9 && < 5+                     , pretty >= 1.1.3 && < 1.2+                     , show-type >= 0.1.1+  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                     , CPP+                     , DataKinds+                     , DefaultSignatures+                     , DeriveDataTypeable+                     , DeriveFunctor+                     , DeriveGeneric+                     , FlexibleInstances+                     , FlexibleContexts+                     , FunctionalDependencies+                     , GADTs+                     , GeneralizedNewtypeDeriving+                     , KindSignatures+                     , MultiParamTypeClasses+                     , OverloadedStrings+                     , PolyKinds+                     , QuasiQuotes+                     , RecordWildCards+                     , RankNTypes+                     , ScopedTypeVariables+                     , StandaloneDeriving+                     , TemplateHaskell+                     , TupleSections+                     , TypeFamilies+                     , TypeInType+                     , TypeOperators+                     , TypeSynonymInstances+                     , UndecidableInstances+  ghc-options:       -Wall++test-suite examples+  type:                exitcode-stdio-1.0+  ghc-options:         -Wall+  hs-source-dirs:      examples+  main-is:             Main.hs+  default-language:    Haskell2010+  build-depends:       base >= 4.9 && < 5+                     , type-spec+  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                     , CPP+                     , DataKinds+                     , DefaultSignatures+                     , DeriveDataTypeable+                     , DeriveFunctor+                     , DeriveGeneric+                     , FlexibleInstances+                     , FlexibleContexts+                     , FunctionalDependencies+                     , GADTs+                     , GeneralizedNewtypeDeriving+                     , KindSignatures+                     , MultiParamTypeClasses+                     , OverloadedStrings+                     , QuasiQuotes+                     , RecordWildCards+                     , RankNTypes+                     , ScopedTypeVariables+                     , StandaloneDeriving+                     , TemplateHaskell+                     , TupleSections+                     , TypeFamilies+                     , TypeInType+                     , TypeOperators+                     , TypeSynonymInstances++source-repository head+  type:     git+  location: https://github.com/sheyll/type-spec