data-diverse 4.1.0.0 → 4.2.0.0

raw patch · 9 files changed

+112/−25 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +6/−0
• data-diverse.cabal +1/−1
• src/Data/Diverse/AFunctor.hs +1/−1
• src/Data/Diverse/CaseFunc.hs +24/−1
• src/Data/Diverse/TypeLevel.hs +5/−0
• src/Data/Diverse/Which.hs +1/−0
• src/Data/Diverse/Which/Internal.hs +44/−14
• test/Data/Diverse/ManySpec.hs +11/−5
• test/Data/Diverse/WhichSpec.hs +19/−3

@@ -14,6 +14,12 @@  # Changelog +* 4.2.0.0+  - Added `CaseFunc1` to allow `afmap` of with `Functor`, etc.+  - `Which` is now also an instance of `AFoldable`.+  - Added `NoConstraint` which is useful for `CaseFunc1` for unused constraints.+  - Added `definitely`.+ * 4.1.0.0   - Removed `zilch`. 

@@ -1,5 +1,5 @@ name:                data-diverse-version:             4.1.0.0+version:             4.2.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).

@@ -5,6 +5,6 @@ import Data.Diverse.TypeLevel  -- | Given a 'Data.Diverse.Case' that transforms each type in the--- typelist, convert a @f xs@ to @f (CasesResult2 c xs)@+-- typelist, convert a @f xs@ to @f (CasesResults c xs)@ class AFunctor f c xs where     afmap :: c xs -> f xs -> f (CaseResults c xs)

