box 0.5.0 → 0.6.0

raw patch · 10 files changed

+123/−156 lines, 10 filesdep −foldldep −streamingdep ~numhaskPVP ok

version bump matches the API change (PVP)

Dependencies removed: foldl, streaming

Dependency ranges changed: numhask

API changes (from Hackage documentation)

Files

• app/concurrency-tests.hs +1/−8
• box.cabal +5/−10
• readme.md +1/−1
• src/Box.hs +10/−25
• src/Box/Box.hs +44/−1
• src/Box/Connectors.hs +11/−0
• src/Box/Emitter.hs +37/−0
• src/Box/Time.hs +13/−13
• src/Box/Transducer.hs +0/−97
• stack.yaml +1/−1

@@ -21,7 +21,6 @@ import Control.Lens import Control.Monad.Conc.Class as C import NumHask.Prelude hiding (STM)-import qualified Streaming.Prelude as S import System.Random import Test.DejaFu hiding (get) import Test.DejaFu.Types@@ -64,10 +63,6 @@ tPureState n =   runIdentity $ fmap (reverse . fst) $ flip execStateT ([], [1 .. n]) $ glue (hoist (zoom _1) stateC) (hoist (zoom _2) stateE) --- tPureBoxF :: (Monad m) => (Box m Int Int -> m ()) -> Int -> m [Int]--- > tPureBoxF (etc' () (Transducer id))--- > tPureBoxF (fuse (pure . pure))--- > tPureBoxF (\(Box c e) -> glue c e) tPureBoxF f n =   fmap (reverse . fst) $ flip execStateT ([], [1 .. n]) $ f (Box (hoist (zoom _1) stateC) (hoist (zoom _2) stateE)) @@ -98,9 +93,7 @@             tToList_ n,             tFromList_' n,             pure (tPureState n),-            tPureBoxF (etc () (Transducer id)) n,             tPureBoxF (fuse (pure . pure)) n,             tPureBoxF (\(Box c e) -> glue c e) n,-            (\(a, b) -> a <> b) <$> (tForkEmit <$.> (fromListE [1 .. n])),-            (\(a, b) -> a <> b) <$> (tForkEmit <$.> (toEmitter (S.take 4 $ S.each [1 ..])))+            (\(a, b) -> a <> b) <$> (tForkEmit <$.> (fromListE [1 .. n]))           ]

@@ -1,6 +1,6 @@ cabal-version:  2.4 name:           box-version:        0.5.0+version:        0.6.0 synopsis:       boxes description:    concurrent, effectful boxes category:       project@@ -31,7 +31,6 @@     Box.IO     Box.Queue     Box.Time-    Box.Transducer   hs-source-dirs:     src   default-extensions:@@ -53,12 +52,10 @@     concurrency >= 1.11,     contravariant >= 1.5,     exceptions >= 0.10,-    foldl >= 1.4,     lens >= 4.19,     mmorph >= 1.1,-    numhask >= 0.6,+    numhask >= 0.6 && < 0.7,     profunctors >= 5.5,-    streaming >= 0.2,     text >= 1.2,     time >= 1.9,     transformers >= 0.5,@@ -76,9 +73,8 @@     dejafu >= 2.3,     generic-lens >= 2.0,     lens >= 4.19,-    numhask >= 0.6,+    numhask >= 0.6 && < 0.7,     random >= 1.1,-    streaming >= 0.2,     text >= 1.2,     transformers >= 0.5   default-language: Haskell2010@@ -112,9 +108,8 @@     generic-lens >= 2.0,     lens >= 4.19,     mtl >= 2.2,-    numhask >= 0.6,+    numhask >= 0.6 && < 0.7,     optparse-generic >= 1.3.0 && < 1.4,-    streaming >= 0.2,     text >= 1.2,     transformers >= 0.5,     websockets >= 0.12@@ -141,7 +136,7 @@     base >=4.7 && <5,     box,     doctest >= 0.16,-    numhask >= 0.6,+    numhask >= 0.6 && < 0.7,   default-language: Haskell2010   default-extensions:     NegativeLiterals

