yaftee-conduit (empty) → 0.1.0.0
raw patch · 10 files changed
+566/−0 lines, 10 filesdep +basedep +ftcqueuedep +higher-order-freer-monadsetup-changed
Dependencies added: base, ftcqueue, higher-order-freer-monad, higher-order-open-union, yaftee, yaftee-basic-monads, yaftee-conduit
Files
- CHANGELOG.md +11/−0
- LICENSE +26/−0
- README.md +40/−0
- Setup.hs +2/−0
- src/Control/Monad/Yaftee/Pipe.hs +201/−0
- src/Control/Monad/Yaftee/Pipe/IO.hs +67/−0
- src/Control/Monad/Yaftee/Pipe/List.hs +49/−0
- src/Control/Monad/Yaftee/Pipe/Tools.hs +99/−0
- test/Spec.hs +2/−0
- yaftee-conduit.cabal +69/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `yaftee-conduit`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2025 Yoshikuni Jujo++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,40 @@+# yaftee-conduit++```Haskell+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module TryConduit.FromOld where++import Prelude hiding (take, putStrLn)++import Control.Monad+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Pipe.Tools qualified as PipeT+import Control.Monad.Yaftee.Pipe.IO qualified as PipeIO+import Control.Monad.Yaftee.IO qualified as IO+import Control.HigherOpenUnion qualified as U+import Data.Char+import System.IO (openFile, IOMode(..), hClose)++action :: FilePath -> IO ()+action fp = do+ h <- openFile fp ReadMode+ _ <- Eff.runM . Pipe.run $+ PipeIO.hGetLines h Pipe.=$=+ take 5 Pipe.=$=+ PipeT.convert (toUpper <$>) Pipe.=$=+ putStrLn+ hClose h++take :: U.Member Pipe.P es => Int -> Eff.E es a a ()+take = \case+ 0 -> pure ()+ n -> Pipe.await >>= \x -> Pipe.yield x >> take (n - 1)++putStrLn :: (U.Member Pipe.P es, U.Base IO.I es) => Eff.E es String o r+putStrLn = forever $ IO.putStrLn =<< Pipe.await+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Monad/Yaftee/Pipe.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe (++ -- * TYPE++ P,++ -- * GET/PUT++ isEmpty, isMore, await, awaitMaybe, yield,++ -- * PIPE++ (=$=), (=@=),++ -- * RUN++ run++ ) where++import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.HigherFreer qualified as F+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as Fn+import Data.FTCQueue qualified as Q+import Data.Bool++data P f i o a where+ IsMore :: forall f i o . P f i o Bool+ Await :: P f i o i+ Yield :: forall f i o . !o -> P f i o ()+ (:=$=) :: forall f i x o r r' .+ !(f i x r) -> !(f x o r') -> P f i o (f i x r, f x o r')+ (:=@=) :: forall f i x o r r' .+ !(f i x r) -> !(f x o r') -> P f i o (f i x r, f x o r')++isEmpty, isMore :: U.Member P es => Eff.E es i o Bool+isEmpty = not <$> Eff.effh IsMore+isMore = Eff.effh IsMore++await :: U.Member P es => Eff.E es i o i+await = Eff.effh Await++awaitMaybe :: U.Member P es => Eff.E es i o (Maybe i)+awaitMaybe = isMore >>= bool (pure Nothing) (Just <$> await)++yield :: forall es i o . U.Member P es => o -> Eff.E es i o ()+yield = Eff.effh . Yield++(=$=), (=@=) :: forall es i x o r r' . U.Member P es =>+ Eff.E es i x r -> Eff.E es x o r' ->+ Eff.E es i o (Eff.E es i x r, Eff.E es x o r')+(=$=) = (Eff.effh .) . (:=$=); (=@=) = (Eff.effh .) . (:=@=)++run :: Fn.Tight (U.U es) => Eff.E (P ': es) i o a -> Eff.E es i o (Maybe a)+run = \case+ F.Pure x -> F.Pure $ Just x+ u F.:>>= q -> case U.decomp u of+ Left u' -> Fn.mapT run Just u' F.:>>=+ Q.singleton (maybe (pure Nothing) (run . (q F.$)))+ Right IsMore -> pure Nothing+ Right Await -> pure Nothing+ Right (Yield _) -> pure Nothing+ Right (o :=$= p) ->+ run (o =$=! p) >>= maybe (pure Nothing) (run F.. q)+ Right (o :=@= p) ->+ run (o =@=! p) >>= maybe (pure Nothing) (run F.. q)++(=$=!) :: forall es i x o r r' . Fn.Tight (U.U es) =>+ Eff.E (P ': es) i x r -> Eff.E (P ': es) x o r' ->+ Eff.E (P ': es) i o (Eff.E (P ': es) i x r, Eff.E (P ': es) x o r')+o =$=! p@(F.Pure _) = F.Pure (o, p)+o@(F.Pure _) =$=! p@(v F.:>>= r) = case U.decomp v of+ Left v' -> U.weaken (Fn.mapT (o =$=!) ((o ,) . F.Pure) v') F.:>>=+ Q.singleton \case+ (o', F.Pure y) -> o' =$=! (r F.$ y)+ (o'@(F.Pure _), p') -> F.Pure (o', (r F.$) =<< p')+ _ -> error "never occur"+ Right (o' :=$= p') -> o =$=! ((r F.$) =<< o' =$=! p')+ Right (o' :=@= p') -> o =$=! ((r F.$) =<< o' =@=! p')+ Right IsMore -> o =$=! (r F.$ False)+ Right Await -> F.Pure (o, p)+ Right (Yield ot) ->+ U.injh (Yield @_ @i ot) F.:>>= Q.singleton ((o =$=!) F.. r)+o@(u F.:>>= q) =$=! p@(v F.:>>= r) = case (U.decomp u, U.decomp v) of+ (_, Left v') -> U.weaken (Fn.mapT (o =$=!) ((o ,) . F.Pure) v') F.:>>=+ Q.singleton \case+ (o', F.Pure y) -> o' =$=! (r F.$ y)+ (o'@(F.Pure _), p') -> F.Pure (o', (r F.$) =<< p')+ _ -> error "never occur"+ (_, Right (o' :=$= p')) -> o =$=! ((r F.$) =<< (o' =$=! p'))+ (_, Right (o' :=@= p')) -> o =$=! ((r F.$) =<< (o' =@=! p'))+ (_, Right (Yield ot)) ->+ U.injh (Yield @_ @i ot) F.:>>= Q.singleton ((o =$=!) F.. r)+ (Right IsMore, _) ->+ U.injh (IsMore @_ @_ @o) F.:>>= Q.singleton ((=$=! p) F.. q)+ (Right Await, _) ->+ U.injh (Await @_ @_ @o) F.:>>= Q.singleton ((=$=! p) F.. q)+ (Right (Yield _), Right IsMore) -> o =$=! (r F.$ True)+ (Right (o' :=$= p'), Right IsMore) -> ((q F.$) =<< (o' =$=! p')) =$=! p+ (Right (o' :=@= p'), Right IsMore) -> ((q F.$) =<< (o' =@=! p')) =$=! p+ (Right (Yield !ot), Right Await) -> (q F.$ ()) =$=! (r F.$ ot)+ (Right (o' :=$= p'), Right Await) -> ((q F.$) =<< (o' =$=! p')) =$=! p+ (Right (o' :=@= p'), Right Await) -> ((q F.$) =<< (o' =@=! p')) =$=! p+ (Left u', _) -> U.weaken (Fn.mapT (=$=!! p) ((, p) . F.Pure) u') F.:>>=+ Q.singleton \case+ (F.Pure x, p') -> (q F.$ x) =$=! p'+ (o', p'@(F.Pure _)) -> F.Pure ((q F.$) =<< o', p')+ _ -> error "never occur"++(=$=!!) :: forall es i x o r r' . Fn.Tight (U.U es) =>+ Eff.E (P ': es) i x r -> Eff.E (P ': es) x o r' ->+ Eff.E (P ': es) i o (Eff.E (P ': es) i x r, Eff.E (P ': es) x o r')+o =$=!! p@(F.Pure _) = F.Pure (o, p)+o@(F.Pure _) =$=!! p@(v F.:>>= r) = case U.decomp v of+ Left v' -> U.weaken (Fn.mapT (o =$=!!) ((o ,) . F.Pure) v') F.:>>=+ Q.singleton \case+ (o', F.Pure y) -> o' =$=!! (r F.$ y)+ (o'@(F.Pure _), p') -> F.Pure (o', (r F.$) =<< p')+ _ -> error "never occur"+ Right (o' :=$= p') -> o =$=!! ((r F.$) =<< o' =$=! p')+ Right (o' :=@= p') -> o =$=!! ((r F.$) =<< o' =@=! p')+ Right IsMore -> F.Pure (o, p)+ Right Await -> F.Pure (o, p)+ Right (Yield ot) ->+ U.injh (Yield @_ @i ot) F.:>>= Q.singleton ((o =$=!!) F.. r)+o@(u F.:>>= q) =$=!! p@(v F.:>>= r) = case (U.decomp u, U.decomp v) of+ (_, Left v') -> U.weaken (Fn.mapT (o =$=!!) ((o ,) . F.Pure) v') F.:>>=+ Q.singleton \case+ (o', F.Pure y) -> o' =$=!! (r F.$ y)+ (o'@(F.Pure _), p') -> F.Pure (o', (r F.$) =<< p')+ _ -> error "never occur"+ (_, Right (o' :=$= p')) -> o =$=!! ((r F.$) =<< (o' =$=! p'))+ (_, Right (o' :=@= p')) -> o =$=!! ((r F.$) =<< (o' =@=! p'))+ (_, Right (Yield ot)) ->+ U.injh (Yield @_ @i ot) F.:>>= Q.singleton ((o =$=!!) F.. r)+ (Right IsMore, _) ->+ U.injh (IsMore @_ @_ @o) F.:>>= Q.singleton ((=$=!! p) F.. q)+ (Right Await, _) ->+ U.injh (Await @_ @_ @o) F.:>>= Q.singleton ((=$=!! p) F.. q)+ (Right (Yield _), Right IsMore) -> o =$=!! (r F.$ True)+ (Right (o' :=$= p'), Right IsMore) -> ((q F.$) =<< (o' =$=! p')) =$=!! p+ (Right (o' :=@= p'), Right IsMore) -> ((q F.$) =<< (o' =@=! p')) =$=!! p+ (Right (Yield ot), Right Await) -> (q F.$ ()) =$=!! (r F.$ ot)+ (Right (o' :=$= p'), Right Await) -> ((q F.$) =<< (o' =$=! p')) =$=!! p+ (Right (o' :=@= p'), Right Await) -> ((q F.$) =<< (o' =@=! p')) =$=!! p+ (Left u', _) -> U.weaken (Fn.mapT (=$=!! p) ((, p) . F.Pure) u') F.:>>=+ Q.singleton \case+ (F.Pure x, p') -> (q F.$ x) =$=!! p'+ (o', p'@(F.Pure _)) -> F.Pure ((q F.$) =<< o', p')+ _ -> error "never occur"++(=@=!) :: forall es i x o r r' . Fn.Tight (U.U es) =>+ Eff.E (P ': es) i x r -> Eff.E (P ': es) x o r' ->+ Eff.E (P ': es) i o (Eff.E (P ': es) i x r, Eff.E (P ': es) x o r')+o@(F.Pure _) =@=! p = F.Pure (o, p)+o@(u F.:>>= q) =@=! p@(F.Pure _) = case U.decomp u of+ Left u' -> U.weaken (Fn.mapT (=@=! p) ((, p) . F.Pure) u') F.:>>=+ Q.singleton \case+ (F.Pure x, p') -> (q F.$ x) =@=! p'+ (o', p'@(F.Pure _)) -> F.Pure ((q F.$) =<< o', p')+ _ -> error "never occur"+ Right (o' :=$= p') -> ((q F.$) =<< (o' =$=! p')) =@=! p+ Right (o' :=@= p') -> ((q F.$) =<< (o' =@=! p')) =@=! p+ Right (Yield _) -> F.Pure (o, p)+ Right IsMore ->+ U.injh (IsMore @_ @_ @o) F.:>>= Q.singleton ((=@=! p) F.. q)+ Right Await ->+ U.injh (Await @_ @_ @o) F.:>>= Q.singleton ((=@=! p) F.. q)+o@(u F.:>>= q) =@=! p@(v F.:>>= r) = case (U.decomp u, U.decomp v) of+ (Left u', _) -> U.weaken (Fn.mapT (=@=! p) ((, p) . F.Pure) u') F.:>>=+ Q.singleton \case+ (F.Pure x, p') -> (q F.$ x) =@=! p'+ (o', p'@(F.Pure _)) -> F.Pure ((q F.$) =<< o', p')+ _ -> error "never occur"+ (Right (o' :=$= p'), _) -> ((q F.$) =<< (o' =$=! p')) =@=! p+ (Right (o' :=@= p'), _) -> ((q F.$) =<< (o' =@=! p')) =@=! p+ (Right IsMore, _) ->+ U.injh (IsMore @_ @_ @o) F.:>>= Q.singleton ((=@=! p) F.. q)+ (Right Await, _) ->+ U.injh (Await @_ @_ @o) F.:>>= Q.singleton ((=@=! p) F.. q)+ (_, Right (Yield ot)) ->+ U.injh (Yield @_ @i ot) F.:>>= Q.singleton ((o =@=!) F.. r)+ (Right (Yield _), Right IsMore) -> o =@=! (r F.$ True)+ (Right (Yield ot), Right Await) -> (q F.$ ()) =@=! (r F.$ ot)+ (_, Right (o' :=$= p')) -> o =@=! ((r F.$) =<< (o' =$=! p'))+ (_, Right (o' :=@= p')) -> o =@=! ((r F.$) =<< (o' =@=! p'))+ (_, Left v') -> U.weaken (Fn.mapT (o =$=!) ((o ,) . F.Pure) v') F.:>>=+ Q.singleton \case+ (o', F.Pure y) -> o' =@=! (r F.$ y)+ (o'@(F.Pure _), p') -> F.Pure (o', (r F.$) =<< p')+ _ -> error "never occur"
+ src/Control/Monad/Yaftee/Pipe/IO.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.IO where++import Foreign.Ptr+import Foreign.Storable+import Prelude hiding (print)+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Except qualified as Except+import Control.Monad.Yaftee.IO qualified as IO+import Control.HigherOpenUnion qualified as U+import Data.Bool+import System.IO++print :: forall es i o r .+ (Show i, U.Member Pipe.P es, U.Base IO.I es) => Eff.E es i o r+print = fix \go -> Pipe.await >>= (>> go) . IO.print++print' :: forall es i o .+ (Show i, U.Member Pipe.P es, U.Base IO.I es) => Eff.E es i o ()+print' = fix \go ->+ Pipe.isMore >>= bool (pure ()) (Pipe.await >>= (>> go) . IO.print)++debugPrint :: forall es x r .+ (Show x, U.Member Pipe.P es, U.Base IO.I es) => Eff.E es x x r+debugPrint = fix \go -> Pipe.await >>= \x -> IO.print x >> Pipe.yield x >> go++debugPrint' :: forall es x .+ (Show x, U.Member Pipe.P es, U.Base IO.I es) => Eff.E es x x ()+debugPrint' = fix \go -> Pipe.awaitMaybe >>=+ maybe (pure ()) (\x -> IO.print x >> Pipe.yield x >> go)++hPutStorable :: forall es a o r .+ (Storable a, U.Member Pipe.P es, U.Base IO.I es) =>+ Handle -> Ptr a -> Eff.E es a o r+hPutStorable h p = fix \go -> Pipe.await >>= \x ->+ Eff.effBase (poke p x >> hPutBuf h p (sizeOf x)) >> go++hGetStorable :: forall es i a . (+ Storable a, U.Member Pipe.P es,+ U.Member (Except.E String) es, U.Base IO.I es ) =>+ Handle -> Ptr a -> Eff.E es i a ()+hGetStorable h p = fix \go -> do+ rsz <- Eff.effBase $ hGetBuf h p sz+ case rsz of+ 0 -> pure ()+ _ | rsz < sz ->+ Except.throw "hGetStorable: Not enough input"+ | rsz == sz -> do+ Pipe.yield =<< Eff.effBase (peek p)+ go+ | otherwise -> Except.throw "never occur"+ where sz = sizeOf (undefined :: a)++hGetLines ::+ (U.Member Pipe.P es, U.Base IO.I es) => Handle -> Eff.E es i String ()+hGetLines h = do+ eof <- Eff.effBase $ hIsEOF h+ when (not eof) $+ (Pipe.yield =<< Eff.effBase (hGetLine h)) >> hGetLines h
+ src/Control/Monad/Yaftee/Pipe/List.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.List (+ from, to, bundle, bundle' ) where++import Control.Arrow+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.HigherFreer qualified as F+import Control.HigherOpenUnion qualified as U+import Data.Foldable+import Data.HigherFunctor qualified as Fn+import Data.Maybe+import Data.Bool++from :: forall f es i a .+ (Foldable f, U.Member Pipe.P es) => f a -> Eff.E es i a ()+from xs = Pipe.yield `traverse_` xs++to :: forall es i o o' r .+ Fn.Tight (U.U es) => Eff.E (Pipe.P ': es) i o r -> Eff.E es i o' [o]+to p = (fromJust <$>) . Pipe.run $ fromPure . snd <$> p Pipe.=$= fix \go ->+ Pipe.isMore >>= bool (pure []) ((:) <$> Pipe.await <*> go)++fromPure :: F.H h i o a -> a+fromPure = \case F.Pure x -> x; _ -> error "not Pure"++bundle :: U.Member Pipe.P es => Int -> Eff.E es a [a] r+bundle n = fix \go -> (Pipe.yield =<< replicateM n Pipe.await) >> go++bundle' :: U.Member Pipe.P es => Int -> Eff.E es a [a] ()+bundle' n = fix \go -> do+ (f, xs) <- replicateAwait n+ Pipe.yield xs+ bool go (pure ()) f++replicateAwait :: U.Member Pipe.P es => Int -> Eff.E es a o (Bool, [a])+replicateAwait = \case+ 0 -> pure (False, [])+ n -> Pipe.isMore >>= bool+ (pure (True, []))+ (Pipe.await >>= \x -> ((x :) `second`) <$> replicateAwait (n - 1))
+ src/Control/Monad/Yaftee/Pipe/Tools.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll, TypeApplications #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.Tools (++ -- * CONVERT++ convert, convert', convert'',++ -- * FILTER++ filter, filter',++ -- * EITHER++ checkRight, skipLeft1,++ -- * LENGTH++ lengthRun, length, Length,++ -- * SCAN++ scanl++ ) where++import Prelude hiding (length, filter, scanl)+import Prelude qualified as P+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.Except qualified as Except+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Bits+import Data.Bool++convert :: U.Member Pipe.P effs => (a -> b) -> Eff.E effs a b r+convert f = fix \go -> Pipe.await >>= ((>> go) . Pipe.yield . f)++convert' :: U.Member Pipe.P effs => (a -> b) -> Eff.E effs a b ()+convert' f = fix \go -> Pipe.isMore+ >>= bool (pure ()) (Pipe.await >>= ((>> go) . Pipe.yield . f))++convert'' :: U.Member Pipe.P es => (Bool -> a -> b) -> a -> Eff.E es a b ()+convert'' f = fix \go p -> Pipe.isMore >>= bool+ (Pipe.yield (f True p))+ (Pipe.await >>= \x -> ((>> go x) . Pipe.yield $ f False p))++filter :: U.Member Pipe.P es => (a -> Maybe b) -> Eff.E es a b r+filter f = fix \go -> Pipe.await >>= \x -> case f x of+ Nothing -> go+ Just y -> Pipe.yield y >> go++filter' :: U.Member Pipe.P es => (a -> Maybe b) -> Eff.E es a b ()+filter' f = fix \go -> Pipe.isMore+ >>= bool (pure ()) (Pipe.await >>= \x -> case f x of+ Nothing -> go+ Just y -> Pipe.yield y >> go)++checkRight :: (U.Member Pipe.P es, U.Member (Except.E String) es) =>+ Eff.E es (Either a b) b r+checkRight = fix \go -> Pipe.await >>= (>> go)+ . either (const $ Except.throw "(Left _) exist") (Pipe.yield)++skipLeft1 :: (U.Member Pipe.P es, U.Member (Except.E String) es) =>+ Eff.E es (Either a b) o b+skipLeft1 = Pipe.await >>= \case+ Left _ -> Pipe.await >>= \case+ Left _ -> Except.throw @String "Not Right"+ Right x -> pure x+ Right x -> pure x++lengthRun :: forall nm es i o a . HFunctor.Loose (U.U es) =>+ Eff.E (State.Named nm Length ': es) i o a -> Eff.E es i o (a, Length)+lengthRun = (`State.runN` (0 :: Length))++length :: forall nm -> (+ Foldable t,+ U.Member Pipe.P es, U.Member (State.Named nm Length) es ) =>+ Eff.E es (t a) (t a) r+length nm = forever $ Pipe.await >>= \s ->+ State.modifyN nm (+ Length (P.length s)) >> Pipe.yield s++newtype Length = Length { unLength :: Int }+ deriving (Show, Eq, Bits, FiniteBits, Ord, Enum, Num, Real, Integral)++scanl :: U.Member Pipe.P es => (b -> a -> b) -> b -> Eff.E es a b r+scanl op =+ fix \go v -> (v `op`) <$> Pipe.await >>= \v' -> Pipe.yield v' >> go v'
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ yaftee-conduit.cabal view
@@ -0,0 +1,69 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: yaftee-conduit+version: 0.1.0.0+synopsis: Conduit implemented on Yaftee+description: Please see the README on GitHub at <https://github.com/YoshikuniJujo/yaftee-conduit#readme>+category: Control+homepage: https://github.com/YoshikuniJujo/yaftee-conduit#readme+bug-reports: https://github.com/YoshikuniJujo/yaftee-conduit/issues+author: Yoshikuni Jujo+maintainer: yoshikuni.jujo@gmail.com+copyright: Copyright (c) 2025 Yoshikuni Jujo+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/YoshikuniJujo/yaftee-conduit++library+ exposed-modules:+ Control.Monad.Yaftee.Pipe+ Control.Monad.Yaftee.Pipe.IO+ Control.Monad.Yaftee.Pipe.List+ Control.Monad.Yaftee.Pipe.Tools+ other-modules:+ Paths_yaftee_conduit+ autogen-modules:+ Paths_yaftee_conduit+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ base >=4.7 && <5+ , ftcqueue ==0.1.*+ , higher-order-freer-monad ==0.1.*+ , higher-order-open-union ==0.1.*+ , yaftee ==0.1.*+ , yaftee-basic-monads ==0.1.*+ default-language: Haskell2010++test-suite yaftee-conduit-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_yaftee_conduit+ autogen-modules:+ Paths_yaftee_conduit+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , ftcqueue ==0.1.*+ , higher-order-freer-monad ==0.1.*+ , higher-order-open-union ==0.1.*+ , yaftee ==0.1.*+ , yaftee-basic-monads ==0.1.*+ , yaftee-conduit+ default-language: Haskell2010