@@ -5,8 +5,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}  module Data.Diverse.CaseFunc where @@ -55,3 +55,26 @@  instance k x => Case (CaseFunc' k) (x ': xs) where     case' (CaseFunc' f) = f++-- | This handler stores a polymorphic function that work on higher kinds, eg 'Functor'+-- You may want to use @NoContraint for @k@+newtype CaseFunc1 (k :: Type -> Constraint) (k1 :: (Type -> Type) -> Constraint) (k0 :: Type -> Constraint) r (xs :: [Type]) = CaseFunc1 (forall f x. (k (f x), k1 f, k0 x) => f x -> f r)++type instance CaseResult (CaseFunc1 k k1 k0 r) (f x) = f r++instance Reiterate (CaseFunc1 k k1 k0 r) xs where+    reiterate (CaseFunc1 f) = CaseFunc1 f++instance (k (f x), k1 f, k0 x) => Case (CaseFunc1 k k1 k0 r) (f x ': xs) where+    case' (CaseFunc1 f) = f++-- | A varation of 'CaseFunc' that doesn't change the return type+newtype CaseFunc1' (k :: Type -> Constraint) (k1 :: (Type -> Type) -> Constraint) (k0 :: Type -> Constraint) (xs :: [Type]) = CaseFunc1' (forall f x. (k (f x), k1 f, k0 x) => f x -> f x)++type instance CaseResult (CaseFunc1' k k1 k0) (f x) = f x++instance Reiterate (CaseFunc1' k k1 k0) xs where+    reiterate (CaseFunc1' f) = CaseFunc1' f++instance (k (f x), k1 f, k0 x) => Case (CaseFunc1' k k1 k0) (f x ': xs) where+    case' (CaseFunc1' f) = f

@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-}@@ -173,3 +174,7 @@     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++-- | This is useful as a level function for @k@ in 'CaseFunc1'+class NoConstraint a where+instance NoConstraint a where

@@ -7,6 +7,7 @@       -- ** Construction     , impossible     , impossible'+    , definitely     , pick     , pick0     , pickOnly

@@ -28,6 +28,7 @@       -- ** Construction     , impossible     , impossible'+    , definitely     , pick     , pick0     , pickOnly@@ -85,6 +86,7 @@ import Control.Applicative import Control.DeepSeq import Control.Monad+import Data.Diverse.AFunctor import Data.Diverse.Case import Data.Diverse.CaseFunc import Data.Diverse.Reduce@@ -95,7 +97,7 @@ import Data.Semigroup (Semigroup(..)) import Data.Tagged import Data.Void-import GHC.Exts (Any, coerce)+import GHC.Exts (Any) import qualified GHC.Generics as G import GHC.TypeLits import Text.ParserCombinators.ReadPrec@@ -187,6 +189,11 @@ impossible' :: Which '[Void] -> a impossible' a = case a of {} +-- | This function is useful to type restrict something (usually a continuation monad)+-- that returns a polymorphic type to return (Which '[])+definitely :: f (Which '[]) -> f (Which '[])+definitely = id+ -- | Lift a value into a 'Which' of possibly other types @xs@. -- @xs@ can be inferred or specified with TypeApplications. -- NB. forall is used to specify @xs@ first, so TypeApplications can be used to specify @xs@ first@@ -837,33 +844,34 @@ class WhichRead v where     whichReadPrec :: Int -> Int -> ReadPrec v -data Which_ (xs ::[Type]) = Which_ Int Any--diversify0' :: forall x xs. Which_ xs -> Which_ (x ': xs)-diversify0' = coerce+-- | coerce Which to another type without incrementing Int.+-- THis is because 'WhichRead' instance already increments the int+coerceReadWhich :: forall x xs. Which xs -> Which (x ': xs)+coerceReadWhich (Which i x) = Which i x -readWhich_ :: forall x xs. Read x => Int -> Int -> ReadPrec (Which_ (x ': xs))-readWhich_ i j = guard (i == j) >> parens (prec app_prec $ (Which_ i . unsafeCoerce) <$> readPrec @x)+-- | Succeed reading if the Int index match+readWhich :: forall x xs. Read x => Int -> Int -> ReadPrec (Which (x ': xs))+readWhich i j = guard (i == j) >> parens (prec app_prec $ (Which i . unsafeCoerce) <$> readPrec @x)       where         app_prec = 10 -instance Read x => WhichRead (Which_ '[x]) where-    whichReadPrec = readWhich_+instance Read x => WhichRead (Which '[x]) where+    whichReadPrec = readWhich -instance (Read x, WhichRead (Which_ (x' ': xs))) => WhichRead (Which_ (x ': x' ': xs)) where-    whichReadPrec i j = readWhich_ i j-               <|> (diversify0' <$> (whichReadPrec i (j + 1) :: ReadPrec (Which_ (x' ': xs))))+instance (Read x, WhichRead (Which (x' ': xs))) => WhichRead (Which (x ': x' ': xs)) where+    whichReadPrec i j = readWhich i j+               <|> (coerceReadWhich <$> (whichReadPrec i (j + 1) :: ReadPrec (Which (x' ': xs))))     {-# INLINABLE whichReadPrec #-} -- This makes compiling tests a little faster than with no pragma  -- | This 'Read' instance tries to read using the each type in the typelist, using the first successful type read.-instance WhichRead (Which_ (x ': xs)) =>+instance WhichRead (Which (x ': xs)) =>          Read (Which (x ': xs)) where     readPrec =         parens $ prec app_prec $ do             lift $ L.expect (Ident "pickN")             lift $ L.expect (Punc "@")             i <- lift L.readDecP-            Which_ n v <- whichReadPrec i 0 :: ReadPrec (Which_ (x ': xs))+            Which n v <- whichReadPrec i 0 :: ReadPrec (Which (x ': xs))             pure $ Which n v       where         app_prec = 10@@ -875,3 +883,25 @@ instance (Reduce (Which (x ': xs)) (Switcher (CaseFunc NFData) () (x ': xs))) =>   NFData (Which (x ': xs)) where     rnf x = switch x (CaseFunc @NFData rnf)++------------------------------------------------------------------++-- class AFunctor f c xs where+--     afmap :: c xs -> f xs -> f (CaseResults c xs)++-- | Terminating AFunctor instance for empty type list+instance AFunctor Which c '[] where+    afmap _ = impossible++-- | Recursive AFunctor instance for non empty type list+-- delegate afmap'ing the remainder to an instance of Collector' with one less type in the type list+instance ( Reiterate c (a ': as)+         , AFunctor Which c as+         , Case c (a ': as)+         ) =>+         AFunctor Which c (a ': as) where+    afmap c v = case trial0 v of+        Right a' -> Which 0 (unsafeCoerce (case' c a'))+        Left v' -> diversify0 (afmap (reiterate c) v')+    {-# INLINABLE afmap #-}+    -- This makes compiling tests a little faster than with no pragma

@@ -7,6 +7,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.Diverse.ManySpec (main, spec) where @@ -33,12 +34,12 @@          -- it "Test user friendly compile errors" $ do         --     let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil-            -- ghc 8.0.2: IndexOf error: ‘Maybe Bool’ is not a member of ...-            -- ghc 8.0.1 has terrible error message: "No instance for (GHC.TypeLits.KnownNat"-            -- grab @(Maybe Bool) y `shouldBe` (Just False)+        --     -- ghc 8.0.2: IndexOf error: ‘Maybe Bool’ is not a member of ...+        --     -- ghc 8.0.1 has terrible error message: "No instance for (GHC.TypeLits.KnownNat"+        --     grab @(Maybe Bool) y `shouldBe` (Just False) -            -- Not unique error: ‘Maybe Char’ is a duplicate in ...-            -- grab @(Maybe Bool) y `shouldBe` (Just False)+        --     -- Not unique error: ‘Maybe Char’ is a duplicate in ...+        --     grab @(Maybe Bool) y `shouldBe` (Just False)          it "is a Typeable" $ do             let x = (5 :: Int) ./ False ./ nil@@ -330,5 +331,10 @@             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+                mx = (Just 5 :: Maybe Int) ./ ([6] :: [Int8]) ./ nil+                my = (Just 15 :: Maybe Int) ./ ([16] :: [Int8]) ./ nil+                mz = (Just "5" :: Maybe String) ./ (["6"] :: [String]) ./ nil             afmap (CaseFunc' @Num (+10)) x `shouldBe` y             afmap (CaseFunc @Show @String show) x `shouldBe` z+            afmap (CaseFunc1' @NoConstraint @Functor @Num (fmap (+10))) mx `shouldBe` my+            afmap (CaseFunc1 @NoConstraint @Functor @Show @String (fmap show)) mx `shouldBe` mz

@@ -10,6 +10,7 @@ module Data.Diverse.WhichSpec (main, spec) where  import Data.Diverse+import Data.Int import Data.Tagged import Data.Typeable import Test.Hspec@@ -37,9 +38,12 @@             show x `shouldBe` "pickN @0 5"          it "is a Read and Show" $ do-            let s = "pickN @0 5"-                x = read s :: Which '[Int, Bool]-            show x `shouldBe` s+            let s1 = "pickN @0 5"+                x1 = read s1 :: Which '[Int, Bool]+            show x1 `shouldBe` s1+            let s2 = "pickN @1 True"+                x2 = read s2 :: Which '[Int, Bool]+            show x2 `shouldBe` s2             -- "zilch" `shouldBe` show zilch             -- "zilch" `shouldBe` show (read "zilch" :: Which '[]) @@ -268,3 +272,15 @@             case trial @Int x of                 Right y -> y `shouldBe` y                 Left z -> impossible z++        it "every possibility can be mapped into a different type in a Functor-like fashion with using 'afmap'" $ do+            let x = pick (5 :: Int8) :: Which '[Int, Int8, Int16]+                y = pick (15 :: Int8) :: Which '[Int, Int8, Int16]+                z = pickN @1 ("5" :: String) :: Which '[String, String, String]+                mx = pick (Just 5 :: Maybe Int8) :: Which '[Maybe Int, Maybe Int8, Maybe Int16]+                my = pick (Just 15 :: Maybe Int8) :: Which '[Maybe Int, Maybe Int8, Maybe Int16]+                mz = pickN @1 (Just "5" :: Maybe String) :: Which '[Maybe String, Maybe String, Maybe String]+            afmap (CaseFunc' @Num (+10)) x `shouldBe` y+            afmap (CaseFunc @Show @String show) x `shouldBe` z+            afmap (CaseFunc1' @NoConstraint @Functor @Num (fmap (+10))) mx `shouldBe` my+            afmap (CaseFunc1 @NoConstraint @Functor @Show @String (fmap show)) mx `shouldBe` mz