large-anon 0.2 → 0.2.1

raw patch · 6 files changed

+104/−15 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• large-anon.cabal +2/−2
• src/Data/Record/Anon/Advanced.hs +19/−0
• src/Data/Record/Anon/Internal/Advanced.hs +23/−0
• test/Test/Prop/Record/Combinators/Simple.hs +48/−13
• test/Test/Prop/Record/Model.hs +8/−0

@@ -1,5 +1,9 @@ # Revision history for large-anon +## 0.2.1 -- 2023-07-05++* Add `distribute` (Johannes Gerer, #142)+ ## 0.2 -- 2023-03-06  * Do not generate imports in the plugin (#129).

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-anon-version:            0.2+version:            0.2.1 synopsis:           Scalable anonymous records description:        The @large-anon@ package provides support for anonymous                     records in Haskell, with a focus on compile-time (and@@ -12,7 +12,7 @@ category:           Records extra-source-files: CHANGELOG.md                     test/Test/Sanity/RebindableSyntax/Tests.hs-tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4+tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5  library   exposed-modules:

@@ -48,6 +48,8 @@   , cmapM   , sequenceA   , sequenceA'+  , distribute+  , distribute'     -- ** Zipping   , zip   , zipWith@@ -412,6 +414,23 @@ -- | Simplified form of 'sequenceA' sequenceA' :: Applicative m => Record m r -> m (Record I r) sequenceA' = A.sequenceA'++-- | Distribute+--+-- This is a higher kinded version of @distribute@ from+-- <https://hackage.haskell.org/package/distributive>, and inverse to+-- 'sequenceA'.+--+-- Be careful with this function: if @f@ allows effects, then those effects will+-- be duplicated whenever any field of the resulting record is accessed. Using+-- this with @f == Vector@ or @f == Maybe@ is fine, but you almost certainly+-- don't want to use it with @f == IO@, for example.+distribute :: (Functor m, KnownFields r) => m (Record f r) -> Record (m :.: f) r+distribute = A.distribute++-- | Simplified form of 'distribute'.+distribute' :: (Functor m, KnownFields r) => m (Record I r) -> Record m r+distribute' = A.distribute'  -- | Analogue of 'Prelude.zip' zip :: Record f r -> Record g r -> Record (Product f g) r

@@ -53,6 +53,8 @@   , cmapM   , sequenceA   , sequenceA'+  , distribute+  , distribute'     -- ** Zipping   , zip   , zipWith@@ -339,6 +341,27 @@ sequenceA' = sequenceA . co   where     co :: Record m r -> Record (m :.: I) r+    co = noInlineUnsafeCo++distribute :: forall r m f.+     (Functor m, KnownFields r)+  => m (Record f r) -> Record (m :.: f) r+distribute =+      unsafeFromCanonical+    . Canon.fromList+    . (\cs -> fieldVec cs <$> indices)+    . fmap toCanonical+  where+    indices :: [Int]+    indices = [0 .. pred (length $ proxy fieldNames (Proxy @r))]++    fieldVec :: m (Canonical f) -> Int -> (m :.: f) Any+    fieldVec cs idx = Comp $ flip Canon.getAtIndex idx <$> cs++distribute' :: (Functor m, KnownFields r) => m (Record I r) -> Record m r+distribute' = co . distribute+  where+    co :: Record (m :.: I) r -> Record m r     co = noInlineUnsafeCo  pure :: forall f r. KnownFields r => (forall x. f x) -> Record f r

@@ -1,7 +1,9 @@-{-# LANGUAGE GADTs            #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators    #-}-{-# LANGUAGE ViewPatterns     #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE ViewPatterns        #-}  module Test.Prop.Record.Combinators.Simple (tests) where @@ -9,6 +11,7 @@ import Data.Bifunctor import Data.SOP +import qualified Data.Record.Anon          as Anon import qualified Data.Record.Anon.Advanced as Anon  import Test.Tasty@@ -21,15 +24,16 @@  tests :: TestTree tests = testGroup "Test.Prop.Record.Combinators.Simple" [-      testProperty "map"       test_map-    , testProperty "mapM"      test_mapM-    , testProperty "zip"       test_zip-    , testProperty "zipWith"   test_zipWith-    , testProperty "zipWithM"  test_zipWithM-    , testProperty "collapse"  test_collapse-    , testProperty "sequenceA" test_sequenceA-    , testProperty "pure"      test_pure-    , testProperty "ap"        test_ap+      testProperty "map"        test_map+    , testProperty "mapM"       test_mapM+    , testProperty "zip"        test_zip+    , testProperty "zipWith"    test_zipWith+    , testProperty "zipWithM"   test_zipWithM+    , testProperty "collapse"   test_collapse+    , testProperty "sequenceA"  test_sequenceA+    , testProperty "pure"       test_pure+    , testProperty "ap"         test_ap+    , testProperty "distribute" test_distribute     ]  {-------------------------------------------------------------------------------@@ -39,6 +43,13 @@ pTop :: Proxy Top pTop = Proxy +data Pair a = MkPair a a+  deriving (Show, Eq, Functor)++instance Applicative Pair where+  pure x = MkPair x x+  MkPair f1 f2 <*> MkPair x1 x2 = MkPair (f1 x1) (f2 x2)+ {-------------------------------------------------------------------------------   Tests proper -------------------------------------------------------------------------------}@@ -141,3 +152,27 @@      f :: K Int x -> (K Int -.-> K Int) x     f (K x) = fn $ \(K y) -> K (x + y)++-- | Test 'Anon.distribute'+--+-- We do not have a model implementation, but instead test that+-- 'Anon.distribute' is right inverse to 'Anon.sequenceA'.+test_distribute ::+     SomeRecordPair (K Int) (K Int)+  -> Property+test_distribute = \(SR2 fields r1 r2) ->+    Modl.fieldsKnown fields $+      go fields r1 r2+  where+    go :: forall r.+         Anon.KnownFields r+      => Modl.ModelFields r+      -> Modl.ModelRecord (K Int) r+      -> Modl.ModelRecord (K Int) r+      -> Property+    go fields r1 r2 =+            rs+        === Anon.sequenceA (Anon.distribute rs)+      where+        rs :: Pair (Anon.Record (K Int) r)+        rs = MkPair (Modl.toRecord fields r1) (Modl.toRecord fields r2)

@@ -34,6 +34,7 @@     -- * Constraints   , ModelSatisfies   , satisfyAll+  , fieldsKnown     -- * Conversion to/from 'Record'   , toRecord   , fromRecord@@ -70,6 +71,7 @@  import Data.Record.Anon import Data.Record.Anon.Advanced (Record)+ import qualified Data.Record.Anon.Advanced as Anon  {-------------------------------------------------------------------------------@@ -122,6 +124,12 @@ satisfyAll _ MF1  k = k satisfyAll _ MF2  k = k satisfyAll _ MF2' k = k++fieldsKnown :: ModelFields r -> (KnownFields r => a) -> a+fieldsKnown MF0  k = k+fieldsKnown MF1  k = k+fieldsKnown MF2  k = k+fieldsKnown MF2' k = k  {-------------------------------------------------------------------------------   Conversion from/to model