deferred-folds-0.9.18.6/0000755000000000000000000000000007346545000013033 5ustar0000000000000000deferred-folds-0.9.18.6/LICENSE0000644000000000000000000000203607346545000014041 0ustar0000000000000000Copyright (c) 2018, Metrix.AI Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. deferred-folds-0.9.18.6/deferred-folds.cabal0000644000000000000000000000633407346545000016712 0ustar0000000000000000cabal-version: 3.0 name: deferred-folds version: 0.9.18.6 category: Folding synopsis: Abstractions over deferred folds description: This library is in an experimental state. Users should be prepared for frequent updates. stability: Experimental homepage: https://github.com/nikita-volkov/deferred-folds bug-reports: https://github.com/nikita-volkov/deferred-folds/issues author: Nikita Volkov maintainer: Nikita Volkov copyright: (c) 2018, Metrix.AI license: MIT license-file: LICENSE build-type: Simple source-repository head type: git location: git://github.com/metrix-ai/deferred-folds.git library hs-source-dirs: library default-extensions: NoImplicitPrelude NoMonomorphismRestriction Arrows BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase LiberalTypeSynonyms MagicHash MultiParamTypeClasses MultiWayIf OverloadedStrings ParallelListComp PatternGuards PatternSynonyms QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeOperators UnboxedTuples default-language: Haskell2010 exposed-modules: DeferredFolds.Unfoldl DeferredFolds.UnfoldlM DeferredFolds.Unfoldr other-modules: DeferredFolds.Defs.Unfoldl DeferredFolds.Defs.UnfoldlM DeferredFolds.Defs.Unfoldr DeferredFolds.Defs.UnfoldrM DeferredFolds.Prelude DeferredFolds.Types DeferredFolds.UnfoldrM DeferredFolds.Util.TextArray build-depends: , base >=4.9 && <5 , bytestring >=0.10 && <0.13 , containers >=0.5 && <0.8 , foldl >=1 && <2 , hashable >=1 && <2 , primitive >=0.6.4 && <0.10 , text >=1.2 && <1.3 || >=2.0 && <2.2 , transformers >=0.5 && <0.7 , unordered-containers >=0.2 && <0.3 , vector >=0.12 && <0.14 test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test default-extensions: NoImplicitPrelude NoMonomorphismRestriction Arrows BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase LiberalTypeSynonyms MagicHash MultiParamTypeClasses MultiWayIf OverloadedStrings ParallelListComp PatternGuards PatternSynonyms QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeOperators UnboxedTuples default-language: Haskell2010 main-is: Main.hs build-depends: , deferred-folds , quickcheck-instances >=0.3.11 && <0.4 , rerebase <2 , tasty >=0.12 && <2 , tasty-quickcheck >=0.9 && <0.11 deferred-folds-0.9.18.6/library/DeferredFolds/Defs/0000755000000000000000000000000007346545000020070 5ustar0000000000000000deferred-folds-0.9.18.6/library/DeferredFolds/Defs/Unfoldl.hs0000644000000000000000000001067307346545000022036 0ustar0000000000000000{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-} 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 qualified DeferredFolds.Prelude as A import DeferredFolds.Types deriving instance Functor Unfoldl instance Applicative Unfoldl where pure x = Unfoldl (\step init -> step init x) (<*>) = ap instance Alternative Unfoldl where empty = Unfoldl (const id) {-# INLINE (<|>) #-} (<|>) (Unfoldl left) (Unfoldl right) = 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 instance MonadPlus Unfoldl where mzero = empty mplus = (<|>) instance Semigroup (Unfoldl a) where (<>) = (<|>) instance Monoid (Unfoldl a) where mempty = empty mappend = (<>) instance Foldable Unfoldl where {-# INLINE foldMap #-} 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 instance (Eq a) => Eq (Unfoldl a) where (==) left right = toList left == toList right instance (Show a) => Show (Unfoldl a) where show = show . toList instance IsList (Unfoldl a) where type Item (Unfoldl a) = a fromList list = foldable list toList = foldr (:) [] -- | 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 {-# INLINE unfoldlM #-} unfoldlM :: UnfoldlM Identity input -> Unfoldl input 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 {-# 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 -- | Construct from any foldable {-# INLINE foldable #-} foldable :: (Foldable foldable) => foldable a -> Unfoldl a foldable foldable = Unfoldl (\step init -> A.foldl' step init foldable) -- | 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)) -- | 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 -- | 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) -- | 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) -- | Bytes of a bytestring {-# INLINE byteStringBytes #-} byteStringBytes :: ByteString -> Unfoldl Word8 byteStringBytes bs = Unfoldl (\step init -> ByteString.foldl' step init bs) -- | Bytes of a short bytestring {-# INLINE shortByteStringBytes #-} shortByteStringBytes :: ShortByteString -> Unfoldl Word8 shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#) -- | Elements of a prim array {-# INLINE primArray #-} primArray :: (Prim prim) => PrimArray prim -> Unfoldl prim primArray ba = Unfoldl $ \f z -> foldlPrimArray' f z ba -- | 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 deferred-folds-0.9.18.6/library/DeferredFolds/Defs/UnfoldlM.hs0000644000000000000000000001533507346545000022153 0ustar0000000000000000{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-} module DeferredFolds.Defs.UnfoldlM where 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) (<*>) = ap instance (Monad m) => Alternative (UnfoldlM m) where empty = UnfoldlM (const return) {-# INLINE (<|>) #-} (<|>) (UnfoldlM left) (UnfoldlM right) = 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 instance (Monad m) => MonadPlus (UnfoldlM m) where mzero = empty mplus = (<|>) instance MonadTrans UnfoldlM where lift m = UnfoldlM (\step init -> m >>= step init) instance (Monad m) => Semigroup (UnfoldlM m a) where (<>) = (<|>) instance (Monad m) => Monoid (UnfoldlM m a) where mempty = empty mappend = (<>) instance Foldable (UnfoldlM Identity) where {-# INLINE foldMap #-} foldMap inputMonoid = foldl' step mempty where step monoid input = mappend monoid (inputMonoid input) foldl = foldl' {-# INLINE foldl' #-} foldl' step init (UnfoldlM run) = runIdentity (run identityStep init) where identityStep state input = return (step state input) instance (Eq a) => Eq (UnfoldlM Identity a) where (==) left right = toList left == toList right instance (Show a) => Show (UnfoldlM Identity a) where show = show . toList instance IsList (UnfoldlM Identity a) where type Item (UnfoldlM Identity a) = a fromList list = foldable list toList = foldr (:) [] -- | Check whether it's empty {-# INLINE null #-} null :: (Monad m) => UnfoldlM m input -> m Bool null (UnfoldlM run) = run (\_ _ -> return False) True -- | 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_ {-# INLINE mapM_ #-} mapM_ :: (Monad m) => (input -> m ()) -> UnfoldlM m input -> m () mapM_ step = foldlM' (const step) () -- | Same as 'mapM_' with arguments flipped {-# INLINE forM_ #-} forM_ :: (Monad m) => UnfoldlM m input -> (input -> m ()) -> m () forM_ = flip mapM_ -- | 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 {-# INLINE foldM #-} foldM :: (Monad m) => FoldM m input output -> UnfoldlM m input -> m output foldM (FoldM step init extract) view = do initialState <- init finalState <- foldlM' step initialState view extract finalState -- | 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 -- | 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) -- | 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)) -- | 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) unfoldr :: (Monad m) => Unfoldr a -> UnfoldlM m a unfoldr (Unfoldr unfoldr) = foldrRunner unfoldr -- | 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))) -- | 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 -- | TVar contents {-# INLINE tVarValue #-} tVarValue :: TVar a -> UnfoldlM STM a tVarValue var = UnfoldlM $ \step state -> do a <- readTVar var step state a -- | 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) -- | 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) -- | 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 {-# INLINE primArray #-} primArray :: (Monad m, Prim prim) => PrimArray prim -> UnfoldlM m prim primArray pa = UnfoldlM $ \f z -> foldlPrimArrayM' f z pa -- | 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 deferred-folds-0.9.18.6/library/DeferredFolds/Defs/Unfoldr.hs0000644000000000000000000003460407346545000022044 0ustar0000000000000000{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-} module DeferredFolds.Defs.Unfoldr where import qualified Data.ByteString as ByteString import qualified Data.ByteString.Short.Internal as ShortByteString 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) (<*>) = ap instance Alternative Unfoldr where empty = Unfoldr (const id) {-# INLINE (<|>) #-} (<|>) (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 instance MonadPlus Unfoldr where mzero = empty mplus = (<|>) instance Semigroup (Unfoldr a) where (<>) = (<|>) instance Monoid (Unfoldr a) where mempty = empty mappend = (<>) instance Foldable Unfoldr where {-# INLINE foldMap #-} foldMap fn (Unfoldr unfoldr) = unfoldr (mappend . fn) mempty {-# INLINE foldr #-} 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 instance Traversable Unfoldr where traverse f (Unfoldr unfoldr) = unfoldr (\a next -> liftA2 cons (f a) next) (pure mempty) instance (Eq a) => Eq (Unfoldr a) where (==) left right = toList left == toList right instance (Show a) => Show (Unfoldr a) where show = show . toList instance IsList (Unfoldr a) where type Item (Unfoldr a) = a fromList list = foldable list toList = foldr (:) [] -- | 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 -- | 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 -- | 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) -- | Construct from any foldable {-# INLINE foldable #-} foldable :: (Foldable foldable) => foldable a -> Unfoldr a foldable = foldrAndContainer foldr -- | Elements of IntSet. {-# INLINE intSet #-} intSet :: IntSet -> Unfoldr Int intSet = foldrAndContainer IntSet.foldr -- | 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)) -- | 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 -- | 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 -- | Ascending infinite stream of ints starting from the one specified {-# INLINE intsFrom #-} intsFrom :: Int -> Unfoldr Int intsFrom = enumsFrom -- | Ints in the specified inclusive range {-# INLINE intsInRange #-} intsInRange :: Int -> Int -> Unfoldr Int intsInRange = enumsInRange -- | 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) -- | 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) -- | 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) -- | 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) -- | 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 {-# 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 {-# 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 {-# INLINE byteStringBytes #-} byteStringBytes :: ByteString -> Unfoldr Word8 byteStringBytes bs = Unfoldr (\step init -> ByteString.foldr step init bs) -- | Bytes of a short bytestring {-# INLINE shortByteStringBytes #-} shortByteStringBytes :: ShortByteString -> Unfoldr Word8 shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#) -- | Elements of a prim array {-# INLINE primArray #-} primArray :: (Prim prim) => PrimArray prim -> Unfoldr prim primArray ba = Unfoldr $ \f z -> foldrPrimArray f z ba -- | 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 -- | 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 -- | 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 -- | -- 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. reverseBinaryDigits :: (Integral a) => a -> Unfoldr a reverseBinaryDigits = reverseDigits 2 -- | -- 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. reverseOctalDigits :: (Integral a) => a -> Unfoldr a reverseOctalDigits = reverseDigits 8 -- | -- 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'. reverseDecimalDigits :: (Integral a) => a -> Unfoldr a reverseDecimalDigits = reverseDigits 10 -- | -- 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. 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) => -- | 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 -- | -- 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 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. 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 -- | -- 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) -- | -- 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 -- | -- 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 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 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 cons :: a -> Unfoldr a -> Unfoldr a 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. -- -- Behaves the same way as 'Data.List.intersperse'. {-# INLINE intersperse #-} intersperse :: a -> Unfoldr a -> Unfoldr a intersperse sep (Unfoldr unfoldr) = Unfoldr $ \step init -> unfoldr ( \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. 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 -> step char (loop nextOffset) in loop off -- | -- 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 -> if isSpace char then if wordOffset == offset then loop nextOffset nextOffset else step (chunk wordOffset offset) (loop nextOffset nextOffset) else loop wordOffset nextOffset 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. trimWhitespace :: Unfoldr Char -> Unfoldr Char trimWhitespace = \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 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 finalize subterm notFirst spacePending newlinePending = subterm deferred-folds-0.9.18.6/library/DeferredFolds/Defs/UnfoldrM.hs0000644000000000000000000000042707346545000022155 0ustar0000000000000000module 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 deferred-folds-0.9.18.6/library/DeferredFolds/0000755000000000000000000000000007346545000017207 5ustar0000000000000000deferred-folds-0.9.18.6/library/DeferredFolds/Prelude.hs0000644000000000000000000000661007346545000021146 0ustar0000000000000000{-# OPTIONS_GHC -Wno-dodgy-imports #-} module DeferredFolds.Prelude ( module Exports, ) where 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.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 import Data.Data as Exports import Data.Dynamic as Exports import Data.Either as Exports import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports hiding (unzip) import Data.Functor.Identity 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 (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 (First (..), Last (..), (<>)) import Data.Ord as Exports import Data.Primitive as Exports import Data.Proxy as Exports import Data.Ratio 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 import Data.Version as Exports import Data.Word as Exports import Debug.Trace as Exports import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports 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 System.Environment as Exports import System.Exit as Exports import System.IO as Exports import System.IO.Error as Exports import System.IO.Unsafe as Exports import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports 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 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, (.)) deferred-folds-0.9.18.6/library/DeferredFolds/Types.hs0000644000000000000000000000743107346545000020654 0ustar0000000000000000module DeferredFolds.Types where -- | -- 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 rearrange 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" 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 rearrange 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) deferred-folds-0.9.18.6/library/DeferredFolds/Unfoldl.hs0000644000000000000000000000023607346545000021147 0ustar0000000000000000module DeferredFolds.Unfoldl ( module Exports, ) where import DeferredFolds.Defs.Unfoldl as Exports import DeferredFolds.Types as Exports (Unfoldl (..)) deferred-folds-0.9.18.6/library/DeferredFolds/UnfoldlM.hs0000644000000000000000000000024107346545000021260 0ustar0000000000000000module DeferredFolds.UnfoldlM ( module Exports, ) where import DeferredFolds.Defs.UnfoldlM as Exports import DeferredFolds.Types as Exports (UnfoldlM (..)) deferred-folds-0.9.18.6/library/DeferredFolds/Unfoldr.hs0000644000000000000000000000027107346545000021154 0ustar0000000000000000module DeferredFolds.Unfoldr ( module Exports, ) where import DeferredFolds.Defs.Unfoldr as Exports hiding (foldrAndContainer) import DeferredFolds.Types as Exports (Unfoldr (..)) deferred-folds-0.9.18.6/library/DeferredFolds/UnfoldrM.hs0000644000000000000000000000024107346545000021266 0ustar0000000000000000module DeferredFolds.UnfoldrM ( module Exports, ) where import DeferredFolds.Defs.UnfoldrM as Exports import DeferredFolds.Types as Exports (UnfoldrM (..)) deferred-folds-0.9.18.6/library/DeferredFolds/Util/0000755000000000000000000000000007346545000020124 5ustar0000000000000000deferred-folds-0.9.18.6/library/DeferredFolds/Util/TextArray.hs0000644000000000000000000000213107346545000022400 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-unused-imports #-} module DeferredFolds.Util.TextArray where import Data.Text.Array 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. #if MIN_VERSION_text(2,0,0) {-# INLINE iter #-} iter :: Array -> Int -> (Char -> Int -> a) -> a iter arr offset cont = 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 deferred-folds-0.9.18.6/test/0000755000000000000000000000000007346545000014012 5ustar0000000000000000deferred-folds-0.9.18.6/test/Main.hs0000644000000000000000000000445507346545000015242 0ustar0000000000000000module Main where import qualified Data.Text as Text import qualified DeferredFolds.Unfoldr as Unfoldr import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck import Prelude main :: IO () 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) 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 ]