data-diverse 1.0.0.1 → 1.1.0.0

raw patch · 12 files changed

+95/−119 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +9/−2
• data-diverse.cabal +2/−2
• src/Data/Diverse.hs +2/−2
• src/Data/Diverse/Case.hs +1/−1
• src/Data/Diverse/CaseFunc.hs +57/−0
• src/Data/Diverse/CaseTypeable.hs +0/−54
• src/Data/Diverse/Cases.hs +4/−4
• src/Data/Diverse/TypeLevel.hs +7/−3
• src/Data/Diverse/TypeLevel/Internal.hs +0/−11
• src/Data/Diverse/Which/Internal.hs +4/−4
• test/Data/Diverse/ManySpec.hs +4/−31
• test/Data/Diverse/WhichSpec.hs +5/−5

@@ -14,12 +14,18 @@  # Changelog +* 1.1.0.0+  - Added `CaseFunc` and `CaseFunc'` which replaces `CaseTypeable` (eg `CaseFunc @Typeable`)+    <https://github.com/louispan/data-diverse/issues/6>+  - Replaced `IsAll` constraint with `AllConstrained`.+ * 1.0.0.1   - Added `CaseTypeable'` as an example of polymorphic `Case` that doesn't change the type.  * 1.0.0.0   - The exposed api shouldn't break, but there are a lot of internal changes.-  - Added `AFunctor` which can map over the types in the 'Many' <https://github.com/louispan/data-diverse/issues/5>.+  - Added `AFunctor` which can map over the types in the 'Many'+    <https://github.com/louispan/data-diverse/issues/5>.   - Added friendlier type synomyns `Collect` and `CollectN` for `collect` and `collectN`   - Expose type of 'Collector' and 'CollectorN'   - Replace type parameter `r` from `Case` typeclass with `CaseResult` type family.@@ -28,7 +34,8 @@   - All `CaseXxxN` type variables now end with r n xs.  * 0.11.0.0-  - Added `impossible` modelled after `Data.Void.absurd` <https://github.com/louispan/data-diverse/issues/4>+  - Added `impossible` modelled after `Data.Void.absurd`+    <https://github.com/louispan/data-diverse/issues/4>   - Removed `zilch` so `Which '[]` is uninhabited like `Data.Void.Void`, making 'impossible' safe to use.   - Removed `Monoid` and changed `Show`, `Read` and `Generic` instances for `Which '[]` to be partial     just like Data.Void.Void.

@@ -1,5 +1,5 @@ name:                data-diverse-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Extensible records and polymorphic variants. description:         "Data.Diverse.Many" is an extensible record for any size encoded efficiently as (Seq Any).                      "Data.Diverse.Which" is a polymorphic variant of possibilities encoded as (Int, Any).@@ -28,8 +28,8 @@                        Data.Diverse.AFoldable                        Data.Diverse.AFunctor                        Data.Diverse.Case+                       Data.Diverse.CaseFunc                        Data.Diverse.Cases-                       Data.Diverse.CaseTypeable                        Data.Diverse.Many                        Data.Diverse.Many.Internal                        Data.Diverse.Reduce

@@ -3,7 +3,7 @@     , module Data.Diverse.AFunctor     , module Data.Diverse.Case     , module Data.Diverse.Cases-    , module Data.Diverse.CaseTypeable+    , module Data.Diverse.CaseFunc     , module Data.Diverse.Many     , module Data.Diverse.Reduce     , module Data.Diverse.Reiterate@@ -15,7 +15,7 @@ import Data.Diverse.AFunctor import Data.Diverse.Case import Data.Diverse.Cases-import Data.Diverse.CaseTypeable+import Data.Diverse.CaseFunc import Data.Diverse.Many import Data.Diverse.Reduce import Data.Diverse.Reiterate

