diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ # Revision history for Churros -## 0.1.0.4 -- 2020-10-15 +## 0.1.2.0 -- 2020-10-15 + +* Added type families to transport class to allow for different in/out types +* Added support for unagi-chan +* Added support for bounded unagi-chan +* Updating documentation + +## 0.1.1.0 -- 2020-10-15 * Transport method `flex` now returns a pair of channels to move towards support for Unagi. * Addition of new prelude methods such as `sources`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,10 +2,26 @@ > Chan + Arrow = Churro -Simple alternative to Conduit, Pipes, Streams, Machines, etc. +Simple alternative to + [Conduit](https://hackage.haskell.org/package/conduit), + [Pipes](https://hackage.haskell.org/package/pipes), + [Streaming](https://hackage.haskell.org/package/streaming), + [Machines](https://hackage.haskell.org/package/machines), etc. Use-case is CSP like scenarios where you need a graph of actors. +Signup Example: + +``` +New-Users {-> ID} ---> Validate {ID -> (ID,Email} ?--> Deploy {Email -> Port} --?-> Log {Port|Receipt ->} +----------------- -------------------------- | ---------------------- | --------------------- + Subscribe REST Request | Run Server | Write File + | | + +--> Warn {Email -> Receipt} -+ + ----------------------- + Send Email +``` + Developed from a history of attempting to use co-routines libraries for setting up complicated asynchronous processes such as collections of MIDI instruments, etc, but being frustrated by not easily being able to conditionally consume and emit events. In these situations I'd fall back on creating a bunch of Chans and piping events manually. @@ -21,7 +37,7 @@ Disadvantages: * No pure interface! -* No expressive return type encoded in the Churro datatype (could this be addressed?) +* No expressive return type for the async action representing the background process is encoded in the Churro datatype (could this be addressed?) * Limited ability to perform lock-step computation (although this is by design) See [Hackage](https://hackage.haskell.org/package/churros-0.1.0.0/candidate) for more info! @@ -50,6 +66,13 @@ ## TODO +* [ ] Add seperate projects to allow minimal core and enciched ecosystem e.g. churros-unagi +* [ ] Create profunctor instance +* [ ] Create contravariant functor instance +* [ ] Create ArrowChoice instance +* [ ] Create ArrowLoop instance +* [ ] Different transports for sections of the graph +* [ ] Allow configurable parallelism / Pool Churro functions * [x] Recovery/Retry capability * [x] Fix await deadlock * [x] Generic Chan functions, then specific newtype @@ -57,14 +80,8 @@ * [x] Different transport options, buffered, etc. * [x] Write doctests for functionality * [x] Get Doctests working as part of the cabal test-suite -* [ ] Bundle in/out channels in the Transport class to allow Unagi to implement it -* [ ] Create profunctor instance -* [ ] Create contravariant functor instance -* [ ] Create ArrowChoice instance -* [ ] Create ArrowLoop instance +* [x] Bundle in/out channels in the Transport class to allow Unagi to implement it * [x] Allow returning of results from run functions * [x] Get haddocks rendering correctly - Including contents -* [ ] Different transports for sections of the graph -* [ ] Allow configurable parallelism * [x] Early termination if downstream consumer completes - [x] Ensure that infinite lists work when partially consumed diff --git a/churros.cabal b/churros.cabal --- a/churros.cabal +++ b/churros.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: churros -version: 0.1.1.0 +version: 0.1.2.0 license-file: LICENSE author: Lyndon Maydwell maintainer: lyndon@sordina.net @@ -29,7 +29,8 @@ async, stm, containers, - random + random, + unagi-chan library import: churros-dependencies @@ -40,6 +41,8 @@ Control.Churro.Prelude, Control.Churro.Transport, Control.Churro.Transport.Chan + Control.Churro.Transport.Unagi + Control.Churro.Transport.Unagi.Bounded test-suite churros-test import: churros-dependencies @@ -49,9 +52,11 @@ build-depends: doctest ghc-options: -threaded -rtsopts other-modules: - Control.Churro, - Control.Churro.Types, - Control.Churro.Prelude, - Control.Churro.Transport, - Control.Churro.Transport.Chan, + Control.Churro + Control.Churro.Types + Control.Churro.Prelude + Control.Churro.Transport + Control.Churro.Transport.Chan + Control.Churro.Transport.Unagi + Control.Churro.Transport.Unagi.Bounded Churro.Test.Examples diff --git a/src/Control/Churro/Prelude.hs b/src/Control/Churro/Prelude.hs --- a/src/Control/Churro/Prelude.hs +++ b/src/Control/Churro/Prelude.hs @@ -336,13 +336,13 @@ -- -- Also polymorphic over exception type. And forwards errors. -- -processRetry'' :: (Exception e, Transport t) => Natural -> (a -> IO o) -> Churro t (Natural, a) (Either e o) +processRetry'' :: (Transport t, Exception e, Ord n, Enum n) => n -> (a -> IO b) -> Churro t (n, a) (Either e b) processRetry'' retries f = - buildChurro \i o -> do - yankAll i \(n, y) -> do + buildChurro' \i' o i -> do + yankAll o \(n, y) -> do r <- try do f y - yeet o (Just r) + yeet i (Just r) case r of Right _ -> return () - Left _ -> when (n < retries) do yeet i (Just (succ n, y)) - yeet o Nothing + Left _ -> when (n < retries) do yeet i' (Just (succ n, y)) + yeet i Nothing diff --git a/src/Control/Churro/Transport.hs b/src/Control/Churro/Transport.hs --- a/src/Control/Churro/Transport.hs +++ b/src/Control/Churro/Transport.hs @@ -17,10 +17,11 @@ -- | Write a list to a raw Transport. -- +-- >>> :set -XTypeApplications -- >>> import Control.Concurrent.Chan -- >>> :{ -- do --- (i,o) <- flex :: IO (TransportChan (Maybe Int)) +-- (i,o) <- flex @Chan -- l2c i (map Just [1,2] ++ [Nothing]) -- yankAll' o print -- :} @@ -29,5 +30,5 @@ -- Just Nothing -- Nothing -- -l2c :: Transport t => t (Maybe a) -> [a] -> IO () +l2c :: (Foldable f, Transport t) => In t (Maybe a) -> f a -> IO () l2c c l = mapM_ (yeet c . Just) l >> yeet c Nothing diff --git a/src/Control/Churro/Transport/Chan.hs b/src/Control/Churro/Transport/Chan.hs --- a/src/Control/Churro/Transport/Chan.hs +++ b/src/Control/Churro/Transport/Chan.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE BlockArguments #-} @@ -12,14 +13,15 @@ import Data.Void instance Transport Chan where - yank = readChan - yeet = writeChan + data In Chan a = ChanIn (Chan a) + data Out Chan a = ChanOut (Chan a) + yank (ChanOut c) = readChan c + yeet (ChanIn c) = writeChan c flex = do c <- newChan - return (c,c) + return (ChanIn c, ChanOut c) -type ChurroChan = Churro Chan -type TransportChan a = (Chan (Maybe a), Chan (Maybe a)) +type ChurroChan = Churro Chan -- | Convenience function for running a Churro with a Chan Transport. -- diff --git a/src/Control/Churro/Transport/Unagi.hs b/src/Control/Churro/Transport/Unagi.hs new file mode 100644 --- /dev/null +++ b/src/Control/Churro/Transport/Unagi.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BlockArguments #-} + +-- | Chan Transport Instance. + +module Control.Churro.Transport.Unagi where + +import Control.Churro.Types +import Control.Churro.Prelude + +import Control.Concurrent.Chan.Unagi +import Data.Void + +data Unagi a + +instance Transport Unagi where + data In Unagi a = ChanIn (InChan a) + data Out Unagi a = ChanOut (OutChan a) + yank (ChanOut c) = readChan c + yeet (ChanIn c) = writeChan c + flex = do + (i, o) <- newChan + return (ChanIn i, ChanOut o) + +type ChurroUnagi = Churro Unagi + +-- | Convenience function for running a Churro with an Unagi Transport. +-- +runWaitUnagi :: ChurroUnagi Void Void -> IO () +runWaitUnagi = runWait + +-- | Convenience function for running a Churro into a List with an Unagi Transport. +-- +runWaitListUnagi :: ChurroUnagi Void o -> IO [o] +runWaitListUnagi = runWaitList diff --git a/src/Control/Churro/Transport/Unagi/Bounded.hs b/src/Control/Churro/Transport/Unagi/Bounded.hs new file mode 100644 --- /dev/null +++ b/src/Control/Churro/Transport/Unagi/Bounded.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Unagi-Chan Bounded Transport Instance. +-- +-- This makes use of a KnownNat parameter to specify the size of the buffer. +-- +module Control.Churro.Transport.Unagi.Bounded where + +import Control.Churro.Types +import Control.Churro.Prelude + +import Control.Concurrent.Chan.Unagi.Bounded +import Data.Void +import Data.Data (Proxy(..)) +import GHC.TypeLits (KnownNat, natVal) + +-- $setup +-- +-- Test Setup +-- +-- >>> :set -XDataKinds +-- >>> import Control.Churro + +data UnagiBounded n a + +instance KnownNat n => Transport (UnagiBounded n) where + data In (UnagiBounded n) a = ChanIn (InChan a) + data Out (UnagiBounded n) a = ChanOut (OutChan a) + yank (ChanOut c) = readChan c + yeet (ChanIn c) = writeChan c + flex = do + (i, o) <- newChan (fromIntegral (natVal (Proxy :: Proxy n))) + return (ChanIn i, ChanOut o) + +type ChurroUnagiBounded n = Churro (UnagiBounded n) + +-- | Convenience function for running a Churro with a Bounded Unagi-Chan Transport. +-- +runWaitUnagi :: KnownNat n => ChurroUnagiBounded n Void Void -> IO () +runWaitUnagi = runWait + +-- | Convenience function for running a Churro into a List with a Bounded Unagi-Chan Transport. +-- +-- >>> runWaitListUnagi @10 $ sourceList [1,2,3] >>> arr succ +-- [2,3,4] +runWaitListUnagi :: KnownNat n => ChurroUnagiBounded n Void o -> IO [o] +runWaitListUnagi = runWaitList diff --git a/src/Control/Churro/Types.hs b/src/Control/Churro/Types.hs --- a/src/Control/Churro/Types.hs +++ b/src/Control/Churro/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE BlockArguments #-} @@ -29,11 +30,16 @@ -- -- The items on transports are wrapped in `Maybe` to allow signalling of completion of a source. -- --- When building a program by composing Churros, the output Transport of one Churro is fed into the input Transports of other Churros. +-- When building a program by composing Churros, the output Transport of one +-- Churro is fed into the input Transports of other Churros. -- --- Convenience types of `Source`, `Sink`, and `DoubleDipped` are also defined, although use is not required. +-- Type families are used to allow the in/out channels to have different types +-- and prevent accidentally reading/writing from the wrong transport. -- -data Churro t i o = Churro { runChurro :: IO (t (Maybe i), t (Maybe o), Async ()) } +-- Convenience types of `Source`, `Sink`, and `DoubleDipped` are also defined, +-- although use is not required. +-- +data Churro t i o = Churro { runChurro :: IO (In t (Maybe i), Out t (Maybe o), Async ()) } type Source t o = Churro t Void o type Sink t i = Churro t i Void type DoubleDipped t = Churro t Void Void @@ -48,17 +54,21 @@ -- * Unagi -- * Various buffered options -- --- Transports used in conjunction with Churros wrap items in Maybe so that once a source has been depleted it can signal completion with --- a Nothing item. +-- Transports used in conjunction with Churros wrap items in Maybe so that once +-- a source has been depleted it can signal completion with a Nothing item. -- --- The flex method returns two transports, so that channels such as unagi that create an in/outs pair can have a Transport instance. +-- The flex method returns two transports, so that channels such as unagi that +-- create an in/outs pair can have a Transport instance. -- --- Channels like Chan that have a single channel act as in/out simply reuse the same channel in the pair returned. +-- Channels like Chan that have a single channel act as in/out simply reuse the +-- same channel in the pair returned. -- -class Transport t where - flex :: IO (t a, t a) -- ^ Create a new pair of transports. - yank :: t a -> IO a -- ^ Yank an item of the Transport - yeet :: t a -> a -> IO () -- ^ Yeet an item onto the Transport +class Transport (t :: * -> *) where + data In t :: * -> * + data Out t :: * -> * + flex :: IO (In t a, Out t a) -- ^ Create a new pair of transports. + yank :: Out t a -> IO a -- ^ Yank an item of the Transport + yeet :: In t a -> a -> IO () -- ^ Yeet an item onto the Transport -- | Covariant functor instance for Churro - Maps over the output. -- @@ -197,23 +207,34 @@ -- -- The manipulations performed are carried out in the async action associated with the Churro -- -buildChurro :: Transport t => (t (Maybe i) -> t (Maybe o) -> IO ()) -> Churro t i o +buildChurro :: Transport t => (Out t (Maybe i) -> In t (Maybe o) -> IO ()) -> Churro t i o buildChurro cb = Churro do (ai,ao) <- flex (bi,bo) <- flex - a <- async do cb ao bi + a <- async do cb ao bi return (ai,bo,a) +-- | A version of `buildChurro` that also passes the original input to the callback so that you can reschedule items. +-- +-- Used by "retry" style functions. +-- +buildChurro' :: Transport t => (In t (Maybe i) -> Out t (Maybe i) -> In t (Maybe o) -> IO ()) -> Churro t i o +buildChurro' cb = Churro do + (ai,ao) <- flex + (bi,bo) <- flex + a <- async do cb ai ao bi + return (ai,bo,a) + -- | Yeet all items from a list into a transport. -- -yeetList :: (Foldable t1, Transport t2) => t2 a -> t1 a -> IO () +yeetList :: (Foldable f, Transport t) => In t a -> f a -> IO () yeetList t = mapM_ (yeet t) -- | Yank all items from a Raw transport into a list. -- -- Won't terminate until the transport has been consumed. -- -yankList :: Transport t => t (Maybe a) -> IO [a] +yankList :: Transport t => Out t (Maybe a) -> IO [a] yankList t = do x <- yank t case x of @@ -222,7 +243,7 @@ -- | Yank each item from a transport into a callback. -- -yankAll :: Transport t => t (Maybe i) -> (i -> IO a) -> IO () +yankAll :: Transport t => Out t (Maybe i) -> (i -> IO a) -> IO () yankAll c f = do x <- yank c case x of @@ -233,7 +254,7 @@ -- -- The items are wrapped in Maybes and when all items are yanked, Nothing is fed to the callback. -- -yankAll' :: Transport t => t (Maybe a) -> (Maybe a -> IO b) -> IO b +yankAll' :: Transport t => Out t (Maybe a) -> (Maybe a -> IO b) -> IO b yankAll' c f = do yankAll c (f . Just) f Nothing @@ -242,8 +263,8 @@ -- -- Raw items are used so `Nothing` should be Yeeted once the transport is depleted. -- -c2c :: Transport t => (i -> o) -> t (Maybe i) -> t (Maybe o) -> IO () -c2c f i o = yankAll' i (yeet o . fmap f) +c2c :: Transport t => (a -> b) -> Out t (Maybe a) -> In t (Maybe b) -> IO () +c2c f o i = yankAll' o (yeet i . fmap f) -- | Flipped `finally`. finally' :: IO b -> IO a -> IO a diff --git a/test/Churro/Test/Main.hs b/test/Churro/Test/Main.hs --- a/test/Churro/Test/Main.hs +++ b/test/Churro/Test/Main.hs @@ -9,6 +9,10 @@ -- TODO: Find out how to use a different test manager to allow these to be run independently main :: IO () main = do - doctest ["-isrc", "test/Churro/Test/Examples.hs"] - -- Ex.main + doctest + [ "-isrc" + , "-itest" + , "test/Churro/Test/Examples.hs" + , "src/Control/Churro/Transport/Unagi/Bounded.hs" + ]