@@ -37,7 +37,7 @@  A `Box m c e` unifies the functorial wrapper `m` of the emitter and committer, which is what really makes it a functional box. Boxes can often be hooked together at this level for useful efficiencies. -A Box is also a [profunctor](https://bartoszmilewski.com/2019/03/27/promonads-arrows-and-einstein-notation-for-profunctors/) and, to quote Bartos, a profunctor can be used to glue together two categories. A Box.Transducer, a stateful stream converter with a Category instance, can be used to connect up a box to create a sound compositional building block for arbitrarily complex problems.+A Box is also a [profunctor](https://bartoszmilewski.com/2019/03/27/promonads-arrows-and-einstein-notation-for-profunctors/) and, to quote Bartos, a profunctor can be used to glue together two categories.  Like other paradigms, boxes can be not fun places to get stuck in.  Much of the library are not, in fact, emitters and committers but emitter, committer and box continuations. If you gave me something that takes a box and does something, then I'll give you a something is a natural piece of logic within the library context, and so large parts of the functionality are [continuation-parsing style](https://ro-che.info/articles/2019-06-07-why-use-contt). 

@@ -26,7 +26,6 @@     module Box.IO,     module Box.Queue,     module Box.Time,-    module Box.Transducer,   ) where @@ -38,7 +37,6 @@ import Box.IO import Box.Queue import Box.Time-import Box.Transducer  {- $setup >>> :set -XOverloadedStrings@@ -49,7 +47,6 @@ >>> import qualified Prelude as P >>> import Data.Functor.Contravariant >>> import Box->>> import qualified Streaming.Prelude as S >>> import Control.Monad.Conc.Class as C >>> import Control.Lens -}@@ -72,10 +69,10 @@  {- $boxes -The basic ways of connecting up a box are all related as follows:+The two basic ways of connecting up a box are related as follows:  > glue c e == glueb (Box c e)-> glueb == fuse (pure . pure) == etc () (Transducer id)+> glueb == fuse (pure . pure)  >>> fromToList_ [1..3] glueb [1,2,3]@@ -83,9 +80,6 @@ >>> fromToList_ [1..3] (fuse (pure . pure)) [1,2,3] ->>> fromToList_ [1..3] (etc () (Transducer id))-[1,2,3]- 1. glue: direct fusion of committer and emitter  >>> runCont $ glue <$> pure toStdout <*> fromListE (show <$> [1..3])@@ -123,23 +117,6 @@ echo: 1 echo: 3 -3. Transduction--For complicated branching and layering, the library provides an API into the streaming library, via 'etc'.-->>> :t etc-etc :: Monad m => s -> Transducer s a b -> Box m b a -> m s--A 'Transducer' is a pure, stateful stream to stream transformation that is highly composable, abstraction leakage-proof and has a category instance.--'etc' stands for emit -> transduce -> commit, and can be considered a distant relative of the model-view-controller abstraction.-->>> let transducer' = Transducer $ \s -> s & S.takeWhile (/="3") & S.chain (const (modify (+1))) & S.map ("echo: " <>)->>> etc 0 transducer' <$.> box'-echo: 1-echo: 2-2- -}  {- $commit@@ -252,6 +229,14 @@ ... 💁 ∞++Use glueN to create a finite computation.++>>> glueN 4 <$> pure (contramap show toStdout) <*.> fromListE [1..]+1+2+3+4  -} 

@@ -13,9 +13,12 @@     bmap,     hoistb,     glue,+    glue_,     glueb,     fuse,     dotb,+    Divap(..),+    DecAlt(..),   ) where @@ -24,6 +27,7 @@ import Data.Functor.Contravariant import Data.Profunctor import NumHask.Prelude+import Data.Functor.Contravariant.Divisible  -- | A Box is a product of a Committer m and an Emitter. Think of a box with an incoming wire and an outgoing wire. Now notice that the abstraction is reversable: are you looking at two wires from "inside a box"; a blind erlang grunt communicating with the outside world via the two thin wires, or are you looking from "outside the box"; interacting with a black box object. Either way, it's a box. -- And either way, the committer is contravariant and the emitter covariant so it forms a profunctor.@@ -74,12 +78,51 @@       c' <- maybe (pure False) (commit c) a       when c' go +-- | Connect an emitter directly to a committer of the same type.+--+-- The monadic action returns if the committer returns False.+glue_ :: (Monad m) => Committer m a -> Emitter m a -> m ()+glue_ c e = go+  where+    go = do+      a <- emit e+      case a of+        Nothing -> go+        Just a' -> do+          b <- commit c a'+          case b of+            True -> go+            False -> pure ()+ -- | Short-circuit a homophonuos box. glueb :: (Monad m) => Box m a a -> m () glueb (Box c e) = glue c e  -- | fuse a box ----- > fuse (pure . pure) == glueb == etc () (Transducer id)+-- > fuse (pure . pure) == glueb  fuse :: (Monad m) => (a -> m (Maybe b)) -> Box m b a -> m () fuse f (Box c e) = glue c (mapE f e)++-- combines 'divide'/'conquer' and 'liftA2'/'pure'+class Divap p where+    divap :: (a -> (b, c)) -> ((d, e) -> f) -> p b d -> p c e -> p a f+    conpur :: a -> p b a++class Profunctor p => DecAlt p where+    choice :: (a -> Either b c) -> (Either d e -> f) -> p b d -> p c e -> p a f+    loss :: p Void b++instance (Applicative m) => Divap (Box m) where+  divap split merge (Box lc le) (Box rc re) = Box (divide split lc rc) (liftA2 (curry merge) le re)++  conpur a = Box conquer (pure a)++instance (Monad m, Alternative m) => DecAlt (Box m) where+  choice split merge (Box lc le) (Box rc re) =+    Box (choose split lc rc) (fmap merge $ (fmap Left le) <|> (fmap Right re))+  loss = Box (lose absurd) empty++++