@@ -13,7 +13,7 @@ -- In conjunction with 'Data.Diverse.Reiterate.Reiterate', you can define handlers that can handle all -- the types in the @xs@ typelist. ----- See "Data.Diverse.CaseTypeable" and "Data.Diverse.Cases".+-- See "Data.Diverse.CaseFunc" and "Data.Diverse.Cases". class Case c (xs :: [Type]) where     -- | Return the handler/continuation when x is observed.     case' :: c xs -> Head xs -> CaseResult c (Head xs)

@@ -0,0 +1,57 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Diverse.CaseFunc where++import Data.Diverse.Case+import Data.Diverse.Reiterate+import Data.Diverse.TypeLevel+import Data.Kind++-- | This handler stores a polymorphic function that returns a different type.+--+-- @+-- let y = 'Data.Diverse.Which.pick' (5 :: Int) :: 'Data.Diverse.Which.Which' '[Int, Bool]+-- 'Data.Diverse.Which.switch' y ('CaseFunc' \@'Data.Typeable.Typeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` "Int"+-- @+--+-- @+-- let x = (5 :: Int) 'Data.Diverse.Many../' False 'Data.Diverse.Many../' \'X' 'Data.Diverse.Many../' Just \'O' 'Data.Diverse.Many../' (6 :: Int) 'Data.Diverse.Many../' Just \'A' 'Data.Diverse.Many../' 'Data.Diverse.Many.nul'+-- 'Data.Diverse.AFoldable.afoldr' (:) [] ('Data.Diverse.Many.forMany' ('CaseFunc' \@'Data.Typeable.Typeable' (show . typeRep . (pure @Proxy))) x) \`shouldBe`+--     [\"Int", \"Bool", \"Char", \"Maybe Char", \"Int", \"Maybe Char"]+-- @+newtype CaseFunc (k :: Type -> Constraint) r (xs :: [Type]) = CaseFunc (forall x. k x => x -> r)+-- This was made possible by Syrak+-- https://www.reddit.com/r/haskell/comments/75zrci/help_how_to_pass_constraints_as_a_type_variable/++type instance CaseResult (CaseFunc k r) x = r++instance Reiterate (CaseFunc k r) xs where+    reiterate (CaseFunc f) = CaseFunc f++instance k x => Case (CaseFunc k r) (x ': xs) where+    case' (CaseFunc f) = f++-- | This handler stores a polymorphic function that doesn't change the type.+--+-- @+-- let x = (5 :: Int) 'Data.Diverse.Many../' (6 :: Int8) 'Data.Diverse.Many../' (7 :: Int16) 'Data.Diverse.Many../' (8 :: Int32) 'Data.Diverse.Many../' 'Data.Diverse.Many.nil'+--     y = (15 :: Int) 'Data.Diverse.Many../' (16 :: Int8) 'Data.Diverse.Many../' (17 :: Int16) 'Data.Diverse.Many../' (18 :: Int32) 'Data.Diverse.Many../' 'Data.Diverse.Many.nil'+-- 'Data.Diverse.AFunctor.afmap' ('CaseFunc'' \@'Num' (+10)) x \`shouldBe` y+-- @+newtype CaseFunc' (k :: Type -> Constraint) (xs :: [Type]) = CaseFunc' (forall x. k x => x -> x)++type instance CaseResult (CaseFunc' k) x = x++instance Reiterate (CaseFunc' k) xs where+    reiterate (CaseFunc' f) = CaseFunc' f++instance k x => Case (CaseFunc' k) (x ': xs) where+    case' (CaseFunc' f) = f

