acc 0.1.2 → 0.1.3

raw patch · 5 files changed

+349/−361 lines, 5 filesdep ~deepseqdep ~semigroupoidsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq, semigroupoids

API changes (from Hackage documentation)

Files

• acc.cabal +4/−4
• library/Acc.hs +38/−17
• library/Acc/BinTree1.hs +0/−269
• library/Acc/NeAcc.hs +1/−71
• library/Acc/NeAcc/Def.hs +306/−0

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

@@ -7,11 +7,14 @@   uncons,   unsnoc,   toNonEmpty,+  toNeAcc,+  enumFromTo, ) where -import Acc.Prelude hiding (toNonEmpty)-import qualified Acc.BinTree1 as BinTree1+import Acc.Prelude hiding (toNonEmpty, enumFromTo)+import qualified Acc.NeAcc as NeAcc+import qualified Acc.NeAcc.Def as NeAcc import qualified Data.Foldable as Foldable import qualified Data.Semigroup.Foldable as Foldable1 @@ -39,7 +42,7 @@ -} data Acc a =   EmptyAcc |-  TreeAcc !(BinTree1.BinTree1 a)+  TreeAcc !(NeAcc.NeAcc a)   deriving (Generic, Generic1)  instance NFData a => NFData (Acc a)@@ -100,7 +103,7 @@  instance Applicative Acc where   pure =-    TreeAcc . BinTree1.Leaf+    TreeAcc . NeAcc.Leaf   (<*>) =     \ case       TreeAcc a ->@@ -120,7 +123,7 @@       TreeAcc a ->         \ case           TreeAcc b ->-            TreeAcc (BinTree1.Branch a b)+            TreeAcc (NeAcc.Branch a b)           EmptyAcc ->             TreeAcc a       EmptyAcc ->@@ -140,7 +143,7 @@   type Item (Acc a) = a   fromList =     \ case-      a : b -> TreeAcc (BinTree1.fromList1 a b)+      a : b -> TreeAcc (NeAcc.fromList1 a b)       _ -> EmptyAcc   toList =     \ case@@ -160,9 +163,9 @@ cons a =   \ case     TreeAcc tree ->-      TreeAcc (BinTree1.Branch (BinTree1.Leaf a) tree)+      TreeAcc (NeAcc.Branch (NeAcc.Leaf a) tree)     EmptyAcc ->-      TreeAcc (BinTree1.Leaf a)+      TreeAcc (NeAcc.Leaf a)  {-| Extract the first element.@@ -177,11 +180,11 @@   \ case     TreeAcc tree ->       case tree of-        BinTree1.Branch l r ->-          case BinTree1.unconsTo r l of+        NeAcc.Branch l r ->+          case NeAcc.unconsTo r l of             (res, newTree) ->               Just (res, TreeAcc newTree)-        BinTree1.Leaf res ->+        NeAcc.Leaf res ->           Just (res, EmptyAcc)     EmptyAcc ->       Nothing@@ -193,9 +196,9 @@ snoc a =   \ case     TreeAcc tree ->-      TreeAcc (BinTree1.Branch tree (BinTree1.Leaf a))+      TreeAcc (NeAcc.Branch tree (NeAcc.Leaf a))     EmptyAcc ->-      TreeAcc (BinTree1.Leaf a)+      TreeAcc (NeAcc.Leaf a)  {-| Extract the last element.@@ -210,11 +213,11 @@   \ case     TreeAcc tree ->       case tree of-        BinTree1.Branch l r ->-          case BinTree1.unsnocTo l r of+        NeAcc.Branch l r ->+          case NeAcc.unsnocTo l r of             (res, newTree) ->               Just (res, TreeAcc newTree)-        BinTree1.Leaf res ->+        NeAcc.Leaf res ->           Just (res, EmptyAcc)     EmptyAcc ->       Nothing@@ -224,8 +227,26 @@ -} toNonEmpty :: Acc a -> Maybe (NonEmpty a) toNonEmpty =+  fmap Foldable1.toNonEmpty . toNeAcc++{-|+Convert to non empty acc if it's not empty.+-}+toNeAcc :: Acc a -> Maybe (NeAcc.NeAcc a)+toNeAcc =   \ case     TreeAcc tree ->-      Just (Foldable1.toNonEmpty tree)+      Just tree     EmptyAcc ->       Nothing++{-|+Enumerate in range, inclusively.+-}+enumFromTo :: (Enum a, Ord a) => a -> a -> Acc a+enumFromTo from to =+  if from <= to+    then+      TreeAcc (NeAcc.appendEnumFromTo (succ from) to (NeAcc.Leaf from))+    else+      EmptyAcc

@@ -1,269 +0,0 @@-{-# LANGUAGE CPP #-}-module Acc.BinTree1-(-  BinTree1(..),-  foldM,-  fromList1,-  uncons,-  unconsTo,-  unsnoc,-  unsnocTo,-)-where--import Acc.Prelude hiding (foldM)-import qualified Acc.Prelude as Prelude---data BinTree1 a =-  Leaf !a |-  Branch !(BinTree1 a) !(BinTree1 a)-  deriving (Generic, Generic1, Show)--instance NFData a => NFData (BinTree1 a)--instance NFData1 BinTree1--deriving instance Functor BinTree1--instance Applicative BinTree1 where-  pure =-    Leaf-  (<*>) =-    \ case-      Branch a b ->-        \ c ->-          Branch (a <*> c) (b <*> c)-      Leaf a ->-        fmap a --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-    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--  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--  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)--  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)--#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--instance Traversable BinTree1 where--  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)--instance Foldable1 BinTree1 where--  fold1 :: Semigroup m => BinTree1 m -> m-  fold1 =-    \ case-      Branch l r ->-        rebalancingLeft l r (foldl' (<>))-      Leaf a ->-        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--  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--instance Traversable1 BinTree1 where--  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)--instance Alt BinTree1 where-  (<!>) =-    Branch--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 ->-      cont a r--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-  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 =-  \ case-    b : c -> fromList1To (Leaf a) b c-    _ -> Leaf a--fromList1To :: BinTree1 a -> a -> [a] -> BinTree1 a-fromList1To leftTree a =-  \ case-    b : c -> fromList1To (Branch leftTree (Leaf a)) b c-    _ -> Branch leftTree (Leaf a)--uncons :: BinTree1 a -> (a, Maybe (BinTree1 a))-uncons =-  \ case-    Branch l r ->-      fmap Just (unconsTo r l)-    Leaf a ->-      (a, Nothing)--unconsTo :: BinTree1 a -> BinTree1 a -> (a, BinTree1 a)-unconsTo buff =-  \ case-    Branch l r ->-      unconsTo (Branch r buff) l-    Leaf a ->-      (a, buff)--unsnoc :: BinTree1 a -> (a, Maybe (BinTree1 a))-unsnoc =-  \ case-    Branch l r ->-      fmap Just (unsnocTo l r)-    Leaf a ->-      (a, Nothing)--unsnocTo :: BinTree1 a -> BinTree1 a -> (a, BinTree1 a)-unsnocTo buff =-  \ case-    Branch l r ->-      unsnocTo (Branch l buff) r-    Leaf a ->-      (a, buff)

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} module Acc.NeAcc (   NeAcc,@@ -6,73 +5,4 @@ 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+import Acc.NeAcc.Def

@@ -0,0 +1,306 @@+{-# LANGUAGE CPP #-}+module Acc.NeAcc.Def+(+  NeAcc(..),+  foldM,+  fromList1,+  uncons,+  unconsTo,+  unsnoc,+  unsnocTo,+  appendEnumFromTo,+)+where++import Acc.Prelude hiding (foldM)+import qualified Acc.Prelude as Prelude+++{-|+Non-empty accumulator.++Relates to 'Acc.Acc' the same way as 'NonEmpty' to list.+-}+data NeAcc a =+  Leaf !a |+  Branch !(NeAcc a) !(NeAcc 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 -> fromList1 a b+      _ -> error "Empty input list"+  toList =+    foldr (:) []++deriving instance Functor NeAcc++instance Applicative NeAcc where+  pure =+    Leaf+  (<*>) =+    \ case+      Branch a b ->+        \ c ->+          Branch (a <*> c) (b <*> c)+      Leaf a ->+        fmap a ++instance Foldable NeAcc where+  +  foldr :: (a -> b -> b) -> b -> NeAcc a -> b+  foldr step acc =+    peel []+    where+      peel layers =+        \ case+          Leaf a ->+            step a (unpeel layers)+          Branch l r ->+            peel (r : layers) l+      unpeel =+        \ case+          h : t ->+            peel t h+          _ ->+            acc++  foldr' :: (a -> b -> b) -> b -> NeAcc a -> b+  foldr' step =+    peel []+    where+      peel layers acc =+        \ case+          Leaf a ->+            unpeel (step a acc) layers+          Branch l r ->+            peel (l : layers) acc r+      unpeel !acc =+        \ case+          h : t ->+            peel t acc h+          _ ->+            acc++  foldl :: (b -> a -> b) -> b -> NeAcc 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 -> NeAcc a -> NeAcc 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++  foldl' :: (b -> a -> b) -> b -> NeAcc 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 -> NeAcc a -> NeAcc 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)++  foldMap :: Monoid m => (a -> m) -> NeAcc a -> m+  foldMap =+    foldMapTo mempty+    where+      foldMapTo :: Monoid m => m -> (a -> m) -> NeAcc 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) -> NeAcc a -> NeAcc 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)++#if MIN_VERSION_base(4,13,0)+  foldMap' :: Monoid m => (a -> m) -> NeAcc a -> m+  foldMap' =+    foldMapTo' mempty+    where+      foldMapTo' :: Monoid m => m -> (a -> m) -> NeAcc 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) -> NeAcc a -> NeAcc 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++instance Traversable NeAcc where++  traverse :: Applicative f => (a -> f b) -> NeAcc a -> f (NeAcc b)+  traverse map =+    \ case+      Branch a b ->+        traverseOnBranch map a b+      Leaf a ->+        Leaf <$> map a+    where+      traverseOnBranch :: Applicative f => (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc 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)++instance Foldable1 NeAcc where++  fold1 :: Semigroup m => NeAcc m -> m+  fold1 =+    \ case+      Branch l r ->+        rebalancingLeft l r (foldl' (<>))+      Leaf a ->+        a++  foldMap1 :: Semigroup m => (a -> m) -> NeAcc a -> m+  foldMap1 f =+    \ case+      Branch l r ->+        rebalancingLeft l r (foldl' (\ m a -> m <> f a) . f)+      Leaf a ->+        f a++  toNonEmpty :: NeAcc 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++instance Traversable1 NeAcc where++  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)++instance Alt NeAcc where+  (<!>) =+    Branch++instance Semigroup (NeAcc a) where+  (<>) =+    Branch++rebalancingLeft :: NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b+rebalancingLeft l r cont =+  case l of+    Branch ll lr ->+      rebalancingLeft ll (Branch lr r) cont+    Leaf a ->+      cont a r++foldM :: Monad m => (a -> b -> m a) -> a -> NeAcc b -> m a+foldM step !acc =+  \ case+    Branch a b -> foldMOnBranch step acc a b+    Leaf a -> step acc a+  where+    foldMOnBranch :: Monad m => (a -> b -> m a) -> a -> NeAcc b -> NeAcc 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] -> NeAcc a+fromList1 a =+  \ case+    b : c -> fromList1To (Leaf a) b c+    _ -> Leaf a++fromList1To :: NeAcc a -> a -> [a] -> NeAcc a+fromList1To leftTree a =+  \ case+    b : c -> fromList1To (Branch leftTree (Leaf a)) b c+    _ -> Branch leftTree (Leaf a)++uncons :: NeAcc a -> (a, Maybe (NeAcc a))+uncons =+  \ case+    Branch l r ->+      fmap Just (unconsTo r l)+    Leaf a ->+      (a, Nothing)++unconsTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)+unconsTo buff =+  \ case+    Branch l r ->+      unconsTo (Branch r buff) l+    Leaf a ->+      (a, buff)++unsnoc :: NeAcc a -> (a, Maybe (NeAcc a))+unsnoc =+  \ case+    Branch l r ->+      fmap Just (unsnocTo l r)+    Leaf a ->+      (a, Nothing)++unsnocTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)+unsnocTo buff =+  \ case+    Branch l r ->+      unsnocTo (Branch l buff) r+    Leaf a ->+      (a, buff)++appendEnumFromTo :: (Enum a, Ord a) => a -> a -> NeAcc a -> NeAcc a+appendEnumFromTo from to =+  if from <= to+    then+      appendEnumFromTo (succ from) to . flip Branch (Leaf from)+    else+      id