@@ -22,6 +22,7 @@     queueEmitter,     concurrentE,     concurrentC,+    glueN,   ) where @@ -60,6 +61,16 @@ -- > toList_ == toListE toList_ :: (Monad m) => Emitter m a -> m [a] toList_ e = reverse <$> flip execStateT [] (glue stateC (hoist lift e))++-- | Glues a committer and emitter, taking n emits+--+-- >>> glueN 4 <$> pure (contramap show toStdout) <*.> fromListE [1..]+-- 1+-- 2+-- 3+-- 4+glueN :: Monad m => Int -> Committer m a -> Emitter m a -> m ()+glueN n c e = flip evalStateT 0 $ glue (hoist lift c) (takeE n e)  -- | take a list, emit it through a box, and output the committed result. --

@@ -23,6 +23,9 @@     toListE,     unlistE,     stateE,+    takeE,+    takeUntilE,+    filterE,   ) where @@ -190,3 +193,37 @@         (x : xs') -> do           put xs'           pure (Just x)++takeE :: (Monad m) => Int -> Emitter m a -> Emitter (StateT Int m) a+takeE n e = Emitter $ do+  x <- emit (hoist lift e)+  case x of+    Nothing -> pure Nothing+    Just x' -> do+      n' <- get+      bool (pure Nothing) (emit' n') (n' < n)+        where+          emit' n' = do+            put (n'+1)+            pure $ Just x'++-- | Take from an emitter until predicate+takeUntilE :: (Monad m) => (a -> Bool) -> Emitter m a -> Emitter m a+takeUntilE p e = Emitter $ do+  x <- emit e+  case x of+    Nothing -> pure Nothing+    Just x' ->+      bool (pure (Just x')) (pure Nothing) (p x')++-- | Filter emissions according to a predicate.+filterE :: (Monad m) => (a -> Bool) -> Emitter m a -> Emitter m a+filterE p e = Emitter go+  where+    go = do+      x <- emit e+      case x of+        Nothing -> pure Nothing+        Just x' ->+          bool go (pure (Just x')) (p x')+

@@ -59,45 +59,45 @@   deriving (Eq, Show, Read)  -- | Add the current time-stampNow :: (MonadConc m, MonadIO m) => a -> m (Stamped a)+stampNow :: (MonadConc m, MonadIO m) => a -> m (LocalTime, a) stampNow a = do   t <- liftIO getCurrentTime-  pure $ Stamped t a+  pure $ (utcToLocalTime utc t, a)  -- | adding a time stamp stampE ::   (MonadConc m, MonadIO m) =>   Emitter m a ->-  Emitter m (Stamped a)-stampE e = mapE (fmap Just . stampNow) e+  Emitter m ((LocalTime, a))+stampE e = mapE (\x -> Just <$> stampNow x) e  -- | wait until Stamped time before emitting emitOn ::-  Emitter IO (Stamped a) ->+  Emitter IO (LocalTime, a) ->   Emitter IO a emitOn e =   mapE-    ( \(Stamped u a) -> do-        sleepUntil u+    ( \((l, a)) -> do+        sleepUntil (localTimeToUTC utc l)         pure $ Just a     )     e  -- | reset the emitter stamps to by in sync with the current time and adjust the speed -- >>> let e1 = fromListE (zipWith (\x a -> Stamped (addUTCTime (fromDouble x) t) a) [0..5] [0..5])-playback :: Double -> Emitter IO (Stamped a) -> IO (Emitter IO (Stamped a))+playback :: Double -> Emitter IO (LocalTime, a) -> IO (Emitter IO (LocalTime, a)) playback speed e = do   r <- emit e   case r of     Nothing -> pure mempty-    Just (Stamped u0 _) -> do+    Just (l0, _) -> do       t0 <- getCurrentTime-      let ua = diffUTCTime t0 u0-      let delta u = addUTCTime ua $ addUTCTime (fromDouble ((toDouble $ diffUTCTime u u0) * speed)) u0-      pure (mapE (\(Stamped u a) -> pure (Just (Stamped (delta u) a))) e)+      let ua = diffLocalTime (utcToLocalTime utc t0) l0+      let delta u = addLocalTime ua $ addLocalTime (fromDouble ((toDouble $ diffLocalTime u l0) * speed)) l0+      pure (mapE (\((l, a)) -> pure (Just ((delta l), a))) e)  -- | simulate a delay from a (Stamped a) Emitter relative to the first timestamp-simulate :: Double -> Emitter IO (Stamped a) -> Cont IO (Emitter IO a)+simulate :: Double -> Emitter IO (LocalTime, a) -> Cont IO (Emitter IO a) simulate speed e = Cont $ \eaction -> do   e' <- playback speed e   eaction (emitOn e')

@@ -1,97 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- | `transduce`-module Box.Transducer-  ( Transducer (..),-    etc,-    toCommitter,-    toEmitter,-    toStream,-    fromStream,-    foldCommitter,-    sinkCommitter,-  )-where--import Box.Box-import Box.Committer-import Box.Cont-import Box.Emitter-import Box.Queue-import qualified Control.Foldl as L-import Control.Lens hiding ((.>), (:>), (<|), (|>))-import Control.Monad.Conc.Class as C-import NumHask.Prelude hiding (STM, atomically)-import Streaming (Of (..), Stream)-import qualified Streaming.Prelude as S---- | transduction--- [wiki](https://en.wikipedia.org/wiki/Transducer) says: "A transducer is a device that converts energy from one form to another." Translated to context, this Transducer converts a stream of type a to a stream of a different type.-newtype Transducer s a b-  = Transducer-      { transduce ::-          forall m.-          Monad m =>-          Stream (Of a) (StateT s m) () ->-          Stream (Of b) (StateT s m) ()-      }--instance Category (Transducer s) where-  (Transducer t1) . (Transducer t2) = Transducer (t1 . t2)--  id = Transducer id---- | emit - transduce - commit------ with etc, you're in the box, and inside the box, there are no effects: just a stream of a's, pure functions and state tracking. It's a nice way to code, and very friendly for the compiler. When the committing and emitting is done, the box collapses to state.------ The combination of an input tape, an output tape, and a state-based stream computation lends itself to the etc computation as a [finite-state transducer](https://en.wikipedia.org/wiki/Finite-state_transducer) or mealy machine.-etc :: Monad m => s -> Transducer s a b -> Box m b a -> m s-etc st t (Box c e) =-  (e & hoist lift & toStream & transduce t & fromStream) (hoist lift c) & flip execStateT st---- | create an committer from a stream continuation-toCommitter :: (MonadConc m) => (Stream (Of a) m () -> m r) -> Cont m (Committer m a)-toCommitter f =-  Cont (\c -> queueC c (\(Emitter o) -> f . toStream . Emitter $ o))---- | create an emitter from a stream-toEmitter :: (MonadConc m) => Stream (Of b) m () -> Cont m (Emitter m b)-toEmitter s = Cont (queueE (fromStream s))---- | turn an emitter into a stream-toStream :: (Monad m) => Emitter m a -> Stream (Of a) m ()-toStream e = S.untilRight getNext-  where-    getNext = maybe (Right ()) Left <$> emit e---- | turn a stream into a committer-fromStream :: (Monad m) => Stream (Of b) m () -> Committer m b -> m ()-fromStream s c = go s-  where-    go str = do-      eNxt <- S.next str -- uncons requires r ~ ()-      forM_ eNxt $ \(a, str') -> do-        continue <- commit c a-        when continue (go str')---- | create a committer from a fold-foldCommitter :: (MonadConc m) => L.FoldM m a () -> Cont m (Committer m a)-foldCommitter f = toCommitter (fmap S.snd' . L.impurely S.foldM f)---- | create a committer from a sink-sinkCommitter :: (MonadConc m) => (a -> m ()) -> Cont m (Committer m a)-sinkCommitter sink = foldCommitter (L.FoldM step begin done)-  where-    step x a = do-      sink a-      pure x-    begin = pure ()-    done = pure

@@ -4,5 +4,5 @@   - .  extra-deps:-  - numhask-0.6.0+  - numhask-0.6.0.2