module DeferredFolds.Unfold
where
import DeferredFolds.Prelude
import qualified DeferredFolds.Prelude as A
import qualified DeferredFolds.UnfoldM as B
import qualified Data.Map.Strict as C
import qualified Data.IntMap.Strict as D
newtype Unfold input =
Unfold (forall output. (output -> input -> output) -> output -> output)
deriving instance Functor Unfold
instance Applicative Unfold where
pure x =
Unfold (\ step init -> step init x)
(<*>) = ap
instance Alternative Unfold where
empty =
Unfold (const id)
{-# INLINE (<|>) #-}
(<|>) (Unfold left) (Unfold right) =
Unfold (\ step init -> right step (left step init))
instance Monad Unfold where
return = pure
(>>=) (Unfold left) rightK =
Unfold $ \ step init ->
let
newStep output x =
case rightK x of
Unfold right ->
right step output
in left newStep init
instance MonadPlus Unfold where
mzero = empty
mplus = (<|>)
instance Semigroup (Unfold a) where
(<>) = (<|>)
instance Monoid (Unfold a) where
mempty = empty
mappend = (<>)
instance Foldable Unfold where
{-# INLINE foldMap #-}
foldMap inputMonoid = foldl' step mempty where
step monoid input = mappend monoid (inputMonoid input)
foldl = foldl'
{-# INLINE foldl' #-}
foldl' step init (Unfold run) = run step init
instance Eq a => Eq (Unfold a) where
(==) left right = toList left == toList right
instance Show a => Show (Unfold a) where
show = show . toList
{-# INLINE fold #-}
fold :: Fold input output -> Unfold input -> output
fold (Fold step init extract) (Unfold run) = extract (run step init)
{-# INLINE unfoldM #-}
unfoldM :: B.UnfoldM Identity input -> Unfold input
unfoldM (B.UnfoldM runFoldM) = Unfold (\ step init -> runIdentity (runFoldM (\ a b -> return (step a b)) init))
{-# INLINE foldable #-}
foldable :: Foldable foldable => foldable a -> Unfold a
foldable foldable = Unfold (\ step init -> A.foldl' step init foldable)
{-# INLINE filter #-}
filter :: (a -> Bool) -> Unfold a -> Unfold a
filter test (Unfold run) = Unfold (\ step -> run (\ state element -> if test element then step state element else state))
{-# INLINE intsInRange #-}
intsInRange :: Int -> Int -> Unfold Int
intsInRange from to =
Unfold $ \ step init ->
let
loop !state int =
if int <= to
then loop (step state int) (succ int)
else state
in loop init from
{-# INLINE map #-}
map :: Map key value -> Unfold (key, value)
map map =
Unfold (\ step init -> C.foldlWithKey' (\ state key value -> step state (key, value)) init map)
{-# INLINE intMap #-}
intMap :: IntMap value -> Unfold (Int, value)
intMap intMap =
Unfold (\ step init -> D.foldlWithKey' (\ state key value -> step state (key, value)) init intMap)