world-peace 1.0.0.0 → 1.0.1.0

raw patch · 5 files changed

+78/−5 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Data/WorldPeace.hs +2/−2
• src/Data/WorldPeace/Union.hs +67/−2
• test/Test/TypeErrors.hs +4/−0
• world-peace.cabal +1/−1

@@ -1,4 +1,8 @@ +## 1.0.1.0++*   Update `IsMember` to show a nice custom type error.  Thanks @chshersh! [#5]+ ## 1.0.0.0  *   Add the functions `relaxOpenUnion` and `relaxUnion` for being able to add

@@ -25,8 +25,8 @@ each possible type in the 'OpenUnion':  @-  let strHandler = (\str -> \"got a String: \" '++' str) :: 'String' -> 'String'-      intHandler = (\int -> \"got an Int: \" '++' 'show' int) :: 'Int' -> 'String'+  let strHandler = (\\str -> \"got a String: \" '++' str) :: 'String' -> 'String'+      intHandler = (\\int -> \"got an Int: \" '++' 'show' int) :: 'Int' -> 'String'   in 'catchesOpenUnion' (strHandler, intHandler) u :: 'String' @ 

@@ -81,6 +81,7 @@ import Data.Kind (Constraint) import Data.Proxy import Data.Typeable (Typeable)+import GHC.TypeLits (ErrorMessage(..), TypeError) import Text.Read (Read(readPrec), ReadPrec, (<++))  import Data.WorldPeace.Internal.Prism@@ -131,6 +132,40 @@   RIndex r (r ': rs) = 'Z   RIndex r (s ': rs) = 'S (RIndex r rs) +-- | Text of the error message.+type NoElementError (r :: k) (rs :: [k]) =+          'Text "You require open sum type to contain the following element:"+    ':$$: 'Text "    " ':<>: 'ShowType r+    ':$$: 'Text "However, given list can store elements only of the following types:"+    ':$$: 'Text "    " ':<>: 'ShowType rs++-- | This type family checks whether @a@ is inside @as@ and produces+-- compile-time error if not.+type family CheckElemIsMember (a :: k) (as :: [k]) :: Constraint where+    CheckElemIsMember a as =+      If (Elem a as) (() :: Constraint) (TypeError (NoElementError a as))++-- | Type-level @if@.+--+-- >>> Refl :: If 'True String Double :~: String+-- Refl+-- >>> Refl :: If 'False String Double :~: Double+-- Refl+type family If (bool :: Bool) (thenCase :: k) (elseCase :: k) :: k where+  If 'True thenCase _ = thenCase+  If 'False _ elseCase = elseCase++-- | Type-level version of the 'elem' function.+--+-- >>> Refl :: Elem String '[Double, String, Char] :~: 'True+-- Refl+-- >>> Refl :: Elem String '[Double, Char] :~: 'False+-- Refl+type family Elem (x :: k) (xs :: [k]) :: Bool where+    Elem _ '[]       = 'False+    Elem x (x ': xs) = 'True+    Elem x (y ': xs) = Elem x xs+ -- | Change a list of types into a list of functions that take the given type -- and return @x@. --@@ -151,7 +186,7 @@  -- | This is a helpful 'Constraint' synonym to assert that @a@ is a member of -- @as@.  You can see how it is used in functions like 'openUnionLift'.-type IsMember (a :: u) (as :: [u]) = UElem a as (RIndex a as)+type IsMember (a :: u) (as :: [u]) = (CheckElemIsMember a as, UElem a as (RIndex a as))  -- | A type family to assert that all of the types in a list are contained -- within another list.@@ -435,7 +470,9 @@ -- 'ElemRemove' gives you a way to specific types from a 'Union'. -- -- Note that @'ElemRemove' a as@ doesn't force @a@ to be in @as@.  We are able--- to try to pull out a 'Double' from a @'Union' 'Identity' \'['Double']@:+-- to use 'unionRemove' to try to pull out a 'String' from a+-- @'Union' 'Identity' \'['Double']@ (even though there is no way this 'Union'+-- could contain a 'String'): -- -- >>> let u = This (Identity 3.5) :: Union Identity '[Double] -- >>> unionRemove u :: Either (Union Identity '[Double]) (Identity String)@@ -586,6 +623,8 @@ ---------------  -- | We can use @'Union' 'Identity'@ as a standard open sum type.+--+-- See the documentation for 'Union'. type OpenUnion = Union Identity  -- | Case analysis for 'OpenUnion'.@@ -645,11 +684,25 @@  -- | Just like 'unionLift' but for 'OpenUnion'. --+-- ==== __Examples__+-- -- Creating an 'OpenUnion': -- -- >>> let string = "hello" :: String -- >>> openUnionLift string :: OpenUnion '[Double, String, Int] -- Identity "hello"+--+-- You will get a compile error if you try to create an 'OpenUnion' that+-- doesn't contain the type:+--+-- >>> let float = 3.5 :: Float+-- >>> openUnionLift float :: OpenUnion '[Double, Int]+-- ...+--     • You require open sum type to contain the following element:+--           Float+--       However, given list can store elements only of the following types:+--           '[Double, Int]+-- ... openUnionLift   :: forall a as.      IsMember a as@@ -673,6 +726,18 @@ -- >>> let p = openUnionLift double :: OpenUnion '[Double, String] -- >>> openUnionMatch p :: Maybe String -- Nothing+--+-- You will get a compile error if you try to pull out an element from+-- the 'OpenUnion' that doesn't exist within it.+--+-- >>> let o2 = openUnionLift double :: OpenUnion '[Double, Char]+-- >>> openUnionMatch o2 :: Maybe Float+-- ...+--     • You require open sum type to contain the following element:+--           Float+--       However, given list can store elements only of the following types:+--           '[Double, Char]+-- ... openUnionMatch   :: forall a as.      IsMember a as

@@ -26,18 +26,22 @@         let u = This (Identity "hello") :: Union Identity '[String]         shouldNotTypecheck           (unionRemove u :: Either (Union Identity '[]) (Identity Double))+     , testCase "too few types in resulting union 2" $ do         let u = This (Identity "hello") :: Union Identity '[String, Char, Double]         shouldNotTypecheck           (unionRemove u :: Either (Union Identity '[String]) (Identity Double))+     , testCase "too many types in resulting union 1" $ do         let u = This (Identity "hello") :: Union Identity '[String]         shouldNotTypecheck           (unionRemove u :: Either (Union Identity '[String, String]) (Identity Double))+     , testCase "too many types in resulting union 2" $ do         let u = This (Identity "hello") :: Union Identity '[String, Char, Double]         shouldNotTypecheck           (unionRemove u :: Either (Union Identity '[String, Char, Double]) (Identity Double))+     , testCase "does not pull out multiple" $ do         let u = This (Identity "hello") :: Union Identity '[String, String, Double]         shouldNotTypecheck

@@ -1,5 +1,5 @@ name:                world-peace-version:             1.0.0.0+version:             1.0.1.0 synopsis:            Open Union and Open Product Types description:         Please see <https://github.com/cdepillabout/world-peace#readme README.md>. homepage:            https://github.com/cdepillabout/world-peace