acc 0.1.1 → 0.1.2

raw patch · 5 files changed

+283/−149 lines, 5 filesdep +semigroupoidsPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroupoids

API changes (from Hackage documentation)

Files

• acc.cabal +4/−2
• library/Acc.hs +14/−11
• library/Acc/BinTree1.hs +180/−136
• library/Acc/NeAcc.hs +78/−0
• library/Acc/Prelude.hs +7/−0

@@ -1,5 +1,5 @@ name: acc-version: 0.1.1+version: 0.1.2 synopsis: Sequence optimized for monoidal construction and folding description:   Data structure intended for accumulating a sequence of elements@@ -30,12 +30,14 @@   default-language: Haskell2010   exposed-modules:     Acc+    Acc.NeAcc   other-modules:     Acc.BinTree1     Acc.Prelude   build-depends:     base >=4.11 && <5,-    deepseq >=1.4.4 && <1.5+    deepseq >=1.4.4 && <1.5,+    semigroupoids >=5.3.4 && <6  benchmark benchmark   type: exitcode-stdio-1.0

@@ -10,9 +10,10 @@ ) where -import Acc.Prelude+import Acc.Prelude hiding (toNonEmpty) import qualified Acc.BinTree1 as BinTree1 import qualified Data.Foldable as Foldable+import qualified Data.Semigroup.Foldable as Foldable1   {-|@@ -20,6 +21,8 @@ for later traversal or folding. Useful for implementing all kinds of builders on top. +Appending and prepending is always \(\mathcal{O}(1)\).+ To produce a single element 'Acc' use 'pure'. To produce a multielement 'Acc' use 'fromList'. To combine use '<|>' or '<>' and other 'Alternative' and 'Monoid'-related utils.@@ -49,39 +52,39 @@   foldMap f =     \ case       TreeAcc a ->-        BinTree1.foldMap f a+        foldMap f a       EmptyAcc ->         mempty #if MIN_VERSION_base(4,13,0)   foldMap' f =     \ case       TreeAcc a ->-        BinTree1.foldMap' f a+        foldMap' f a       EmptyAcc ->         mempty #endif   foldr step acc =     \ case       TreeAcc a ->-        BinTree1.foldr step acc a+        foldr step acc a       EmptyAcc ->         acc   foldr' step acc =     \ case       TreeAcc a ->-        BinTree1.foldr' step acc a+        foldr' step acc a       EmptyAcc ->         acc   foldl step acc =     \ case       TreeAcc a ->-        BinTree1.foldl step acc a+        foldl step acc a       EmptyAcc ->         acc   foldl' step acc =     \ case       TreeAcc a ->-        BinTree1.foldl' step acc a+        foldl' step acc a       EmptyAcc ->         acc   sum =@@ -91,7 +94,7 @@   traverse f =     \ case       TreeAcc a ->-        TreeAcc <$> BinTree1.traverse f a+        TreeAcc <$> traverse f a       EmptyAcc ->         pure EmptyAcc @@ -103,7 +106,7 @@       TreeAcc a ->         \ case           TreeAcc b ->-            TreeAcc (BinTree1.ap a b)+            TreeAcc (a <*> b)           EmptyAcc ->             EmptyAcc       EmptyAcc ->@@ -142,7 +145,7 @@   toList =     \ case       TreeAcc a ->-        BinTree1.foldr (:) [] a+        foldr (:) [] a       _ ->         [] @@ -223,6 +226,6 @@ toNonEmpty =   \ case     TreeAcc tree ->-      Just (BinTree1.toNonEmpty tree)+      Just (Foldable1.toNonEmpty tree)     EmptyAcc ->       Nothing

@@ -1,25 +1,17 @@+{-# LANGUAGE CPP #-} module Acc.BinTree1 (   BinTree1(..),   foldM,-  ap,   fromList1,-  foldMap,-  foldMap',-  foldr,-  foldr',-  foldl,-  foldl',-  traverse,   uncons,   unconsTo,   unsnoc,   unsnocTo,-  toNonEmpty, ) where -import Acc.Prelude hiding (ap, foldM, foldl, foldl', foldr, foldr', foldMap, foldMap', traverse)+import Acc.Prelude hiding (foldM) import qualified Acc.Prelude as Prelude  @@ -34,134 +26,203 @@  deriving instance Functor BinTree1 -foldM :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> m a-foldM step !acc =-  \ case-    Branch a b -> foldMOnBranch step acc a b-    Leaf a -> step acc a+instance Applicative BinTree1 where+  pure =+    Leaf+  (<*>) =+    \ case+      Branch a b ->+        \ c ->+          Branch (a <*> c) (b <*> c)+      Leaf a ->+        fmap a  -foldMOnBranch :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> BinTree1 b -> m a-foldMOnBranch step acc a b =-  case a of-    Leaf c -> step acc c >>= \ acc' -> foldM step acc' b-    Branch c d -> foldMOnBranch step acc c (Branch d b)+instance Foldable BinTree1 where+  +  foldr :: (a -> b -> b) -> b -> BinTree1 a -> b+  foldr step acc =+    \ case+      Branch a b ->+        foldrOnBranch step acc a b+      Leaf a ->+        step a acc+    where+      foldrOnBranch :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b+      foldrOnBranch step acc a b =+        case a of+          Leaf c ->+            step c (foldr step acc b)+          Branch c d ->+            foldrOnBranch step acc c (Branch d b) -foldr :: (a -> b -> b) -> b -> BinTree1 a -> b-foldr step acc =-  \ case-    Branch a b ->-      foldrOnBranch step acc a b-    Leaf a ->-      step a acc+  foldr' :: (a -> b -> b) -> b -> BinTree1 a -> b+  foldr' step !acc =+    \ case+      Branch a b -> foldrOnBranch' step acc a b+      Leaf a -> step a acc+    where+      foldrOnBranch' :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b+      foldrOnBranch' step acc a b =+        case b of+          Leaf c -> foldr' step (step c acc) a+          Branch c d -> foldrOnBranch' step acc (Branch a c) d -foldrOnBranch :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b-foldrOnBranch step acc a b =-  case a of-    Leaf c ->-      step c (foldr step acc b)-    Branch c d ->-      foldrOnBranch step acc c (Branch d b)+  foldl :: (b -> a -> b) -> b -> BinTree1 a -> b+  foldl step acc =+    \ case+      Branch a b ->+        foldlOnBranch step acc a b+      Leaf a ->+        step acc a+    where+      foldlOnBranch :: (b -> a -> b) -> b -> BinTree1 a -> BinTree1 a -> b+      foldlOnBranch step acc a b =+        case b of+          Leaf c ->+            step (foldl step acc a) c+          Branch c d ->+            foldlOnBranch step acc (Branch a c) d -foldr' :: (a -> b -> b) -> b -> BinTree1 a -> b-foldr' step !acc =-  \ case-    Branch a b -> foldrOnBranch' step acc a b-    Leaf a -> step a acc+  foldl' :: (b -> a -> b) -> b -> BinTree1 a -> b+  foldl' step !acc =+    \ case+      Branch a b ->+        foldlOnBranch' step acc a b+      Leaf a ->+        step acc a+    where+      foldlOnBranch' :: (b -> a -> b) -> b -> BinTree1 a -> BinTree1 a -> b+      foldlOnBranch' step acc a b =+        case a of+          Leaf c ->+            foldl' step (step acc c) b+          Branch c d ->+            foldlOnBranch' step acc c (Branch d b) -foldrOnBranch' :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b-foldrOnBranch' step acc a b =-  case b of-    Leaf c -> foldr' step (step c acc) a-    Branch c d -> foldrOnBranch' step acc (Branch a c) d+  foldMap :: Monoid m => (a -> m) -> BinTree1 a -> m+  foldMap =+    foldMapTo mempty+    where+      foldMapTo :: Monoid m => m -> (a -> m) -> BinTree1 a -> m+      foldMapTo acc map =+        \ case+          Branch a b -> foldMapToOnBranch acc map a b+          Leaf a -> acc <> map a+      foldMapToOnBranch :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m+      foldMapToOnBranch acc map a b =+        case a of+          Leaf c -> foldMapTo (acc <> map c) map b+          Branch c d -> foldMapToOnBranch acc map c (Branch d b) -foldl :: (b -> a -> b) -> b -> BinTree1 a -> b-foldl step acc =-  \ case-    Branch a b ->-      foldlOnBranch step acc a b-    Leaf a ->-      step acc a+#if MIN_VERSION_base(4,13,0)+  foldMap' :: Monoid m => (a -> m) -> BinTree1 a -> m+  foldMap' =+    foldMapTo' mempty+    where+      foldMapTo' :: Monoid m => m -> (a -> m) -> BinTree1 a -> m+      foldMapTo' !acc map =+        \ case+          Branch a b -> foldMapToOnBranch' acc map a b+          Leaf a -> acc <> map a+      foldMapToOnBranch' :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m+      foldMapToOnBranch' acc map a b =+        case a of+          Leaf c -> foldMapTo' (acc <> map c) map b+          Branch c d -> foldMapToOnBranch' acc map c (Branch d b)+#endif -foldlOnBranch :: (b -> a -> b) -> b -> BinTree1 a -> BinTree1 a -> b-foldlOnBranch step acc a b =-  case b of-    Leaf c ->-      step (foldl step acc a) c-    Branch c d ->-      foldlOnBranch step acc (Branch a c) d+instance Traversable BinTree1 where -foldl' :: (b -> a -> b) -> b -> BinTree1 a -> b-foldl' step !acc =-  \ case-    Branch a b ->-      foldlOnBranch' step acc a b-    Leaf a ->-      step acc a+  traverse :: Applicative f => (a -> f b) -> BinTree1 a -> f (BinTree1 b)+  traverse map =+    \ case+      Branch a b ->+        traverseOnBranch map a b+      Leaf a ->+        Leaf <$> map a+    where+      traverseOnBranch :: Applicative f => (a -> f b) -> BinTree1 a -> BinTree1 a -> f (BinTree1 b)+      traverseOnBranch map a b =+        case a of+          Leaf c ->+            Branch <$> Leaf <$> map c <*> traverse map b+          Branch c d ->+            traverseOnBranch map a (Branch d b) -foldlOnBranch' :: (b -> a -> b) -> b -> BinTree1 a -> BinTree1 a -> b-foldlOnBranch' step acc a b =-  case a of-    Leaf c ->-      foldl' step (step acc c) b-    Branch c d ->-      foldlOnBranch' step acc c (Branch d b)+instance Foldable1 BinTree1 where -foldMap :: Monoid m => (a -> m) -> BinTree1 a -> m-foldMap =-  foldMapTo mempty+  fold1 :: Semigroup m => BinTree1 m -> m+  fold1 =+    \ case+      Branch l r ->+        rebalancingLeft l r (foldl' (<>))+      Leaf a ->+        a -foldMapTo :: Monoid m => m -> (a -> m) -> BinTree1 a -> m-foldMapTo acc map =-  \ case-    Branch a b -> foldMapToOnBranch acc map a b-    Leaf a -> acc <> map a+  foldMap1 :: Semigroup m => (a -> m) -> BinTree1 a -> m+  foldMap1 f =+    \ case+      Branch l r ->+        rebalancingLeft l r (foldl' (\ m a -> m <> f a) . f)+      Leaf a ->+        f a -foldMapToOnBranch :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m-foldMapToOnBranch acc map a b =-  case a of-    Leaf c -> foldMapTo (acc <> map c) map b-    Branch c d -> foldMapToOnBranch acc map c (Branch d b)+  toNonEmpty :: BinTree1 a -> NonEmpty a+  toNonEmpty =+    findFirst+    where+      findFirst =+        \ case+          Branch l r ->+            findFirstOnBranch l r+          Leaf a ->+            a :| []+      findFirstOnBranch l r =+        case l of+          Branch ll lr ->+            findFirstOnBranch ll (Branch lr r)+          Leaf a ->+            a :| foldr (:) [] r -foldMap' :: Monoid m => (a -> m) -> BinTree1 a -> m-foldMap' =-  foldMapTo' mempty+instance Traversable1 BinTree1 where -foldMapTo' :: Monoid m => m -> (a -> m) -> BinTree1 a -> m-foldMapTo' !acc map =-  \ case-    Branch a b -> foldMapToOnBranch' acc map a b-    Leaf a -> acc <> map a+  traverse1 map =+    \ case+      Branch a b ->+        traverseOnBranch map a b+      Leaf a ->+        Leaf <$> map a+    where+      traverseOnBranch map a b =+        case a of+          Leaf c ->+            Branch <$> Leaf <$> map c <.> traverse1 map b+          Branch c d ->+            traverseOnBranch map a (Branch d b) -foldMapToOnBranch' :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m-foldMapToOnBranch' acc map a b =-  case a of-    Leaf c -> foldMapTo' (acc <> map c) map b-    Branch c d -> foldMapToOnBranch' acc map c (Branch d b)+instance Alt BinTree1 where+  (<!>) =+    Branch -traverse :: Applicative f => (a -> f b) -> BinTree1 a -> f (BinTree1 b)-traverse map =-  \ case-    Branch a b ->-      traverseOnBranch map a b+rebalancingLeft :: BinTree1 a -> BinTree1 a -> (a -> BinTree1 a -> b) -> b+rebalancingLeft l r cont =+  case l of+    Branch ll lr ->+      rebalancingLeft ll (Branch lr r) cont     Leaf a ->-      Leaf <$> map a--traverseOnBranch :: Applicative f => (a -> f b) -> BinTree1 a -> BinTree1 a -> f (BinTree1 b)-traverseOnBranch map a b =-  case a of-    Leaf c ->-      Branch <$> Leaf <$> map c <*> traverse map b-    Branch c d ->-      traverseOnBranch map a (Branch d b)+      cont a r -ap :: BinTree1 (a -> b) -> BinTree1 a -> BinTree1 b-ap =+foldM :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> m a+foldM step !acc =   \ case-    Branch a b ->-      \ c ->-        Branch (ap a c) (ap b c)-    Leaf a ->-      fmap a +    Branch a b -> foldMOnBranch step acc a b+    Leaf a -> step acc a+  where+    foldMOnBranch :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> BinTree1 b -> m a+    foldMOnBranch step acc a b =+      case a of+        Leaf c -> step acc c >>= \ acc' -> foldM step acc' b+        Branch c d -> foldMOnBranch step acc c (Branch d b)  fromList1 :: a -> [a] -> BinTree1 a fromList1 a =@@ -206,20 +267,3 @@       unsnocTo (Branch l buff) r     Leaf a ->       (a, buff)--toNonEmpty :: BinTree1 a -> NonEmpty a-toNonEmpty =-  findFirst-  where-    findFirst =-      \ case-        Branch l r ->-          findFirstOnBranch l r-        Leaf a ->-          a :| []-    findFirstOnBranch l r =-      case l of-        Branch ll lr ->-          findFirstOnBranch ll (Branch lr r)-        Leaf a ->-          a :| foldr (:) [] r

@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}+module Acc.NeAcc+(+  NeAcc,+)+where++import Acc.Prelude+import qualified Acc.BinTree1 as BinTree1+++{-|+Non-empty accumulator.++Relates to 'Acc.Acc' the same way as 'NonEmpty' to list.+-}+newtype NeAcc a =+  NeAcc (BinTree1.BinTree1 a)+  deriving (Generic, Generic1)++instance Show a => Show (NeAcc a) where+  show =+    show . toList++instance NFData a => NFData (NeAcc a)++instance NFData1 NeAcc++instance IsList (NeAcc a) where+  type Item (NeAcc a) = a+  fromList =+    \ case+      a : b -> NeAcc (BinTree1.fromList1 a b)+      _ -> error "Acc.NeAcc.fromList empty input list"+  toList =+    foldr (:) []++instance Semigroup (NeAcc a) where+  (<>) =+    (<!>)++deriving instance Functor NeAcc++deriving instance Applicative NeAcc++instance Alt NeAcc where+  (<!>) (NeAcc l) (NeAcc r) =+    NeAcc (l <!> r)++instance Foldable NeAcc where++  foldMap f (NeAcc tree) =+    foldMap f tree++#if MIN_VERSION_base(4,13,0)+  foldMap' f (NeAcc tree) =+    foldMap' f tree+#endif++  foldr step acc (NeAcc tree) =+    foldr step acc tree++  foldr' step acc (NeAcc tree) =+    foldr' step acc tree++  foldl step acc (NeAcc tree) =+    foldl step acc tree++  foldl' step acc (NeAcc tree) =+    foldl' step acc tree++deriving instance Traversable NeAcc++deriving instance Foldable1 NeAcc++instance Traversable1 NeAcc where+  traverse1 f (NeAcc tree) =+    NeAcc <$> traverse1 f tree

@@ -77,3 +77,10 @@ -- deepseq ------------------------- import Control.DeepSeq as Exports++-- semigroupoids+-------------------------+import Data.Functor.Alt as Exports hiding (some, many, optional)+import Data.Functor.Apply as Exports+import Data.Semigroup.Foldable as Exports+import Data.Semigroup.Traversable as Exports