data-diverse 0.6.0.0 → 0.7.0.0

raw patch · 7 files changed

+85/−57 lines, 7 filesdep +criteriondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +2/−0
• bench/Bench.hs +11/−0
• bench/Data/Diverse/ManyBench.hs +11/−0
• bench/Data/Diverse/WhichBench.hs +11/−0
• data-diverse.cabal +17/−1
• src/Data/Diverse/Many/Internal.hs +28/−43
• src/Data/Diverse/Which/Internal.hs +5/−13

@@ -9,3 +9,5 @@ accessed by type or index or label.  Refer to [ManySpec.hs](https://github.com/louispan/data-diverse/blob/master/test/Data/Diverse/ManySpec.hs) and [WhichSpec.hs](https://github.com/louispan/data-diverse/blob/master/test/Data/Diverse/WhichSpec.hs) for example usages.++Iso, Lens and Prisms are provided in [data-diverse-lens](http://hackage.haskell.org/package/data-diverse-lens)

@@ -0,0 +1,11 @@+module Main where++import Criterion.Main+import qualified Data.Diverse.ManyBench as ManyBench+import qualified Data.Diverse.WhichBench as WhichBench++-- Our benchmark harness.+main = defaultMain [+    ManyBench.bgroup+  , WhichBench.bgroup+  ]

@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Data.Diverse.ManyBench where++import qualified Criterion.Main as C+import Data.Diverse++bgroup = C.bgroup "Many"+    [ C.bench "read" (C.whnf (read @(Many '[Int, Bool, Char, Maybe Char])) "5 ./ False ./ 'X' ./ Just 'O' ./ nil")+    ]

@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Data.Diverse.WhichBench where++import qualified Criterion.Main as C+import Data.Diverse++bgroup = C.bgroup "Which"+    [ C.bench "read" $ C.whnf (read @(Which '[Int, Bool])) "pickN @0 Proxy 5"+    ]

@@ -1,11 +1,15 @@ name:                data-diverse-version:             0.6.0.0+version:             0.7.0.0 synopsis:            Extensible records and polymorphic variants. description:         "Data.Diverse.Many" is an extensible record for any size encoded efficiently as (Int, Map Int Any).                      "Data.Diverse.Which" is a polymorphic variant of possibilities encoded as (Int, Any).                      Provides getters, setters, projection, injection, folds, and catamorphisms;                      accessed by type, index or label.+                      Refer to [ManySpec.hs](https://github.com/louispan/data-diverse/blob/master/test/Data/Diverse/ManySpec.hs) and [WhichSpec.hs](https://github.com/louispan/data-diverse/blob/master/test/Data/Diverse/WhichSpec.hs) for example usages.++                     Iso, Lens and Prisms are provided in [data-diverse-lens](http://hackage.haskell.org/package/data-diverse-lens)+ homepage:            https://github.com/louispan/data-diverse#readme license:             BSD3 license-file:        LICENSE@@ -52,6 +56,18 @@                      , hspec >= 2 && < 3                      , tagged >= 0.8.5 && < 1   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010++benchmark data-diverse-bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      bench+  main-is:             Bench.hs+  other-modules:       Data.Diverse.ManyBench+                       Data.Diverse.WhichBench+  build-depends:       base+                     , data-diverse+                     , criterion+  ghc-options:         -O2   default-language:    Haskell2010  source-repository head

@@ -88,7 +88,7 @@ import Data.Diverse.Reiterate import Data.Diverse.TypeLevel import Data.Kind-import qualified Data.Map.Strict as M+import qualified Data.IntMap.Strict as M import Data.Proxy import Data.Tagged import qualified GHC.Generics as G@@ -131,7 +131,7 @@ -- -- The constructor will guarantee the correct number and types of the elements. -- The constructor is only exported in the "Data.Diverse.Many.Internal" module-data Many (xs :: [Type]) = Many {-# UNPACK #-} !Int (M.Map Int Any)+data Many (xs :: [Type]) = Many {-# UNPACK #-} !Int (M.IntMap Any)  -- Inferred role is phantom which is incorrect -- representational means:@@ -164,11 +164,7 @@ instance G.Generic (Many (x ': xs)) where     type Rep (Many (x ': xs)) = (G.Rec0 x) G.:*: (G.Rec0 (Many xs))     from r = ({- G.Rec0 -} G.K1 (front r)) G.:*: ({- G.Rec0 -} G.K1 (aft r))-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE from #-}     to (({- G.Rec0 -} G.K1 a) G.:*: ({- G.Rec0 -} G.K1 b)) = a ./ b-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE to #-}  ----------------------------------------------------------------------- @@ -281,7 +277,6 @@ -- \OldRightKey -> OldRightKey - RightOffset + LeftOffset + LeftSize rightKeyForSnoc :: Int -> Int -> Int -> Int -> Int rightKeyForSnoc lo ld ro rk = rk - ro + lo + ld-{-# INLINE rightKeyForSnoc #-}  -- | When appending two maps together, get the function to modify the RightMap's offset -- when adding LeftMap into RightMap.@@ -289,7 +284,6 @@ -- NewRightOffset = OldRightOffset - LeftSize rightOffsetForCons :: Int -> Int -> Int rightOffsetForCons ld ro = ro - ld-{-# INLINE rightOffsetForCons #-}  -- | When appending two maps together, get the function to 'M.mapKeys' the LeftMap -- when adding LeftMap into RightMap.@@ -302,9 +296,8 @@ -- \OldLeftKey -> OldLeftKey - LeftOffset + NewRightOffset (as above) leftKeyForCons :: Int -> Int -> Int -> Int leftKeyForCons lo ro lk = lk - lo + ro-{-# INLINE leftKeyForCons #-} --- | Analogous to 'Prelude.nill'. Named 'nil' to avoid conflicting with 'Prelude.nill'.+-- | Analogous to 'Prelude.null'. Named 'nil' to avoid conflicting with 'Prelude.null'. nil :: Many '[] nil = Many 0 M.empty @@ -335,7 +328,7 @@ infixr 5 ./ -- like Data.List.(:)  -- | Add an element to the right of a Many--- Not named 'snoc' to avoid conflict with 'Control.Lens.snoc'+-- Not named @snoc@ to avoid conflict with 'Control.Lens.snoc' postfix :: Many xs -> y -> Many (Append xs '[y]) postfix (Many lo lm) y = Many lo     (M.insert (rightKeyForSnoc lo (M.size lm) 0 0)@@ -343,12 +336,16 @@         lm) infixl 5 `postfix` --- | 'snoc' mnemonic: Many is larger '\.' than the smaller element+-- | Infix version of 'postfix'.+--+-- Mnemonic: Many is larger '\.' than the smaller element (\.) :: Many xs -> y -> Many (Append xs '[y]) (\.) = postfix infixl 5 \. --- | 'append' mnemonic: 'cons' './' with an extra slash (meaning 'Many') in front.+-- | Infix version of 'append'.+--+-- Mnemonic: 'prefix' './' with an extra slash (meaning 'Many') in front. (/./) :: Many xs -> Many ys -> Many (Append xs ys) (/./) = append infixr 5 /./ -- like (++)@@ -415,8 +412,8 @@  -- | Getter by label. Get the value of the field with tag @label@ which can be any type -- not just @KnownSymbol@.--- @ --+-- @ -- let y = False './' Tagged \@Foo \'X' './' Tagged @"Hi" True './' 'nil' -- 'fetchL' \@Foo Proxy y \`shouldBe` Tagged \@Foo \'X' -- 'fetchL' \@"Hi" Proxy y \`shouldBe` Tagged \@"Hi" True@@ -510,7 +507,7 @@ -----------------------------------------------------------------------  -- | Internal function for construction - do not expose!-fromList' :: Ord k => [(k, WrappedAny)] -> M.Map k Any+fromList' :: [(Int, WrappedAny)] -> M.IntMap Any fromList' xs = M.fromList (coerce xs)  -----------------------------------------------------------------------@@ -538,8 +535,7 @@        -- use of head/tail here is safe as we are guaranteed the length from the typelist        x = Partial.head xs        xs' = Partial.tail xs-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE afoldr #-}+    {-# INLINABLE afoldr #-} -- This makes compiling tests a little faster than with no pragma  forMany' :: c xs r -> Many xs -> CollectorAny c xs r forMany' c (Many _ xs) = CollectorAny c (snd <$> M.toAscList xs)@@ -563,8 +559,7 @@        -- use of head/tail here is safe as we are guaranteed the length from the typelist        x = Partial.head xs        xs' = Partial.tail xs-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE afoldr #-}+    {-# INLINABLE afoldr #-} -- This makes compiling tests a little faster than with no pragma  forManyN' :: c n xs r -> Many xs -> CollectorAnyN c n xs r forManyN' c (Many _ xs) = CollectorAnyN c (snd <$> M.toAscList xs)@@ -583,7 +578,7 @@ instance AFoldable (Collector c '[]) r where     afoldr _ z _ = z --- | Folds values by 'reiterate'ing 'Emit'ters through the @xs@ typelist.+-- | Folds values by 'reiterate'ing 'Case's through the @xs@ typelist. instance ( Case c (x ': xs) r          , Reiterate c (x ': xs)          , AFoldable (Collector c xs) r@@ -594,24 +589,21 @@        -- use of head/tail here is safe as we are guaranteed the length from the typelist        v = unsafeCoerce $ Partial.head xs        xs' = Partial.tail xs-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE afoldr #-}+    {-# INLINABLE afoldr #-} -- This makes compiling tests a little faster than with no pragma  -----------------------------------------------------------------------  -- | Folds any 'Many', even with indistinct types.--- Given __distinct__ handlers for the fields in 'Many', create a 'Collector'+-- Given __distinct__ handlers for the fields in 'Many', create 'AFoldable' -- of the results of running the handlers over the fields in 'Many'. ----- The 'Collector' is 'AFoldable' to combine the results.--- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil' --     y = show \@Int './' show \@Char './' show \@(Maybe Char) './' show \@Bool './' 'nil' -- 'afoldr' (:) [] ('forMany' ('Data.Diverse.Cases.cases' y) x) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-forMany :: c xs r -> Many xs -> Collector c xs r+forMany :: (t ~ Collector c xs, AFoldable t r, Case c xs r) => c xs r -> Many xs -> t r forMany c (Many _ xs) = Collector c (snd <$> M.toAscList xs)  -- | This is @flip 'forMany'@@@ -622,7 +614,7 @@ -- 'afoldr' (:) [] ('collect' x ('Data.Diverse.Cases.cases' y)) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-collect :: Many xs -> c xs r -> Collector c xs r+collect :: (t ~ Collector c xs, AFoldable t r, Case c xs r) => Many xs -> c xs r -> t r collect = flip forMany  -----------------------------------------------------------------------@@ -645,22 +637,19 @@        -- use of head/tail here is safe as we are guaranteed the length from the typelist        v = unsafeCoerce $ Partial.head xs        xs' = Partial.tail xs-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE afoldr #-}+    {-# INLINABLE afoldr #-} -- This makes compiling tests a little faster than with no pragma  -- | Folds any 'Many', even with indistinct types.--- Given __index__ handlers for the fields in 'Many', create a 'CollectorN'+-- Given __index__ handlers for the fields in 'Many', create 'AFoldable' -- of the results of running the handlers over the fields in 'Many'. ----- The 'CollectorN' is 'AFoldable' to combine the results.--- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil' --     y = show \@Int './' show \@Bool './' show \@Char './' show \@(Maybe Char) './' show \@Int './' show \@(Maybe Char) './' 'nil' -- 'afoldr' (:) [] ('forManyN' ('Data.Diverse.Cases.casesN' y) x) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-forManyN :: c n xs r -> Many xs -> CollectorN c n xs r+forManyN :: (t ~ CollectorN c n xs, AFoldable t r, Case (c n) xs r) => c n xs r -> Many xs -> t r forManyN c (Many _ xs) = CollectorN c (snd <$> M.toAscList xs)  -- | This is @flip 'forManyN'@@@ -671,7 +660,7 @@ -- 'afoldr' (:) [] ('collectN' x ('Data.Diverse.Cases.casesN' y)) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-collectN :: Many xs -> c n xs r -> CollectorN c n xs r+collectN :: (t ~ CollectorN c n xs, AFoldable t r, Case (c n) xs r) => Many xs -> c n xs r -> t r collectN = flip forManyN  -----------------------------------------------------------------------@@ -956,8 +945,7 @@     ls == rs = case front' ls == front' rs of         False -> False         _ -> (aft' ls) == (aft' rs)-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE (==) #-}+    {-# INLINABLE (==) #-} -- This makes compiling tests a little faster than with no pragma  -- | Two 'Many's are equal if all their fields equal instance Eq (Many_ xs) => Eq (Many xs) where@@ -973,8 +961,7 @@         LT -> LT         GT -> GT         EQ -> compare (aft' ls) (aft' rs)-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE compare #-}+    {-# INLINABLE compare #-} -- This makes compiling tests a little faster than with no pragma  -- | Two 'Many's are ordered by 'compare'ing their fields in index order instance Ord (Many_ xs) => Ord (Many xs) where@@ -997,10 +984,9 @@         cons_prec = 5 -- infixr 5 prefix         -- use of front here is safe as we are guaranteed the length from the typelist         v = unsafeCoerce (Partial.head xs) :: x-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE showsPrec #-}+    {-# INLINABLE showsPrec #-} -- This makes compiling tests a little faster than with no pragma --- | Two 'Many's are equal if all their fields equal+-- | @show (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' == "5 ./ False ./ 'X' ./ Just 'O' ./ nil" == @ instance Show (Many_ xs) => Show (Many xs) where     showsPrec d xs = showsPrec d (toMany_ xs) @@ -1021,8 +1007,7 @@         pure $ prefix' a as       where         cons_prec = 5 -- infixr `prefix`-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    {-# NOINLINE readPrec #-}+    {-# INLINABLE readPrec #-} -- This makes compiling tests a little faster than with no pragma  -- | @read "5 ./ False ./ 'X' ./ Just 'O' ./ nil" == (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'@ instance Read (Many_ xs) => Read (Many xs) where

@@ -464,10 +464,8 @@         case trial0 v of             Right a -> case' c a             Left v' -> reduce (Switch (reiterate c)) v'-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    -- Using INLINEABLE instead of NOLINE so that ghc 8.2.1 can optimize to single case statement-    -- See https://ghc.haskell.org/trac/ghc/ticket/12877-    {-# INLINEABLE reduce #-}+    -- Ghc 8.2.1 can optimize to single case statement. See https://ghc.haskell.org/trac/ghc/ticket/12877+    {-# INLINABLE reduce #-} -- This makes compiling tests a little faster than with no pragma  -- | Terminating case of the loop, ensuring that a instance of @Case '[]@ -- with an empty typelist is not required.@@ -517,10 +515,8 @@         case trial0 v of             Right a -> case' c a             Left v' -> reduce (SwitchN (reiterateN c)) v'-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    -- Using INLINEABLE instead of NOLINE so that ghc 8.2.1 can optimize to single case statement-    -- See https://ghc.haskell.org/trac/ghc/ticket/12877-    {-# INLINEABLE reduce #-}+    -- Ghc 8.2.1 can optimize to single case statement. See https://ghc.haskell.org/trac/ghc/ticket/12877+    {-# INLINABLE reduce #-} -- This makes compiling tests a little faster than with no pragma  -- | Terminating case of the loop, ensuring that a instance of @Case '[]@ -- with an empty typelist is not required.@@ -643,11 +639,7 @@ 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))))-    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types-    -- Using INLINEABLE instead of NOLINE so that ghc 8.2.1 can optimize to single case statement-    -- See https://ghc.haskell.org/trac/ghc/ticket/12877-    {-# INLINEABLE whichReadPrec #-}-+    {-# 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)) =>