@@ -1,54 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}--module Data.Diverse.CaseTypeable where--import Data.Diverse.Case-import Data.Diverse.Reiterate-import Data.Diverse.TypeLevel-import Data.Kind-import Data.Typeable---- | This handler stores a polymorphic function for all Typeables.--- This is an example of how to define and instance of 'Case' for--- polymorphic function into a specified result type.------ @--- let y = 'Data.Diverse.Which.pick' (5 :: Int) :: 'Data.Diverse.Which.Which' '[Int, Bool]--- 'Data.Diverse.Which.switch' y ('CaseTypeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` "Int"--- @------ @--- let x = (5 :: Int) 'Data.Diverse.Many../' False 'Data.Diverse.Many../' \'X' 'Data.Diverse.Many../' Just \'O' 'Data.Diverse.Many../' (6 :: Int) 'Data.Diverse.Many../' Just \'A' 'Data.Diverse.Many../' 'Data.Diverse.Many.nul'--- 'Data.Diverse.AFoldable.afoldr' (:) [] ('Data.Diverse.Many.forMany' ('CaseTypeable' (show . typeRep . (pure @Proxy))) x) \`shouldBe`---     [\"Int", \"Bool", \"Char", \"Maybe Char", \"Int", \"Maybe Char"]--- @-newtype CaseTypeable r (xs :: [Type]) = CaseTypeable (forall x. Typeable x => x -> r)--type instance CaseResult (CaseTypeable r) x = r--instance Reiterate (CaseTypeable r) xs where-    reiterate (CaseTypeable f) = CaseTypeable f--instance Typeable x => Case (CaseTypeable r) (x ': xs) where-    case' (CaseTypeable f) = f----- | This handler stores a polymorphic function for all Typeables.--- This is an example of how to define and instance of 'Case' for--- polymorphic function that doesn't change the type-newtype CaseTypeable' (xs :: [Type]) = CaseTypeable' (forall x. Typeable x => x -> x)--type instance CaseResult CaseTypeable' x = x--instance Reiterate CaseTypeable' xs where-    reiterate (CaseTypeable' f) = CaseTypeable' f--instance Typeable x => Case CaseTypeable' (x ': xs) where-    case' (CaseTypeable' f) = f

@@ -68,14 +68,14 @@ -- However, the 'Cases' constructor is still exported to allow creating a master-of-all-'Case'. cases     :: forall r xs fs.-       (IsAll r (CaseResults (Cases fs r) fs), SameLength fs (Nub xs))+       (AllConstrained ((~) r) (CaseResults (Cases fs r) fs), SameLength fs (Nub xs))     => Many fs -> Cases fs r xs cases = Cases  -- | A variation of 'cases' without the @SameLength@ constraint to allow creating a master-of-all-'Case'. cases'     :: forall r xs fs.-       (IsAll r (CaseResults (Cases fs r) fs))+       (AllConstrained ((~) r) (CaseResults (Cases fs r) fs))     => Many fs -> Cases fs r xs cases' = Cases @@ -126,13 +126,13 @@ -- @ casesN     :: forall r xs fs.-       (IsAll r (CaseResults (CasesN fs r 0) fs), SameLength fs xs)+       (AllConstrained ((~) r) (CaseResults (CasesN fs r 0) fs), SameLength fs xs)     => Many fs -> CasesN fs r 0 xs casesN = CasesN  -- | A variation of 'casesN' without the @SameLength@ constraint to allow creating a master-of-all-'Case'. casesN'     :: forall r xs fs.-       (IsAll r (CaseResults (CasesN fs r 0) fs))+       (AllConstrained ((~) r) (CaseResults (CasesN fs r 0) fs))     => Many fs -> CasesN fs r 0 xs casesN' = CasesN

@@ -164,12 +164,16 @@ -- | Takes two lists which must be the same length and returns a list of corresponding pairs. type Zip (xs :: [k]) (ys :: [k]) = ZipImpl xs ys xs ys --- | Tests if all the types in a typelist is all a specified type.-type IsAll (x :: k) (xs :: [k]) = IsAllImpl xs x xs-+-- | The result from evaluating a 'Case' with a type from a typelist. type family CaseResult (c ::[k1] -> k2) (x :: k1) :: k2  -- | Return a list of results from applying 'CaseResult' to every type in the @xs@ typelist. type family CaseResults (c ::[k1] -> k2) (xs :: [k1]) :: [k2] where     CaseResults c '[] = '[]     CaseResults c (x ': xs) = CaseResult c x ': CaseResults c xs++-- | Tests if all the types in a typelist satisfy a constraint+type family AllConstrained (c :: k -> Constraint) (xs :: [k]) :: Constraint where+    AllConstrained c '[] = ()+    AllConstrained c (x ': xs) = (c x, AllConstrained c xs)+-- https://hackage.haskell.org/package/vinyl-0.6.0/docs/Data-Vinyl-TypeLevel.html#t:AllConstrained

@@ -192,14 +192,3 @@                               ':<>: 'Text "‘"                               ':<>: 'ShowType ys'                               ':<>: 'Text "’")---- | Tests if all the types in a typelist is all a specified type.-type family IsAllImpl (ctx :: [k]) (x :: k) (xs :: [k]) :: Constraint where-    IsAllImpl ctx x '[] = ()-    IsAllImpl ctx x (x ': xs) = IsAllImpl ctx x xs-    IsAllImpl ctx x xs = TypeError ('Text "IsAll error: ‘"-                              ':<>: 'ShowType ctx-                              ':<>: 'Text "’"-                              ':<>: 'Text " must only contain ‘"-                              ':<>: 'ShowType x-                              ':<>: 'Text "’")

@@ -379,7 +379,7 @@ -- let y = 'pickOnly' (5 :: Tagged Bar Int) --     y' = 'diversifyL' \@'[Bar] Proxy y :: 'Which' '[Tagged Bar Int, Tagged Foo Bool] --     y'' = 'diversifyL' \@'[Bar, Foo] Proxy y' :: 'Which' '[Tagged Foo Bool, Tagged Bar Int]--- 'switch' y'' ('Data.Diverse.CaseTypeable.CaseTypeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` \"Tagged * Bar Int"+-- 'switch' y'' ('Data.Diverse.CaseFunc.CaseFunc' \@'Data.Typeable.Typeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` \"Tagged * Bar Int" -- @ diversifyL     :: forall ls branch tree proxy.@@ -411,7 +411,7 @@ -- let y = 'pickOnly' (5 :: Int) --     y' = 'diversifyN' \@'[0] \@_ \@[Int, Bool] Proxy y --     y'' = 'diversifyN' \@[1,0] \@_ \@[Bool, Int] Proxy y'--- 'switch' y'' ('Data.Diverse.CaseTypeable.CaseTypeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` \"Int"+-- 'switch' y'' ('Data.Diverse.CaseFunc.CaseFunc' \@'Data.Typeable.Typeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` \"Int" -- @ diversifyN :: forall indices branch tree proxy. (DiversifyN indices branch tree) => proxy indices -> Which branch -> Which tree diversifyN _ = whichN (CaseDiversifyN @indices @_ @0 @branch)@@ -627,11 +627,11 @@ --         'Data.Diverse.Many../' 'Data.Diverse.Many.nil')) \`shouldBe` "5" -- @ ----- Or 'Data.Diverse.CaseTypeable.CaseTypeable' to apply a polymorphic function that work on all 'Typeables'.+-- Or 'Data.Diverse.CaseFunc.CaseFunc' \@'Data.Typeable.Typeable' to apply a polymorphic function that work on all 'Typeable's. -- -- @ -- let y = 'Data.Diverse.Which.pick' (5 :: Int) :: 'Data.Diverse.Which.Which' '[Int, Bool]--- 'Data.Diverse.Which.switch' y ('CaseTypeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` "Int"+-- 'Data.Diverse.Which.switch' y ('Data.Diverse.CaseFunc.CaseFunc' \@'Data.Typeable.Typeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` "Int" -- @ -- -- Or you may use your own custom instance of 'Case'.

@@ -12,7 +12,6 @@  import Data.Diverse import Data.Int-import Data.Kind import Data.Tagged import Data.Typeable import Test.Hspec@@ -25,32 +24,6 @@  -------------------------------- --- | Create an instance of 'Case' that can handle all 'Num'-newtype CaseNum' (xs :: [Type]) = CaseNum' (forall x. Num x => x -> x)--type instance CaseResult CaseNum' x = x--instance Reiterate CaseNum' (x ': xs) where-    reiterate (CaseNum' f) = CaseNum' f--instance Num x => Case CaseNum' (x ': xs) where-    case' (CaseNum' f) = f-------------------------------------- | Create an instance of 'Case' that can handle all 'Show' and convert to a specified type-newtype CaseShow r (xs :: [Type]) = CaseShow (forall x. Show x => x -> r)--type instance CaseResult (CaseShow r) x = r--instance Reiterate (CaseShow r) (x ': xs) where-    reiterate (CaseShow f) = CaseShow f--instance Show x => Case (CaseShow r) (x ': xs) where-    case' (CaseShow f) = f----------------------------------- data Foo data Bar @@ -332,9 +305,9 @@             afoldr (:) [] (forMany (cases y) x) `shouldBe` ret             afoldr (:) [] (forMany (cases y) x) `shouldBe` ret -        it "can be folded with single 'CaseTypeable' handlers using 'forMany' or 'collect'" $ do+        it "can be folded with polymorphic 'CaseFunc' handlers using 'forMany' or 'collect'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil-            afoldr (:) [] (forMany (CaseTypeable (show . typeRep . (pure @Proxy))) x) `shouldBe` ["Int", "Bool", "Char", "Maybe Char", "Int", "Maybe Char"]+            afoldr (:) [] (forMany (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) x) `shouldBe` ["Int", "Bool", "Char", "Maybe Char", "Int", "Maybe Char"]          it "can be folded with 'Many' handlers in index order using 'forManyN' or 'collectN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil@@ -347,5 +320,5 @@             let x = (5 :: Int) ./ (6 :: Int8) ./ (7 :: Int16) ./ (8 :: Int32) ./ nil                 y = (15 :: Int) ./ (16 :: Int8) ./ (17 :: Int16) ./ (18 :: Int32) ./ nil                 z = ("5" :: String) ./ ("6" :: String) ./ ("7" :: String) ./ ("8" :: String) ./ nil-            afmap (CaseNum' (+10)) x `shouldBe` y-            afmap (CaseShow show) x `shouldBe` z+            afmap (CaseFunc' @Num (+10)) x `shouldBe` y+            afmap (CaseFunc @Show @String show) x `shouldBe` z

@@ -133,19 +133,19 @@             let y = pickOnly (5 :: Int)                 y' = diversify @_ @[Int, Bool] y                 y'' = diversify @_ @[Bool, Int] y'-            switch y'' (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int"+            switch y'' (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int"          it "can be extended and rearranged by type with 'diversify'" $ do             let y = pickOnly (5 :: Tagged Bar Int)                 y' = diversifyL @'[Bar] Proxy y :: Which '[Tagged Bar Int, Tagged Foo Bool]                 y'' = diversifyL @'[Bar, Foo] Proxy y' :: Which '[Tagged Foo Bool, Tagged Bar Int]-            switch y'' (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Tagged * Bar Int"+            switch y'' (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) `shouldBe` "Tagged * Bar Int"          it "can be extended and rearranged by index with 'diversifyN'" $ do             let y = pickOnly (5 :: Int)                 y' = diversifyN @'[0] @_ @[Int, Bool] Proxy y                 y'' = diversifyN @[1,0] @_ @[Bool, Int] Proxy y'-            switch y'' (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int"+            switch y'' (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int"          it "the 'diversify'ed type can contain multiple fields if they aren't in the original 'Many'" $ do             let y = pick @_ @[Int, Char] (5 :: Int)@@ -229,9 +229,9 @@                     ./ show @Int                     ./ nil)) `shouldBe` "5" -        it "can be switched with a single 'CaseTypeable' handler" $ do+        it "can be switched with a polymorphic 'CaseFunc' handler" $ do             let y = pick (5 :: Int) :: Which '[Int, Bool]-            switch y (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int"+            switch y (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int" #if __GLASGOW_HASKELL__ >= 802             let expected = "Which (': * Int (': * Bool ('[] *)))" #else