packages feed

deferred-folds 0.9.18 → 0.9.18.1

raw patch · 13 files changed

+589/−639 lines, 13 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

deferred-folds.cabal view
@@ -1,5 +1,7 @@+cabal-version: 3.0+ name: deferred-folds-version: 0.9.18+version: 0.9.18.1 category: Folding synopsis: Abstractions over deferred folds description:@@ -14,7 +16,6 @@ license: MIT license-file: LICENSE build-type: Simple-cabal-version: >=1.10  source-repository head   type: git@@ -44,10 +45,10 @@     foldl >=1 && <2,     hashable >=1 && <2,     primitive >=0.6.4 && <0.8,-    text >=1.2 && <1.3,+    text >=1.2 && <1.3 || >=2.0 && <2.1,     transformers >=0.5 && <0.7,     unordered-containers >=0.2 && <0.3,-    vector >=0.12 && <0.13+    vector >=0.12 && <0.13,  test-suite test   type: exitcode-stdio-1.0@@ -63,4 +64,4 @@     rerebase <2,     tasty >=0.12 && <2,     tasty-hunit >=0.9 && <0.11,-    tasty-quickcheck >=0.9 && <0.11+    tasty-quickcheck >=0.9 && <0.11,
library/DeferredFolds/Defs/Unfoldl.hs view
@@ -1,21 +1,19 @@-module DeferredFolds.Defs.Unfoldl-where+module DeferredFolds.Defs.Unfoldl where +import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Short.Internal as ShortByteString+import qualified Data.IntMap.Strict as D+import qualified Data.Map.Strict as C import DeferredFolds.Prelude hiding (fold)-import DeferredFolds.Types import qualified DeferredFolds.Prelude as A+import DeferredFolds.Types import qualified DeferredFolds.UnfoldlM as B-import qualified Data.Map.Strict as C-import qualified Data.IntMap.Strict as D-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Short.Internal as ShortByteString - deriving instance Functor Unfoldl  instance Applicative Unfoldl where   pure x =-    Unfoldl (\ step init -> step init x)+    Unfoldl (\step init -> step init x)   (<*>) = ap  instance Alternative Unfoldl where@@ -23,18 +21,17 @@     Unfoldl (const id)   {-# INLINE (<|>) #-}   (<|>) (Unfoldl left) (Unfoldl right) =-    Unfoldl (\ step init -> right step (left step init))+    Unfoldl (\step init -> right step (left step init))  instance Monad Unfoldl where   return = pure   (>>=) (Unfoldl left) rightK =-    Unfoldl $ \ step init ->-    let-      newStep output x =-        case rightK x of-          Unfoldl right ->-            right step output-      in left newStep init+    Unfoldl $ \step init ->+      let newStep output x =+            case rightK x of+              Unfoldl right ->+                right step output+       in left newStep init  instance MonadPlus Unfoldl where   mzero = empty@@ -49,8 +46,9 @@  instance Foldable Unfoldl where   {-# INLINE foldMap #-}-  foldMap inputMonoid = foldl' step mempty where-    step monoid input = mappend monoid (inputMonoid input)+  foldMap inputMonoid = foldl' step mempty+    where+      step monoid input = mappend monoid (inputMonoid input)   foldl = foldl'   {-# INLINE foldl' #-}   foldl' step init (Unfoldl run) = run step init@@ -66,77 +64,76 @@   fromList list = foldable list   toList = foldr (:) [] --{-| Apply a Gonzalez fold -}+-- | Apply a Gonzalez fold {-# INLINE fold #-} fold :: Fold input output -> Unfoldl input -> output fold (Fold step init extract) (Unfoldl run) = extract (run step init) -{-| Unlift a monadic unfold -}+-- | Unlift a monadic unfold {-# INLINE unfoldlM #-} unfoldlM :: UnfoldlM Identity input -> Unfoldl input-unfoldlM (UnfoldlM runFoldM) = Unfoldl (\ step init -> runIdentity (runFoldM (\ a b -> return (step a b)) init))+unfoldlM (UnfoldlM runFoldM) = Unfoldl (\step init -> runIdentity (runFoldM (\a b -> return (step a b)) init)) -{-| Lift a fold input mapping function into a mapping of unfolds -}+-- | Lift a fold input mapping function into a mapping of unfolds {-# INLINE mapFoldInput #-} mapFoldInput :: (forall x. Fold b x -> Fold a x) -> Unfoldl a -> Unfoldl b-mapFoldInput newFold unfold = Unfoldl $ \ step init -> fold (newFold (Fold step init id)) unfold+mapFoldInput newFold unfold = Unfoldl $ \step init -> fold (newFold (Fold step init id)) unfold -{-| Construct from any foldable -}+-- | Construct from any foldable {-# INLINE foldable #-} foldable :: Foldable foldable => foldable a -> Unfoldl a-foldable foldable = Unfoldl (\ step init -> A.foldl' step init foldable)+foldable foldable = Unfoldl (\step init -> A.foldl' step init foldable) -{-| Filter the values given a predicate -}+-- | Filter the values given a predicate {-# INLINE filter #-} filter :: (a -> Bool) -> Unfoldl a -> Unfoldl a-filter test (Unfoldl run) = Unfoldl (\ step -> run (\ state element -> if test element then step state element else state))+filter test (Unfoldl run) = Unfoldl (\step -> run (\state element -> if test element then step state element else state)) -{-| Ints in the specified inclusive range -}+-- | Ints in the specified inclusive range {-# INLINE intsInRange #-} intsInRange :: Int -> Int -> Unfoldl Int intsInRange from to =-  Unfoldl $ \ step init ->-  let-    loop !state int =-      if int <= to-        then loop (step state int) (succ int)-        else state-    in loop init from+  Unfoldl $ \step init ->+    let loop !state int =+          if int <= to+            then loop (step state int) (succ int)+            else state+     in loop init from -{-| Associations of a map -}+-- | Associations of a map {-# INLINE mapAssocs #-} mapAssocs :: Map key value -> Unfoldl (key, value) mapAssocs map =-  Unfoldl (\ step init -> C.foldlWithKey' (\ state key value -> step state (key, value)) init map)+  Unfoldl (\step init -> C.foldlWithKey' (\state key value -> step state (key, value)) init map) -{-| Associations of an intmap -}+-- | Associations of an intmap {-# INLINE intMapAssocs #-} intMapAssocs :: IntMap value -> Unfoldl (Int, value) intMapAssocs intMap =-  Unfoldl (\ step init -> D.foldlWithKey' (\ state key value -> step state (key, value)) init intMap)+  Unfoldl (\step init -> D.foldlWithKey' (\state key value -> step state (key, value)) init intMap) -{-| Bytes of a bytestring -}+-- | Bytes of a bytestring {-# INLINE byteStringBytes #-} byteStringBytes :: ByteString -> Unfoldl Word8-byteStringBytes bs = Unfoldl (\ step init -> ByteString.foldl' step init bs)+byteStringBytes bs = Unfoldl (\step init -> ByteString.foldl' step init bs) -{-| Bytes of a short bytestring -}+-- | Bytes of a short bytestring {-# INLINE shortByteStringBytes #-} shortByteStringBytes :: ShortByteString -> Unfoldl Word8 shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#) -{-| Elements of a prim array -}+-- | Elements of a prim array {-# INLINE primArray #-} primArray :: (Prim prim) => PrimArray prim -> Unfoldl prim-primArray ba = Unfoldl $ \ f z -> foldlPrimArray' f z ba+primArray ba = Unfoldl $ \f z -> foldlPrimArray' f z ba -{-| Elements of a prim array coming paired with indices -}+-- | Elements of a prim array coming paired with indices {-# INLINE primArrayWithIndices #-} primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfoldl (Int, prim)-primArrayWithIndices pa = Unfoldl $ \ step state -> let-  !size = sizeofPrimArray pa-  iterate index !state = if index < size-    then iterate (succ index) (step state (index, indexPrimArray pa index))-    else state-  in iterate 0 state+primArrayWithIndices pa = Unfoldl $ \step state ->+  let !size = sizeofPrimArray pa+      iterate index !state =+        if index < size+          then iterate (succ index) (step state (index, indexPrimArray pa index))+          else state+   in iterate 0 state
library/DeferredFolds/Defs/UnfoldlM.hs view
@@ -1,18 +1,16 @@-module DeferredFolds.Defs.UnfoldlM-where+module DeferredFolds.Defs.UnfoldlM where -import DeferredFolds.Prelude hiding (mapM_, foldM)-import DeferredFolds.Types-import qualified DeferredFolds.Prelude as A import qualified Data.ByteString.Internal as ByteString import qualified Data.ByteString.Short.Internal as ShortByteString-+import DeferredFolds.Prelude hiding (foldM, mapM_)+import qualified DeferredFolds.Prelude as A+import DeferredFolds.Types  deriving instance Functor m => Functor (UnfoldlM m)  instance Monad m => Applicative (UnfoldlM m) where   pure x =-    UnfoldlM (\ step init -> step init x)+    UnfoldlM (\step init -> step init x)   (<*>) = ap  instance Monad m => Alternative (UnfoldlM m) where@@ -20,26 +18,25 @@     UnfoldlM (const return)   {-# INLINE (<|>) #-}   (<|>) (UnfoldlM left) (UnfoldlM right) =-    UnfoldlM (\ step init -> left step init >>= right step)+    UnfoldlM (\step init -> left step init >>= right step)  instance Monad m => Monad (UnfoldlM m) where   return = pure   {-# INLINE (>>=) #-}   (>>=) (UnfoldlM left) rightK =-    UnfoldlM $ \ step init ->-    let-      newStep output x =-        case rightK x of-          UnfoldlM right ->-            right step output-      in left newStep init+    UnfoldlM $ \step init ->+      let newStep output x =+            case rightK x of+              UnfoldlM right ->+                right step output+       in left newStep init  instance Monad m => MonadPlus (UnfoldlM m) where   mzero = empty   mplus = (<|>)  instance MonadTrans UnfoldlM where-  lift m = UnfoldlM (\ step init -> m >>= step init)+  lift m = UnfoldlM (\step init -> m >>= step init)  instance Monad m => Semigroup (UnfoldlM m a) where   (<>) = (<|>)@@ -50,8 +47,9 @@  instance Foldable (UnfoldlM Identity) where   {-# INLINE foldMap #-}-  foldMap inputMonoid = foldl' step mempty where-    step monoid input = mappend monoid (inputMonoid input)+  foldMap inputMonoid = foldl' step mempty+    where+      step monoid input = mappend monoid (inputMonoid input)   foldl = foldl'   {-# INLINE foldl' #-}   foldl' step init (UnfoldlM run) =@@ -70,33 +68,33 @@   fromList list = foldable list   toList = foldr (:) [] -{-| Check whether it's empty -}+-- | Check whether it's empty {-# INLINE null #-} null :: Monad m => UnfoldlM m input -> m Bool-null (UnfoldlM run) = run (\ _ _ -> return False) True+null (UnfoldlM run) = run (\_ _ -> return False) True -{-| Perform a monadic strict left fold -}+-- | Perform a monadic strict left fold {-# INLINE foldlM' #-} foldlM' :: Monad m => (output -> input -> m output) -> output -> UnfoldlM m input -> m output foldlM' step init (UnfoldlM run) =   run step init -{-| A more efficient implementation of mapM_ -}+-- | A more efficient implementation of mapM_ {-# INLINE mapM_ #-} mapM_ :: Monad m => (input -> m ()) -> UnfoldlM m input -> m () mapM_ step = foldlM' (const step) () -{-| Same as 'mapM_' with arguments flipped -}+-- | Same as 'mapM_' with arguments flipped {-# INLINE forM_ #-} forM_ :: Monad m => UnfoldlM m input -> (input -> m ()) -> m () forM_ = flip mapM_ -{-| Apply a Gonzalez fold -}+-- | Apply a Gonzalez fold {-# INLINE fold #-} fold :: Fold input output -> UnfoldlM Identity input -> output fold (Fold step init extract) = extract . foldl' step init -{-| Apply a monadic Gonzalez fold -}+-- | Apply a monadic Gonzalez fold {-# INLINE foldM #-} foldM :: Monad m => FoldM m input output -> UnfoldlM m input -> m output foldM (FoldM step init extract) view =@@ -105,95 +103,95 @@     finalState <- foldlM' step initialState view     extract finalState -{-| Lift a fold input mapping function into a mapping of unfolds -}+-- | Lift a fold input mapping function into a mapping of unfolds {-# INLINE mapFoldMInput #-} mapFoldMInput :: Monad m => (forall x. FoldM m b x -> FoldM m a x) -> UnfoldlM m a -> UnfoldlM m b-mapFoldMInput newFoldM unfoldM = UnfoldlM $ \ step init -> foldM (newFoldM (FoldM step (return init) return)) unfoldM+mapFoldMInput newFoldM unfoldM = UnfoldlM $ \step init -> foldM (newFoldM (FoldM step (return init) return)) unfoldM -{-| Construct from any foldable -}+-- | Construct from any foldable {-# INLINE foldable #-} foldable :: (Monad m, Foldable foldable) => foldable a -> UnfoldlM m a-foldable foldable = UnfoldlM (\ step init -> A.foldlM step init foldable)+foldable foldable = UnfoldlM (\step init -> A.foldlM step init foldable) -{-| Construct from a specification of how to execute a left-fold -}+-- | Construct from a specification of how to execute a left-fold {-# INLINE foldlRunner #-} foldlRunner :: Monad m => (forall x. (x -> a -> x) -> x -> x) -> UnfoldlM m a-foldlRunner run = UnfoldlM (\ stepM state -> run (\ stateM a -> stateM >>= \state -> stepM state a) (return state))+foldlRunner run = UnfoldlM (\stepM state -> run (\stateM a -> stateM >>= \state -> stepM state a) (return state)) -{-| Construct from a specification of how to execute a right-fold -}+-- | Construct from a specification of how to execute a right-fold {-# INLINE foldrRunner #-} foldrRunner :: Monad m => (forall x. (a -> x -> x) -> x -> x) -> UnfoldlM m a-foldrRunner run = UnfoldlM (\ stepM -> run (\ x k z -> stepM z x >>= k) return)+foldrRunner run = UnfoldlM (\stepM -> run (\x k z -> stepM z x >>= k) return)  unfoldr :: Monad m => Unfoldr a -> UnfoldlM m a unfoldr (Unfoldr unfoldr) = foldrRunner unfoldr -{-| Filter the values given a predicate -}+-- | Filter the values given a predicate {-# INLINE filter #-} filter :: Monad m => (a -> m Bool) -> UnfoldlM m a -> UnfoldlM m a-filter test (UnfoldlM run) = UnfoldlM (\ step -> run (\ state element -> test element >>= bool (return state) (step state element)))+filter test (UnfoldlM run) = UnfoldlM (\step -> run (\state element -> test element >>= bool (return state) (step state element))) -{-| Ints in the specified inclusive range -}+-- | Ints in the specified inclusive range {-# INLINE intsInRange #-} intsInRange :: Monad m => Int -> Int -> UnfoldlM m Int intsInRange from to =-  UnfoldlM $ \ step init ->-  let-    loop !state int =-      if int <= to-        then do-          newState <- step state int-          loop newState (succ int)-        else return state-    in loop init from+  UnfoldlM $ \step init ->+    let loop !state int =+          if int <= to+            then do+              newState <- step state int+              loop newState (succ int)+            else return state+     in loop init from -{-| TVar contents -}+-- | TVar contents {-# INLINE tVarValue #-} tVarValue :: TVar a -> UnfoldlM STM a-tVarValue var = UnfoldlM $ \ step state -> do+tVarValue var = UnfoldlM $ \step state -> do   a <- readTVar var   step state a -{-| Change the base monad using invariant natural transformations -}+-- | Change the base monad using invariant natural transformations {-# INLINE hoist #-} hoist :: (forall a. m a -> n a) -> (forall a. n a -> m a) -> UnfoldlM m a -> UnfoldlM n a-hoist trans1 trans2 (UnfoldlM unfold) = UnfoldlM $ \ step init -> -  trans1 (unfold (\ a b -> trans2 (step a b)) init)+hoist trans1 trans2 (UnfoldlM unfold) = UnfoldlM $ \step init ->+  trans1 (unfold (\a b -> trans2 (step a b)) init) -{-| Bytes of a bytestring -}-{-# INLINABLE byteStringBytes #-}+-- | Bytes of a bytestring+{-# INLINEABLE byteStringBytes #-} byteStringBytes :: ByteString -> UnfoldlM IO Word8 byteStringBytes (ByteString.PS fp off len) =-  UnfoldlM $ \ step init ->-  withForeignPtr fp $ \ ptr ->-  let-    endPtr = plusPtr ptr (off + len)-    iterate !state !ptr = if ptr == endPtr-      then return state-      else do-        x <- peek ptr-        newState <- step state x-        iterate newState (plusPtr ptr 1)-    in iterate init (plusPtr ptr off)+  UnfoldlM $ \step init ->+    withForeignPtr fp $ \ptr ->+      let endPtr = plusPtr ptr (off + len)+          iterate !state !ptr =+            if ptr == endPtr+              then return state+              else do+                x <- peek ptr+                newState <- step state x+                iterate newState (plusPtr ptr 1)+       in iterate init (plusPtr ptr off) -{-| Bytes of a short bytestring -}+-- | Bytes of a short bytestring {-# INLINE shortByteStringBytes #-} shortByteStringBytes :: Monad m => ShortByteString -> UnfoldlM m Word8 shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#) -{-| Elements of a prim array -}+-- | Elements of a prim array {-# INLINE primArray #-} primArray :: (Monad m, Prim prim) => PrimArray prim -> UnfoldlM m prim-primArray pa = UnfoldlM $ \ f z -> foldlPrimArrayM' f z pa+primArray pa = UnfoldlM $ \f z -> foldlPrimArrayM' f z pa -{-| Elements of a prim array coming paired with indices -}+-- | Elements of a prim array coming paired with indices {-# INLINE primArrayWithIndices #-} primArrayWithIndices :: (Monad m, Prim prim) => PrimArray prim -> UnfoldlM m (Int, prim)-primArrayWithIndices pa = UnfoldlM $ \ step state -> let-  !size = sizeofPrimArray pa-  iterate index !state = if index < size-    then do-      newState <- step state (index, indexPrimArray pa index)-      iterate (succ index) newState-    else return state-  in iterate 0 state+primArrayWithIndices pa = UnfoldlM $ \step state ->+  let !size = sizeofPrimArray pa+      iterate index !state =+        if index < size+          then do+            newState <- step state (index, indexPrimArray pa index)+            iterate (succ index) newState+          else return state+   in iterate 0 state
library/DeferredFolds/Defs/Unfoldr.hs view
@@ -1,36 +1,34 @@-module DeferredFolds.Defs.Unfoldr-where+module DeferredFolds.Defs.Unfoldr where -import DeferredFolds.Prelude hiding (fold, reverse)-import DeferredFolds.Types-import qualified DeferredFolds.Prelude as Prelude-import qualified Data.Map.Strict as Map-import qualified Data.IntMap.Strict as IntMap-import qualified Data.IntSet as IntSet-import qualified Data.HashMap.Strict as HashMap import qualified Data.ByteString as ByteString import qualified Data.ByteString.Short.Internal as ShortByteString-import qualified Data.Vector.Generic as GenericVector+import qualified Data.HashMap.Strict as HashMap+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map.Strict as Map import qualified Data.Text.Internal as TextInternal+import qualified Data.Vector.Generic as GenericVector+import DeferredFolds.Prelude hiding (fold, reverse)+import qualified DeferredFolds.Prelude as Prelude+import DeferredFolds.Types import qualified DeferredFolds.Util.TextArray as TextArrayUtil - deriving instance Functor Unfoldr  instance Applicative Unfoldr where-  pure x = Unfoldr (\ step -> step x)+  pure x = Unfoldr (\step -> step x)   (<*>) = ap  instance Alternative Unfoldr where   empty = Unfoldr (const id)   {-# INLINE (<|>) #-}-  (<|>) (Unfoldr left) (Unfoldr right) = Unfoldr (\ step init -> left step (right step init))+  (<|>) (Unfoldr left) (Unfoldr right) = Unfoldr (\step init -> left step (right step init))  instance Monad Unfoldr where   return = pure   {-# INLINE (>>=) #-}   (>>=) (Unfoldr left) rightK =-    Unfoldr $ \ step -> left $ \ input -> case rightK input of Unfoldr right -> right step+    Unfoldr $ \step -> left $ \input -> case rightK input of Unfoldr right -> right step  instance MonadPlus Unfoldr where   mzero = empty@@ -50,8 +48,9 @@   foldr step state (Unfoldr run) = run step state   foldl = foldl'   {-# INLINE foldl' #-}-  foldl' leftStep state (Unfoldr unfoldr) = unfoldr rightStep id state where-    rightStep element k state = k $! leftStep state element+  foldl' leftStep state (Unfoldr unfoldr) = unfoldr rightStep id state+    where+      rightStep element k state = k $! leftStep state element  instance Traversable Unfoldr where   traverse f (Unfoldr unfoldr) =@@ -68,376 +67,377 @@   fromList list = foldable list   toList = foldr (:) [] -{-| Apply a Gonzalez fold -}+-- | Apply a Gonzalez fold {-# INLINE fold #-} fold :: Fold input output -> Unfoldr input -> output fold (Fold step init extract) (Unfoldr run) =-  run (\ input next state -> next $! step state input) extract init+  run (\input next state -> next $! step state input) extract init -{-| Apply a monadic Gonzalez fold -}+-- | Apply a monadic Gonzalez fold {-# INLINE foldM #-} foldM :: Monad m => FoldM m input output -> Unfoldr input -> m output foldM (FoldM step init extract) (Unfoldr unfoldr) =-  init >>= unfoldr (\ input next state -> step state input >>= next) return >>= extract+  init >>= unfoldr (\input next state -> step state input >>= next) return >>= extract -{-| Construct from any value by supplying a definition of foldr -}+-- | Construct from any value by supplying a definition of foldr {-# INLINE foldrAndContainer #-} foldrAndContainer :: (forall x. (elem -> x -> x) -> x -> container -> x) -> container -> Unfoldr elem-foldrAndContainer foldr a = Unfoldr (\ step init -> foldr step init a)+foldrAndContainer foldr a = Unfoldr (\step init -> foldr step init a) -{-| Construct from any foldable -}+-- | Construct from any foldable {-# INLINE foldable #-} foldable :: Foldable foldable => foldable a -> Unfoldr a foldable = foldrAndContainer foldr -{-| Elements of IntSet. -}+-- | Elements of IntSet. {-# INLINE intSet #-} intSet :: IntSet -> Unfoldr Int intSet = foldrAndContainer IntSet.foldr -{-| Filter the values given a predicate -}+-- | Filter the values given a predicate {-# INLINE filter #-} filter :: (a -> Bool) -> Unfoldr a -> Unfoldr a-filter test (Unfoldr run) = Unfoldr (\ step -> run (\ element state -> if test element then step element state else state))+filter test (Unfoldr run) = Unfoldr (\step -> run (\element state -> if test element then step element state else state)) -{-| Ascending infinite stream of enums starting from the one specified -}+-- | Ascending infinite stream of enums starting from the one specified {-# INLINE enumsFrom #-} enumsFrom :: (Enum a) => a -> Unfoldr a-enumsFrom from = Unfoldr $ \ step init -> let-  loop int = step int (loop (succ int))-  in loop from+enumsFrom from = Unfoldr $ \step init ->+  let loop int = step int (loop (succ int))+   in loop from -{-| Enums in the specified inclusive range -}+-- | Enums in the specified inclusive range {-# INLINE enumsInRange #-} enumsInRange :: (Enum a, Ord a) => a -> a -> Unfoldr a enumsInRange from to =-  Unfoldr $ \ step init ->-  let-    loop int =-      if int <= to-        then step int (loop (succ int))-        else init-    in loop from+  Unfoldr $ \step init ->+    let loop int =+          if int <= to+            then step int (loop (succ int))+            else init+     in loop from -{-| Ascending infinite stream of ints starting from the one specified -}+-- | Ascending infinite stream of ints starting from the one specified {-# INLINE intsFrom #-} intsFrom :: Int -> Unfoldr Int intsFrom = enumsFrom -{-| Ints in the specified inclusive range -}+-- | Ints in the specified inclusive range {-# INLINE intsInRange #-} intsInRange :: Int -> Int -> Unfoldr Int intsInRange = enumsInRange -{-| Associations of a map -}+-- | Associations of a map {-# INLINE mapAssocs #-} mapAssocs :: Map key value -> Unfoldr (key, value) mapAssocs map =-  Unfoldr (\ step init -> Map.foldrWithKey (\ key value state -> step (key, value) state) init map)+  Unfoldr (\step init -> Map.foldrWithKey (\key value state -> step (key, value) state) init map) -{-| Associations of an intmap -}+-- | Associations of an intmap {-# INLINE intMapAssocs #-} intMapAssocs :: IntMap value -> Unfoldr (Int, value) intMapAssocs intMap =-  Unfoldr (\ step init -> IntMap.foldrWithKey (\ key value state -> step (key, value) state) init intMap)+  Unfoldr (\step init -> IntMap.foldrWithKey (\key value state -> step (key, value) state) init intMap) -{-| Keys of a hash-map -}+-- | Keys of a hash-map {-# INLINE hashMapKeys #-} hashMapKeys :: HashMap key value -> Unfoldr key hashMapKeys hashMap =-  Unfoldr (\ step init -> HashMap.foldrWithKey (\ key _ state -> step key state) init hashMap)+  Unfoldr (\step init -> HashMap.foldrWithKey (\key _ state -> step key state) init hashMap) -{-| Associations of a hash-map -}+-- | Associations of a hash-map {-# INLINE hashMapAssocs #-} hashMapAssocs :: HashMap key value -> Unfoldr (key, value) hashMapAssocs hashMap =-  Unfoldr (\ step init -> HashMap.foldrWithKey (\ key value state -> step (key, value) state) init hashMap)+  Unfoldr (\step init -> HashMap.foldrWithKey (\key value state -> step (key, value) state) init hashMap) -{-| Value of a hash-map by key -}+-- | Value of a hash-map by key {-# INLINE hashMapAt #-} hashMapAt :: (Hashable key, Eq key) => HashMap key value -> key -> Unfoldr value hashMapAt hashMap key = foldable (HashMap.lookup key hashMap) -{-| Value of a hash-map by key -}+-- | Value of a hash-map by key {-# INLINE hashMapValue #-} {-# DEPRECATED hashMapValue "Use 'hashMapAt' instead" #-} hashMapValue :: (Hashable key, Eq key) => key -> HashMap key value -> Unfoldr value hashMapValue key = foldable . HashMap.lookup key -{-| Values of a hash-map by their keys -}+-- | Values of a hash-map by their keys {-# INLINE hashMapValues #-} hashMapValues :: (Hashable key, Eq key) => HashMap key value -> Unfoldr key -> Unfoldr value hashMapValues hashMap keys = keys >>= flip hashMapValue hashMap -{-| Bytes of a bytestring -}+-- | Bytes of a bytestring {-# INLINE byteStringBytes #-} byteStringBytes :: ByteString -> Unfoldr Word8-byteStringBytes bs = Unfoldr (\ step init -> ByteString.foldr step init bs)+byteStringBytes bs = Unfoldr (\step init -> ByteString.foldr step init bs) -{-| Bytes of a short bytestring -}+-- | Bytes of a short bytestring {-# INLINE shortByteStringBytes #-} shortByteStringBytes :: ShortByteString -> Unfoldr Word8 shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#) -{-| Elements of a prim array -}+-- | Elements of a prim array {-# INLINE primArray #-} primArray :: (Prim prim) => PrimArray prim -> Unfoldr prim-primArray ba = Unfoldr $ \ f z -> foldrPrimArray f z ba+primArray ba = Unfoldr $ \f z -> foldrPrimArray f z ba -{-| Elements of a prim array coming paired with indices -}+-- | Elements of a prim array coming paired with indices {-# INLINE primArrayWithIndices #-} primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfoldr (Int, prim)-primArrayWithIndices pa = Unfoldr $ \ step state -> let-  !size = sizeofPrimArray pa-  loop index = if index < size-    then step (index, indexPrimArray pa index) (loop (succ index))-    else state-  in loop 0+primArrayWithIndices pa = Unfoldr $ \step state ->+  let !size = sizeofPrimArray pa+      loop index =+        if index < size+          then step (index, indexPrimArray pa index) (loop (succ index))+          else state+   in loop 0 -{-| Elements of a vector -}+-- | Elements of a vector {-# INLINE vector #-} vector :: GenericVector.Vector vector a => vector a -> Unfoldr a-vector vector = Unfoldr $ \ step state -> GenericVector.foldr step state vector+vector vector = Unfoldr $ \step state -> GenericVector.foldr step state vector -{-| Elements of a vector coming paired with indices -}+-- | Elements of a vector coming paired with indices {-# INLINE vectorWithIndices #-} vectorWithIndices :: GenericVector.Vector vector a => vector a -> Unfoldr (Int, a)-vectorWithIndices vector = Unfoldr $ \ step state -> GenericVector.ifoldr (\ index a -> step (index, a)) state vector+vectorWithIndices vector = Unfoldr $ \step state -> GenericVector.ifoldr (\index a -> step (index, a)) state vector -{-|-Binary digits of a non-negative integral number.--}+-- |+-- Binary digits of a non-negative integral number. binaryDigits :: Integral a => a -> Unfoldr a binaryDigits = reverse . reverseBinaryDigits -{-|-Binary digits of a non-negative integral number in reverse order.--}+-- |+-- Binary digits of a non-negative integral number in reverse order. reverseBinaryDigits :: Integral a => a -> Unfoldr a reverseBinaryDigits = reverseDigits 2 -{-|-Octal digits of a non-negative integral number.--}+-- |+-- Octal digits of a non-negative integral number. octalDigits :: Integral a => a -> Unfoldr a octalDigits = reverse . reverseOctalDigits -{-|-Octal digits of a non-negative integral number in reverse order.--}+-- |+-- Octal digits of a non-negative integral number in reverse order. reverseOctalDigits :: Integral a => a -> Unfoldr a reverseOctalDigits = reverseDigits 8 -{-|-Decimal digits of a non-negative integral number.--}+-- |+-- Decimal digits of a non-negative integral number. decimalDigits :: Integral a => a -> Unfoldr a decimalDigits = reverse . reverseDecimalDigits -{-|-Decimal digits of a non-negative integral number in reverse order.-More efficient than 'decimalDigits'.--}+-- |+-- Decimal digits of a non-negative integral number in reverse order.+-- More efficient than 'decimalDigits'. reverseDecimalDigits :: Integral a => a -> Unfoldr a reverseDecimalDigits = reverseDigits 10 -{-|-Hexadecimal digits of a non-negative number.--}+-- |+-- Hexadecimal digits of a non-negative number. hexadecimalDigits :: Integral a => a -> Unfoldr a hexadecimalDigits = reverse . reverseHexadecimalDigits -{-|-Hexadecimal digits of a non-negative number in reverse order.--}+-- |+-- Hexadecimal digits of a non-negative number in reverse order. reverseHexadecimalDigits :: Integral a => a -> Unfoldr a reverseHexadecimalDigits = reverseDigits 16 -{-|-Digits of a non-negative number in numeral system based on the specified radix.-The digits come in reverse order.--E.g., here's how an unfold of binary digits in proper order looks:--@-binaryDigits :: Integral a => a -> Unfoldr a-binaryDigits = 'reverse' . 'reverseDigits' 2-@--}-reverseDigits :: Integral a => a {-^ Radix -} -> a {-^ Number -} -> Unfoldr a-reverseDigits radix x = Unfoldr $ \ step init -> let-  loop x = case divMod x radix of-    (next, digit) -> step digit (if next <= 0 then init else loop next)-  in loop x--{-|-Reverse the order.+-- |+-- Digits of a non-negative number in numeral system based on the specified radix.+-- The digits come in reverse order.+--+-- E.g., here's how an unfold of binary digits in proper order looks:+--+-- @+-- binaryDigits :: Integral a => a -> Unfoldr a+-- binaryDigits = 'reverse' . 'reverseDigits' 2+-- @+reverseDigits ::+  Integral a =>+  -- | Radix+  a ->+  -- | Number+  a ->+  Unfoldr a+reverseDigits radix x = Unfoldr $ \step init ->+  let loop x = case divMod x radix of+        (next, digit) -> step digit (if next <= 0 then init else loop next)+   in loop x -Use with care, because it requires to allocate all elements.--}+-- |+-- Reverse the order.+--+-- Use with care, because it requires to allocate all elements. reverse :: Unfoldr a -> Unfoldr a-reverse (Unfoldr unfoldr) = Unfoldr $ \ step -> unfoldr (\ a f -> f . step a) id+reverse (Unfoldr unfoldr) = Unfoldr $ \step -> unfoldr (\a f -> f . step a) id  zipWith :: (a -> b -> c) -> Unfoldr a -> Unfoldr b -> Unfoldr c zipWith f l r =   Prelude.zipWith f (toList l) (toList r) & foldable -{-|-Lift into an unfold, which produces pairs with index.--}+-- |+-- Lift into an unfold, which produces pairs with index. zipWithIndex :: Unfoldr a -> Unfoldr (Int, a)-zipWithIndex (Unfoldr unfoldr) = Unfoldr $ \ indexedStep indexedState -> unfoldr-  (\ a nextStateByIndex index -> indexedStep (index, a) (nextStateByIndex (succ index)))-  (const indexedState)-  0+zipWithIndex (Unfoldr unfoldr) = Unfoldr $ \indexedStep indexedState ->+  unfoldr+    (\a nextStateByIndex index -> indexedStep (index, a) (nextStateByIndex (succ index)))+    (const indexedState)+    0 -{-|-Lift into an unfold, which produces pairs with right-associative index.--}+-- |+-- Lift into an unfold, which produces pairs with right-associative index. {-# DEPRECATED zipWithReverseIndex "This function builds up stack. Use 'zipWithIndex' instead." #-} zipWithReverseIndex :: Unfoldr a -> Unfoldr (Int, a)-zipWithReverseIndex (Unfoldr unfoldr) = Unfoldr $ \ step init -> snd $ unfoldr-  (\ a (index, state) -> (succ index, step (index, a) state))-  (0, init)+zipWithReverseIndex (Unfoldr unfoldr) = Unfoldr $ \step init ->+  snd $+    unfoldr+      (\a (index, state) -> (succ index, step (index, a) state))+      (0, init) -{-|-Indices of set bits.--}+-- |+-- Indices of set bits. setBitIndices :: FiniteBits a => a -> Unfoldr Int-setBitIndices a = let-  !size = finiteBitSize a-  in Unfoldr $ \ step state -> let-    loop !index = if index < size-      then if testBit a index-        then step index (loop (succ index))-        else loop (succ index)-      else state-    in loop 0+setBitIndices a =+  let !size = finiteBitSize a+   in Unfoldr $ \step state ->+        let loop !index =+              if index < size+                then+                  if testBit a index+                    then step index (loop (succ index))+                    else loop (succ index)+                else state+         in loop 0 -{-|-Indices of unset bits.--}+-- |+-- Indices of unset bits. unsetBitIndices :: FiniteBits a => a -> Unfoldr Int-unsetBitIndices a = let-  !size = finiteBitSize a-  in Unfoldr $ \ step state -> let-    loop !index = if index < size-      then if testBit a index-        then loop (succ index)-        else step index (loop (succ index))-      else state-    in loop 0+unsetBitIndices a =+  let !size = finiteBitSize a+   in Unfoldr $ \step state ->+        let loop !index =+              if index < size+                then+                  if testBit a index+                    then loop (succ index)+                    else step index (loop (succ index))+                else state+         in loop 0  take :: Int -> Unfoldr a -> Unfoldr a-take amount (Unfoldr unfoldr) = Unfoldr $ \ step init -> unfoldr-  (\ a nextState index -> if index < amount-    then step a (nextState (succ index))-    else init)-  (const init)-  0+take amount (Unfoldr unfoldr) = Unfoldr $ \step init ->+  unfoldr+    ( \a nextState index ->+        if index < amount+          then step a (nextState (succ index))+          else init+    )+    (const init)+    0  takeWhile :: (a -> Bool) -> Unfoldr a -> Unfoldr a-takeWhile predicate (Unfoldr unfoldr) = Unfoldr $ \ step init -> unfoldr-  (\ a nextState -> if predicate a-    then step a nextState-    else init)-  init+takeWhile predicate (Unfoldr unfoldr) = Unfoldr $ \step init ->+  unfoldr+    ( \a nextState ->+        if predicate a+          then step a nextState+          else init+    )+    init  cons :: a -> Unfoldr a -> Unfoldr a-cons a (Unfoldr unfoldr) = Unfoldr $ \ step init -> step a (unfoldr step init)+cons a (Unfoldr unfoldr) = Unfoldr $ \step init -> step a (unfoldr step init)  snoc :: a -> Unfoldr a -> Unfoldr a-snoc a (Unfoldr unfoldr) = Unfoldr $ \ step init -> unfoldr step (step a init)--{-|-Insert a separator value between each element.+snoc a (Unfoldr unfoldr) = Unfoldr $ \step init -> unfoldr step (step a init) -Behaves the same way as 'Data.List.intersperse'.--}+-- |+-- Insert a separator value between each element.+--+-- Behaves the same way as 'Data.List.intersperse'. {-# INLINE intersperse #-} intersperse :: a -> Unfoldr a -> Unfoldr a intersperse sep (Unfoldr unfoldr) =-  Unfoldr $ \ step init ->+  Unfoldr $ \step init ->     unfoldr-      (\ a next first ->-        if first-          then step a (next False)-          else step sep (step a (next False)))+      ( \a next first ->+          if first+            then step a (next False)+            else step sep (step a (next False))+      )       (const init)       True -{-|-Reproduces the behaviour of 'Data.Text.unpack'.--Implementation is efficient and avoids allocation of an intermediate list.--}+-- |+-- Reproduces the behaviour of 'Data.Text.unpack'.+--+-- Implementation is efficient and avoids allocation of an intermediate list. textChars :: Text -> Unfoldr Char textChars (TextInternal.Text arr off len) =-  Unfoldr $ \ step term ->-    let-      loop !offset =-        if offset >= len-          then term-          else -            TextArrayUtil.iter arr offset $ \ char nextOffset ->+  Unfoldr $ \step term ->+    let loop !offset =+          if offset >= len+            then term+            else TextArrayUtil.iter arr offset $ \char nextOffset ->               step char (loop nextOffset)-      in loop off--{-|-Reproduces the behaviour of 'Data.Text.words'.+     in loop off -Implementation is efficient and avoids allocation of an intermediate list.--}+-- |+-- Reproduces the behaviour of 'Data.Text.words'.+--+-- Implementation is efficient and avoids allocation of an intermediate list. textWords :: Text -> Unfoldr Text textWords (TextInternal.Text arr off len) =-  Unfoldr $ \ step term ->-    let-      loop !wordOffset !offset =-        if offset >= len-          then if wordOffset == offset-            then term-            else step (chunk wordOffset offset) term-          else-            TextArrayUtil.iter arr offset $ \ char nextOffset ->+  Unfoldr $ \step term ->+    let loop !wordOffset !offset =+          if offset >= len+            then+              if wordOffset == offset+                then term+                else step (chunk wordOffset offset) term+            else TextArrayUtil.iter arr offset $ \char nextOffset ->               if isSpace char-                then if wordOffset == offset-                  then loop nextOffset nextOffset-                  else step (chunk wordOffset offset) (loop nextOffset nextOffset)+                then+                  if wordOffset == offset+                    then loop nextOffset nextOffset+                    else step (chunk wordOffset offset) (loop nextOffset nextOffset)                 else loop wordOffset nextOffset-      in loop off off+     in loop off off   where     chunk startOffset afterEndOffset =       TextInternal.Text arr startOffset (afterEndOffset - startOffset) -{-|-Transformer of chars,-replaces all space-like chars with space,-all newline-like chars with @\\n@,-and trims their duplicate sequences to single-char.-Oh yeah, it also trims whitespace from beginning and end.--}+-- |+-- Transformer of chars,+-- replaces all space-like chars with space,+-- all newline-like chars with @\\n@,+-- and trims their duplicate sequences to single-char.+-- Oh yeah, it also trims whitespace from beginning and end. trimWhitespace :: Unfoldr Char -> Unfoldr Char trimWhitespace =-  \ foldable ->-    Unfoldr $ \ substep subterm ->+  \foldable ->+    Unfoldr $ \substep subterm ->       foldr (step substep) (finalize subterm) foldable False False False   where     step substep char next notFirst spacePending newlinePending =       if isSpace char-        then if char == '\n' || char == '\r'-          then next notFirst False True-          else next notFirst True newlinePending+        then+          if char == '\n' || char == '\r'+            then next notFirst False True+            else next notFirst True newlinePending         else-          let-            mapper =-              if notFirst-                then if newlinePending-                  then substep '\n'-                  else if spacePending-                    then substep ' '-                    else id-                else id-            in-              mapper $ substep char $ next True False False+          let mapper =+                if notFirst+                  then+                    if newlinePending+                      then substep '\n'+                      else+                        if spacePending+                          then substep ' '+                          else id+                  else id+           in mapper $ substep char $ next True False False     finalize subterm notFirst spacePending newlinePending =       subterm
library/DeferredFolds/Defs/UnfoldrM.hs view
@@ -1,11 +1,9 @@-module DeferredFolds.Defs.UnfoldrM-where+module DeferredFolds.Defs.UnfoldrM where  import DeferredFolds.Prelude import DeferredFolds.Types - unfoldr :: Monad m => Unfoldr a -> UnfoldrM m a-unfoldr (Unfoldr unfoldr) = UnfoldrM $ \ stepM -> let-  step input act state = stepM input state >>= act-  in unfoldr step return+unfoldr (Unfoldr unfoldr) = UnfoldrM $ \stepM ->+  let step input act state = stepM input state >>= act+   in unfoldr step return
library/DeferredFolds/Prelude.hs view
@@ -1,23 +1,23 @@ module DeferredFolds.Prelude-(-  module Exports,-)+  ( module Exports,+  ) where ---- base-------------------------- import Control.Applicative as Exports import Control.Arrow as Exports import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports-import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports+import Control.Foldl as Exports (Fold (..), FoldM (..))+import Control.Monad as Exports hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports+import Control.Monad.Trans.Class as Exports import Data.Bits as Exports import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.ByteString.Short as Exports (ShortByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports@@ -29,18 +29,27 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Identity as Exports-import Data.Int as Exports+import Data.HashMap.Strict as Exports (HashMap)+import Data.Hashable as Exports (Hashable) import Data.IORef as Exports+import Data.Int as Exports+import Data.IntMap.Strict as Exports (IntMap)+import Data.IntSet as Exports (IntSet) import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.Map.Strict as Exports (Map) import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Monoid as Exports hiding (First (..), Last (..), (<>)) import Data.Ord as Exports+import Data.Primitive as Exports import Data.Proxy as Exports import Data.Ratio as Exports-import Data.Semigroup as Exports import Data.STRef as Exports+import Data.Semigroup as Exports+import Data.Sequence as Exports (Seq)+import Data.Set as Exports (Set) import Data.String as Exports+import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports@@ -50,13 +59,12 @@ import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports-import Foreign.Storable as Exports hiding (sizeOf, alignment)-import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))+import Foreign.Storable as Exports hiding (alignment, sizeOf)+import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports-import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports@@ -66,44 +74,8 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports---- containers---------------------------import Data.IntMap.Strict as Exports (IntMap)-import Data.Map.Strict as Exports (Map)-import Data.IntSet as Exports (IntSet)-import Data.Set as Exports (Set)-import Data.Sequence as Exports (Seq)---- foldl---------------------------import Control.Foldl as Exports (Fold(..), FoldM(..))---- transformers---------------------------import Control.Monad.Trans.Class as Exports---- bytestring---------------------------import Data.ByteString as Exports (ByteString)-import Data.ByteString.Short as Exports (ShortByteString)---- primitive---------------------------import Data.Primitive as Exports---- unordered-containers---------------------------import Data.HashMap.Strict as Exports (HashMap)---- hashable---------------------------import Data.Hashable as Exports (Hashable)---- text---------------------------import Data.Text as Exports (Text)+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))
library/DeferredFolds/Types.hs view
@@ -1,120 +1,115 @@-module DeferredFolds.Types-where+module DeferredFolds.Types where  import DeferredFolds.Prelude --{-|-A projection on data, which only knows how to execute a strict left-fold.--It is a monad and a monoid, and is very useful for-efficiently aggregating the projections on data intended for left-folding,-since its concatenation (`<>`) has complexity of @O(1)@.--[Intuition]--The intuition for this abstraction can be derived from lists.--Let's consider the `Data.List.foldl'` function for lists:-->foldl' :: (b -> a -> b) -> b -> [a] -> b--If we reverse its parameters we get-->foldl' :: [a] -> (b -> a -> b) -> b -> b--Which in Haskell is essentially the same as-->foldl' :: [a] -> (forall b. (b -> a -> b) -> b -> b)--We can isolate that part into an abstraction:-->newtype Unfoldl a = Unfoldl (forall b. (b -> a -> b) -> b -> b)--Then we get to this simple morphism:-->list :: [a] -> Unfoldl a->list list = Unfoldl (\ step init -> foldl' step init list)--We can do the same with say "Data.Text.Text":-->text :: Text -> Unfoldl Char->text text = Unfoldl (\ step init -> Data.Text.foldl' step init text)--And then we can use those both to concatenate with just an @O(1)@ cost:-->abcdef :: Unfoldl Char->abcdef = list ['a', 'b', 'c'] <> text "def"--Please notice that up until this moment no actual data materialization has happened and-hence no traversals have appeared.-All that we've done is just composed a function,-which only specifies which parts of data structures to traverse to perform a left-fold.-Only at the moment where the actual folding will happen will we actually traverse the source data.-E.g., using the "fold" function:-->abcdefLength :: Int->abcdefLength = fold Control.Foldl.length abcdef--}+-- |+-- A projection on data, which only knows how to execute a strict left-fold.+--+-- It is a monad and a monoid, and is very useful for+-- efficiently aggregating the projections on data intended for left-folding,+-- since its concatenation (`<>`) has complexity of @O(1)@.+--+-- [Intuition]+--+-- The intuition for this abstraction can be derived from lists.+--+-- Let's consider the `Data.List.foldl'` function for lists:+--+-- >foldl' :: (b -> a -> b) -> b -> [a] -> b+--+-- If we reverse its parameters we get+--+-- >foldl' :: [a] -> (b -> a -> b) -> b -> b+--+-- Which in Haskell is essentially the same as+--+-- >foldl' :: [a] -> (forall b. (b -> a -> b) -> b -> b)+--+-- We can isolate that part into an abstraction:+--+-- >newtype Unfoldl a = Unfoldl (forall b. (b -> a -> b) -> b -> b)+--+-- Then we get to this simple morphism:+--+-- >list :: [a] -> Unfoldl a+-- >list list = Unfoldl (\ step init -> foldl' step init list)+--+-- We can do the same with say "Data.Text.Text":+--+-- >text :: Text -> Unfoldl Char+-- >text text = Unfoldl (\ step init -> Data.Text.foldl' step init text)+--+-- And then we can use those both to concatenate with just an @O(1)@ cost:+--+-- >abcdef :: Unfoldl Char+-- >abcdef = list ['a', 'b', 'c'] <> text "def"+--+-- Please notice that up until this moment no actual data materialization has happened and+-- hence no traversals have appeared.+-- All that we've done is just composed a function,+-- which only specifies which parts of data structures to traverse to perform a left-fold.+-- Only at the moment where the actual folding will happen will we actually traverse the source data.+-- E.g., using the "fold" function:+--+-- >abcdefLength :: Int+-- >abcdefLength = fold Control.Foldl.length abcdef newtype Unfoldl a = Unfoldl (forall x. (x -> a -> x) -> x -> x) -{-|-A monadic variation of "DeferredFolds.Unfoldl"--}+-- |+-- A monadic variation of "DeferredFolds.Unfoldl" newtype UnfoldlM m a = UnfoldlM (forall x. (x -> a -> m x) -> x -> m x) -{-|-A projection on data, which only knows how to execute a right-fold.--It is a monad and a monoid, and is very useful for-efficiently aggregating the projections on data intended for right-folding,-since its concatenation (`<>`) has complexity of @O(1)@.--[Intuition]--The intuition of what this abstraction is all about can be derived from lists.--Let's consider the `Data.List.foldr` function for lists:-->foldr :: (a -> b -> b) -> b -> [a] -> b--If we reverse its parameters we get-->foldr :: [a] -> (a -> b -> b) -> b -> b--Which in Haskell is essentially the same as-->foldr :: [a] -> (forall b. (a -> b -> b) -> b -> b)--We can isolate that part into an abstraction:-->newtype Unfoldr a = Unfoldr (forall b. (a -> b -> b) -> b -> b)--Then we get to this simple morphism:-->list :: [a] -> Unfoldr a->list list = Unfoldr (\ step init -> foldr step init list)--We can do the same with say "Data.Text.Text":-->text :: Text -> Unfoldr Char->text text = Unfoldr (\ step init -> Data.Text.foldr step init text)--And then we can use those both to concatenate with just an @O(1)@ cost:-->abcdef :: Unfoldr Char->abcdef = list ['a', 'b', 'c'] <> text "def"--Please notice that up until this moment no actual data materialization has happened and-hence no traversals have appeared.-All that we've done is just composed a function,-which only specifies which parts of data structures to traverse to perform a right-fold.-Only at the moment where the actual folding will happen will we actually traverse the source data.-E.g., using the "fold" function:-->abcdefLength :: Int->abcdefLength = fold Control.Foldl.length abcdef--}+-- |+-- A projection on data, which only knows how to execute a right-fold.+--+-- It is a monad and a monoid, and is very useful for+-- efficiently aggregating the projections on data intended for right-folding,+-- since its concatenation (`<>`) has complexity of @O(1)@.+--+-- [Intuition]+--+-- The intuition of what this abstraction is all about can be derived from lists.+--+-- Let's consider the `Data.List.foldr` function for lists:+--+-- >foldr :: (a -> b -> b) -> b -> [a] -> b+--+-- If we reverse its parameters we get+--+-- >foldr :: [a] -> (a -> b -> b) -> b -> b+--+-- Which in Haskell is essentially the same as+--+-- >foldr :: [a] -> (forall b. (a -> b -> b) -> b -> b)+--+-- We can isolate that part into an abstraction:+--+-- >newtype Unfoldr a = Unfoldr (forall b. (a -> b -> b) -> b -> b)+--+-- Then we get to this simple morphism:+--+-- >list :: [a] -> Unfoldr a+-- >list list = Unfoldr (\ step init -> foldr step init list)+--+-- We can do the same with say "Data.Text.Text":+--+-- >text :: Text -> Unfoldr Char+-- >text text = Unfoldr (\ step init -> Data.Text.foldr step init text)+--+-- And then we can use those both to concatenate with just an @O(1)@ cost:+--+-- >abcdef :: Unfoldr Char+-- >abcdef = list ['a', 'b', 'c'] <> text "def"+--+-- Please notice that up until this moment no actual data materialization has happened and+-- hence no traversals have appeared.+-- All that we've done is just composed a function,+-- which only specifies which parts of data structures to traverse to perform a right-fold.+-- Only at the moment where the actual folding will happen will we actually traverse the source data.+-- E.g., using the "fold" function:+--+-- >abcdefLength :: Int+-- >abcdefLength = fold Control.Foldl.length abcdef newtype Unfoldr a = Unfoldr (forall x. (a -> x -> x) -> x -> x)  newtype UnfoldrM m a = UnfoldrM (forall x. (a -> x -> m x) -> x -> m x)
library/DeferredFolds/Unfoldl.hs view
@@ -1,8 +1,7 @@ module DeferredFolds.Unfoldl-(-  module Exports,-)+  ( module Exports,+  ) where -import DeferredFolds.Types as Exports (Unfoldl(..)) import DeferredFolds.Defs.Unfoldl as Exports+import DeferredFolds.Types as Exports (Unfoldl (..))
library/DeferredFolds/UnfoldlM.hs view
@@ -1,8 +1,7 @@ module DeferredFolds.UnfoldlM-(-  module Exports,-)+  ( module Exports,+  ) where -import DeferredFolds.Types as Exports (UnfoldlM(..)) import DeferredFolds.Defs.UnfoldlM as Exports+import DeferredFolds.Types as Exports (UnfoldlM (..))
library/DeferredFolds/Unfoldr.hs view
@@ -1,8 +1,7 @@ module DeferredFolds.Unfoldr-(-  module Exports,-)+  ( module Exports,+  ) where -import DeferredFolds.Types as Exports (Unfoldr(..)) import DeferredFolds.Defs.Unfoldr as Exports hiding (foldrAndContainer)+import DeferredFolds.Types as Exports (Unfoldr (..))
library/DeferredFolds/UnfoldrM.hs view
@@ -1,8 +1,7 @@ module DeferredFolds.UnfoldrM-(-  module Exports,-)+  ( module Exports,+  ) where -import DeferredFolds.Types as Exports (UnfoldrM(..)) import DeferredFolds.Defs.UnfoldrM as Exports+import DeferredFolds.Types as Exports (UnfoldrM (..))
library/DeferredFolds/Util/TextArray.hs view
@@ -1,30 +1,35 @@-module DeferredFolds.Util.TextArray-where+{-# LANGUAGE CPP #-} -import DeferredFolds.Prelude hiding (Array)+module DeferredFolds.Util.TextArray where+ import Data.Text.Array import qualified Data.Text.Internal as TextInternal import qualified Data.Text.Internal.Encoding.Utf16 as TextUtf16 import qualified Data.Text.Internal.Unsafe.Char as TextChar-+import qualified Data.Text.Unsafe as TextUnsafe+import DeferredFolds.Prelude hiding (Array) -{-|-Same as 'Data.Text.Unsafe.iter',-but operates on the array directly,-uses a continuation and passes the next offset to it instead of delta.--}+-- |+-- Same as 'Data.Text.Unsafe.iter',+-- but operates on the array directly,+-- uses a continuation and passes the next offset to it instead of delta.+#if MIN_VERSION_text(2,0,0) {-# INLINE iter #-} iter :: Array -> Int -> (Char -> Int -> a) -> a iter arr offset cont =-  let-    b1 =-      unsafeIndex arr offset-    in if b1 >= 0xd800 && b1 <= 0xdbff-      then let-        b2 =-          unsafeIndex arr (succ offset)-        char =-          TextUtf16.chr2 b1 b2-        in cont char (offset + 2)-      else-        cont (TextChar.unsafeChr b1) (offset + 1)+  let TextUnsafe.Iter c d = TextUnsafe.iterArray arr offset in cont c (offset + d)+#else+{-# INLINE iter #-}+iter :: Array -> Int -> (Char -> Int -> a) -> a+iter arr offset cont =+  let b1 =+        unsafeIndex arr offset+   in if b1 >= 0xd800 && b1 <= 0xdbff+        then+          let b2 =+                unsafeIndex arr (succ offset)+              char =+                TextUtf16.chr2 b1 b2+           in cont char (offset + 2)+        else cont (TextChar.unsafeChr b1) (offset + 1)+#endif
test/Main.hs view
@@ -1,78 +1,66 @@ module Main where -import Prelude+import qualified Data.Text as Text+import qualified DeferredFolds.Unfoldr as Unfoldr+import qualified Test.QuickCheck as QuickCheck import Test.QuickCheck.Instances+import qualified Test.QuickCheck.Property as QuickCheck import Test.Tasty-import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck-import qualified Test.QuickCheck as QuickCheck-import qualified Test.QuickCheck.Property as QuickCheck-import qualified DeferredFolds.Unfoldr as Unfoldr-import qualified Data.Text as Text-+import Test.Tasty.Runners+import Prelude  main =   defaultMain $-  testGroup "All" $ [-    testProperty "List roundtrip" $ \ (list :: [Int]) ->-    list === toList (Unfoldr.foldable list)-    ,-    testProperty "take" $ \ (list :: [Int], amount) ->-    take amount list ===-    toList (Unfoldr.take amount (Unfoldr.foldable list))-    ,-    testProperty "takeWhile odd" $ \ (list :: [Int]) ->-    takeWhile odd list ===-    toList (Unfoldr.takeWhile odd (Unfoldr.foldable list))-    ,-    testProperty "intersperse" $ \ (list :: [Char]) -> -    intersperse ',' list ===-    toList (Unfoldr.intersperse ',' (Unfoldr.foldable list))-    ,-    testProperty "textChars" $ \ (text :: Text) ->-    Text.unpack text ===-    toList (Unfoldr.textChars text)-    ,-    testProperty "textWords" $ \ (text :: Text) ->-    Text.words text ===-    toList (Unfoldr.textWords text)-    ,-    testProperty "trimWhitespace 1" $ \ (text :: Text) ->-    let-      words =-        Text.words text-      run =-        fromString . toList . Unfoldr.trimWhitespace . Unfoldr.textChars-      spacedInput =-        Text.map (\ c -> if isSpace c then ' ' else c) text-      newlinedInput =-        Text.map (\ c -> if isSpace c then '\n' else c) text-      in-        Text.unwords words === run spacedInput .&&.-        Text.intercalate "\n" words === run newlinedInput-    ,-    testProperty "trimWhitespace 2" $ \ (text :: Text) ->-    let-      isNewline c =-        c == '\n' || c == '\r'-      isSpaceButNotNewline c =-        isSpace c && not (isNewline c)-      normalize separator condition =-        Text.split condition >>>-        filter (not . Text.null) >>>-        Text.intercalate separator-      expected =-        text &-        Text.split isNewline &-        fmap Text.strip &-        filter (not . Text.null) &-        Text.intercalate "\n" &-        Text.split isSpaceButNotNewline &-        filter (not . Text.null) &-        Text.intercalate " "-      run =-        fromString . toList . Unfoldr.trimWhitespace . Unfoldr.textChars-      in-        expected === run text-  ]+    testGroup "All" $+      [ testProperty "List roundtrip" $ \(list :: [Int]) ->+          list === toList (Unfoldr.foldable list),+        testProperty "take" $ \(list :: [Int], amount) ->+          take amount list+            === toList (Unfoldr.take amount (Unfoldr.foldable list)),+        testProperty "takeWhile odd" $ \(list :: [Int]) ->+          takeWhile odd list+            === toList (Unfoldr.takeWhile odd (Unfoldr.foldable list)),+        testProperty "intersperse" $ \(list :: [Char]) ->+          intersperse ',' list+            === toList (Unfoldr.intersperse ',' (Unfoldr.foldable list)),+        testProperty "textChars" $ \(text :: Text) ->+          Text.unpack text+            === toList (Unfoldr.textChars text),+        testProperty "textWords" $ \(text :: Text) ->+          Text.words text+            === toList (Unfoldr.textWords text),+        testProperty "trimWhitespace 1" $ \(text :: Text) ->+          let words =+                Text.words text+              run =+                fromString . toList . Unfoldr.trimWhitespace . Unfoldr.textChars+              spacedInput =+                Text.map (\c -> if isSpace c then ' ' else c) text+              newlinedInput =+                Text.map (\c -> if isSpace c then '\n' else c) text+           in Text.unwords words === run spacedInput+                .&&. Text.intercalate "\n" words === run newlinedInput,+        testProperty "trimWhitespace 2" $ \(text :: Text) ->+          let isNewline c =+                c == '\n' || c == '\r'+              isSpaceButNotNewline c =+                isSpace c && not (isNewline c)+              normalize separator condition =+                Text.split condition+                  >>> filter (not . Text.null)+                  >>> Text.intercalate separator+              expected =+                text+                  & Text.split isNewline+                  & fmap Text.strip+                  & filter (not . Text.null)+                  & Text.intercalate "\n"+                  & Text.split isSpaceButNotNewline+                  & filter (not . Text.null)+                  & Text.intercalate " "+              run =+                fromString . toList . Unfoldr.trimWhitespace . Unfoldr.textChars+           in expected === run text+      ]