objective 0.6.5 → 0.6.5.1

raw patch · 12 files changed

+428/−413 lines, 12 filesdep ~extensible

Dependency ranges changed: extensible

Files

• CHANGELOG.md +69/−64
• objective.cabal +52/−52
• src/Control/Monad/Objective.hs +6/−6
• src/Control/Monad/Objective/Class.hs +81/−74
• src/Control/Monad/Objective/IO.hs +34/−34
• src/Control/Monad/Objective/ST.hs +36/−36
• src/Control/Object.hs +33/−33
• src/Control/Object/Extra.hs +3/−3
• src/Control/Object/Mortal.hs +3/−0
• src/Control/Object/Object.hs +2/−2
• src/Data/Functor/PushPull.hs +60/−60
• src/Data/Functor/Request.hs +49/−49

@@ -1,64 +1,69 @@-0.6.5
-----
-* Supported `elevator >= 0.2`.
-
-0.6.3.1
-----
-* Reverted the fixity.
-
-0.6.3
-----
-* Added `Variable`, an alias for `variable` objects.
-* Added `Mortal`.
-* Increased fixity of invocation operators to 5.
-* Added stream connection operators.
-* Added `transit` and `animate`.
-
-0.6.2
-----
-* Added `announce`, `announceMaybe` and `announceMaybeT` which invoke a method for every objects in a container.
-* Added `(@**@)` and `(@||@)`.
-* Renamed `(.>>.)` to `(@>>@)`, `.|>.` to `(@|>@)` for consistency.
-* Added `filterPush`, `bipush`, `bipull`.
-* Added `iterObject`, `iterTObject`, `iterative`, `iterativeT` for free monads.
-* Renamed `runSequential` to `(@!)`.
-* Added combinators for `ReifiedProgramT`: `(@!!)` and `sequentialT`.
-* Changed the semantics of `variable` to accept `StateT`.
-* Added `flyweight'` that relies on HashMap.
-* Added `MonadObjective` constraint
-
-0.6.1
------
-* Fixed the wrong constraints of `request`
-
-0.6
------
-* `PushPull` has more `Floors`
-* Added `Applicative` instance for `Request`
-* Reformed around Control.Monad.Objective
-  * Instance f g m ==> Inst m f g
-  * `invoke` takes two transformations for lifting
-  * Added lifted versions of `new`: `newIO` and `newST`
-
-0.5.2
------
-* Added Process
-* Added `runSequential`, `sequential` for operational monad
-* Added `flyweight`
-
-0.5.1
------
-* Added PushPull functor
-* Removed `sequential`
-
-0.5
------
-* Lift has gone
-* Use elevator instead of Lift
-* Moved Request to a separate module
-
-0.4
------
-* Added Request functor along with Lift
-* Supported "extensible" objects using open unions
-* AccessT is now obsolete
+0.6.5.1+----+* Added `MonadTrans` instance for `Mortal`.+* Added `newSettle`.++0.6.5+----+* Supported `elevator >= 0.2`.++0.6.3.1+----+* Reverted the fixity.++0.6.3+----+* Added `Variable`, an alias for `variable` objects.+* Added `Mortal`.+* Increased fixity of invocation operators to 5.+* Added stream connection operators.+* Added `transit` and `animate`.++0.6.2+----+* Added `announce`, `announceMaybe` and `announceMaybeT` which invoke a method for every objects in a container.+* Added `(@**@)` and `(@||@)`.+* Renamed `(.>>.)` to `(@>>@)`, `.|>.` to `(@|>@)` for consistency.+* Added `filterPush`, `bipush`, `bipull`.+* Added `iterObject`, `iterTObject`, `iterative`, `iterativeT` for free monads.+* Renamed `runSequential` to `(@!)`.+* Added combinators for `ReifiedProgramT`: `(@!!)` and `sequentialT`.+* Changed the semantics of `variable` to accept `StateT`.+* Added `flyweight'` that relies on HashMap.+* Added `MonadObjective` constraint++0.6.1+-----+* Fixed the wrong constraints of `request`++0.6+-----+* `PushPull` has more `Floors`+* Added `Applicative` instance for `Request`+* Reformed around Control.Monad.Objective+  * Instance f g m ==> Inst m f g+  * `invoke` takes two transformations for lifting+  * Added lifted versions of `new`: `newIO` and `newST`++0.5.2+-----+* Added Process+* Added `runSequential`, `sequential` for operational monad+* Added `flyweight`++0.5.1+-----+* Added PushPull functor+* Removed `sequential`++0.5+-----+* Lift has gone+* Use elevator instead of Lift+* Moved Request to a separate module++0.4+-----+* Added Request functor along with Lift+* Supported "extensible" objects using open unions+* AccessT is now obsolete

@@ -1,52 +1,52 @@-name:                objective
-version:             0.6.5
-synopsis:            Extensible objects
-description:         Stateful effect transducer
-homepage:            https://github.com/fumieval/objective
-license:             BSD3
-license-file:        LICENSE
-author:              Fumiaki Kinoshita
-maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>
-copyright:           Copyright (c) 2014 Fumiaki Kinoshita
-category:            Control
-build-type:          Simple
-extra-source-files:
-  CHANGELOG.md
-  .travis.yml
-cabal-version:       >=1.10
-
-library
-  exposed-modules:
-    Control.Object
-      , Control.Object.Object
-      , Control.Object.Mortal
-      , Control.Object.Process
-      , Control.Object.Extra
-      , Control.Object.Stream
-      , Control.Monad.Objective
-      , Control.Monad.Objective.Class
-      , Control.Monad.Objective.IO
-      , Control.Monad.Objective.ST
-      , Data.Functor.Request
-      , Data.Functor.PushPull
-  -- other-modules:
-  other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies
-  build-depends:       base >=4.5 && <5
-    , comonad
-    , elevator >= 0.2 && <0.3
-    , extensible
-    , containers
-    , minioperational >= 0.4 && <0.5
-    , profunctors >= 4.0 && <5
-    , witherable <= 0.2
-    , free >= 4.4 && <5
-    , kan-extensions >= 4.1 && <5
-    , unordered-containers
-    , hashable >= 1.2 && <1.4
-    , either
-    , void
-    , adjunctions >= 4.0 && <5
-    , transformers >= 0.3 && <0.5
-  ghc-options: -Wall
-  hs-source-dirs:      src
-  default-language:    Haskell2010
+name:                objective+version:             0.6.5.1+synopsis:            Extensible objects+description:         Stateful effect transducer+homepage:            https://github.com/fumieval/objective+license:             BSD3+license-file:        LICENSE+author:              Fumiaki Kinoshita+maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>+copyright:           Copyright (c) 2014 Fumiaki Kinoshita+category:            Control+build-type:          Simple+extra-source-files:+  CHANGELOG.md+  .travis.yml+cabal-version:       >=1.10++library+  exposed-modules:+    Control.Object+      , Control.Object.Object+      , Control.Object.Mortal+      , Control.Object.Process+      , Control.Object.Extra+      , Control.Object.Stream+      , Control.Monad.Objective+      , Control.Monad.Objective.Class+      , Control.Monad.Objective.IO+      , Control.Monad.Objective.ST+      , Data.Functor.Request+      , Data.Functor.PushPull+  -- other-modules:+  other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies+  build-depends:       base >=4.5 && <5+    , comonad+    , elevator >= 0.2 && <0.3+    , extensible >= 0.2.9 && <0.3+    , containers+    , minioperational >= 0.4 && <0.5+    , profunctors >= 4.0 && <5+    , witherable <= 0.2+    , free >= 4.4 && <5+    , kan-extensions >= 4.1 && <5+    , unordered-containers+    , hashable >= 1.2 && <1.4+    , either+    , void+    , adjunctions >= 4.0 && <5+    , transformers >= 0.3 && <0.5+  ghc-options: -Wall+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -1,7 +1,7 @@-module Control.Monad.Objective (module Control.Monad.Objective.Class
-  , module Control.Monad.Objective.IO
-  , module Control.Monad.Objective.ST) where
-
-import Control.Monad.Objective.Class
-import Control.Monad.Objective.IO
+module Control.Monad.Objective (module Control.Monad.Objective.Class+  , module Control.Monad.Objective.IO+  , module Control.Monad.Objective.ST) where++import Control.Monad.Objective.Class+import Control.Monad.Objective.IO import Control.Monad.Objective.ST

@@ -1,74 +1,81 @@-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Objective.IO
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- 'MonadObjective' class and operations
---
------------------------------------------------------------------------------
-module Control.Monad.Objective.Class where
-import Control.Object.Object
-import Control.Elevator
-import Control.Monad.Trans.State.Strict
-import Control.Monad.Operational.Mini
-import Data.Functor.Identity
-import Control.Monad
-
-type Inst' f g = Inst g f g
-
-class Monad b => ObjectiveBase b where
-  data Inst b (f :: * -> *) (g :: * -> *)
-  type InstOf b o :: *
-  type InstOf b (Object f g) = Inst b f g
-  new :: Object f g -> b (Inst b f g)
-  invoke :: Monad m => (forall x. b x -> m x) -> (forall x. g x -> m x) -> Inst b f g -> f a -> m a
-
-type MonadObjective b m = (ObjectiveBase b, Elevate b m, Monad m)
-
-(.->) :: (Monad m, ObjectiveBase m) => Inst m f m -> f a -> m a
-(.->) = invoke id id
-
-(.-) :: (MonadObjective b m, Elevate g m) => Inst b f g -> f a -> m a
-(.-) = invoke elevate elevate
-{-# INLINE (.-) #-}
-
-infixr 3 .-
-
--- | Invoke a method.
-(.^) :: (MonadObjective b m, Elevate g m, Elevate e f) => Inst b f g -> e a -> m a
-i .^ e = i .- elevate e
-{-# INLINE (.^) #-}
-infixr 3 .^
-
--- | (.^) for StateT
-(.&) :: (MonadObjective b m, Elevate g m, Elevate (State s) f) => Inst b f g -> StateT s m a -> m a
-i .& m = do
-  s <- i .^ StateT (\s -> Identity (s, s))
-  (a, s') <- runStateT m s
-  i .^ StateT (\_ -> Identity (a, s'))
-
-infixr 3 .&
-
-(.!) :: (MonadObjective b m, Elevate g m) => Inst b f g -> Program f a -> m a
-(.!) i = interpret (i.-)
-
-infixr 3 .!
-
--- | We can convert method invocation into an object trivially.
--- @invocation i = liftO (i.-)@
-invocation :: (MonadObjective b m, Elevate g m) => Inst b f g -> Object f m
-invocation i = Object $ liftM (\a -> (a, invocation i)). (i.-)
+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Objective.IO+-- Copyright   :  (c) Fumiaki Kinoshita 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- 'MonadObjective' class and operations+--+-----------------------------------------------------------------------------+module Control.Monad.Objective.Class where+import Control.Object.Object+import Control.Elevator+import Control.Monad.Trans.State.Strict+import Control.Monad.Operational.Mini+import Data.Functor.Identity+import Control.Monad++type Inst' f g = Inst g f g++class Monad b => ObjectiveBase b where+  data Inst b (f :: * -> *) (g :: * -> *)+  type InstOf b o :: *+  type InstOf b (Object f g) = Inst b f g+  new :: Object f g -> b (Inst b f g)+  new = new+  invoke :: Monad m => (forall x. b x -> m x) -> (forall x. g x -> m x) -> Inst b f g -> f a -> m a++newSettle :: ObjectiveBase g => Object f g -> g (Inst g f g)+newSettle = new++type MonadObjective b m = (ObjectiveBase b, Elevate b m, Monad m)++(.->) :: (Monad m, ObjectiveBase m) => Inst m f m -> f a -> m a+(.->) = invoke id id+{-# INLINE (.->) #-}++(.-) :: (MonadObjective b m, Elevate g m) => Inst b f g -> f a -> m a+(.-) = invoke elevate elevate+{-# INLINE (.-) #-}++infixr 3 .-++-- | Invoke a method.+(.^) :: (MonadObjective b m, Elevate g m, Elevate e f) => Inst b f g -> e a -> m a+i .^ e = i .- elevate e+{-# INLINE (.^) #-}+infixr 3 .^++-- | (.^) for StateT+(.&) :: (MonadObjective b m, Elevate g m, Elevate (State s) f) => Inst b f g -> StateT s m a -> m a+i .& m = do+  s <- i .^ StateT (\s -> Identity (s, s))+  (a, s') <- runStateT m s+  i .^ StateT (\_ -> Identity (a, s'))++infixr 3 .&++(.!) :: (MonadObjective b m, Elevate g m) => Inst b f g -> Program f a -> m a+(.!) i = interpret (i.-)+{-# INLINE (.!) #-}++infixr 3 .!++-- | We can convert method invocation into an object trivially.+-- @invocation i = liftO (i.-)@+invocation :: (MonadObjective b m, Elevate g m) => Inst b f g -> Object f m+invocation i = Object $ liftM (\a -> (a, invocation i)). (i.-)+{-# INLINE invocation #-}

@@ -1,34 +1,34 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Objective.IO
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- 'MonadObjective' 'IO' using MVar
---
------------------------------------------------------------------------------
-module Control.Monad.Objective.IO  where
-import Control.Monad.Objective.Class
-import Control.Concurrent
-import Control.Object.Object
-import Control.Monad.IO.Class
-
-instance ObjectiveBase IO where
-  data Inst IO f g = InstIO (MVar (Object f g))
-
-  invoke mr gr (InstIO m) e = do
-    c <- mr (takeMVar m)
-    (a, c') <- gr (runObject c e)
-    mr (putMVar m c')
-    return a
-
-  new v = InstIO `fmap` newMVar v
-
-newIO :: MonadIO m => Object f g -> m (Inst IO f g)
-newIO = liftIO . new
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Objective.IO+-- Copyright   :  (c) Fumiaki Kinoshita 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- 'MonadObjective' 'IO' using MVar+--+-----------------------------------------------------------------------------+module Control.Monad.Objective.IO  where+import Control.Monad.Objective.Class+import Control.Concurrent+import Control.Object.Object+import Control.Monad.IO.Class++instance ObjectiveBase IO where+  data Inst IO f g = InstIO (MVar (Object f g))++  invoke mr gr (InstIO m) e = do+    c <- mr (takeMVar m)+    (a, c') <- gr (runObject c e)+    mr (putMVar m c')+    return a++  new v = InstIO `fmap` newMVar v++newIO :: MonadIO m => Object f g -> m (Inst IO f g)+newIO = liftIO . new

@@ -1,36 +1,36 @@-{-# LANGUAGE TypeFamilies, ConstraintKinds, FlexibleContexts #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Objective.ST
--- Copyright   :  (c) Corbin Simpson, Google Inc. 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable (ST)
---
--- 'MonadObjective' 'ST' using 'STRef'
---
------------------------------------------------------------------------------
-module Control.Monad.Objective.ST where
-
-import Control.Monad.Objective.Class
-import Control.Monad.ST
-import Control.Object.Object
-import Data.STRef
-import Control.Elevator
-
-instance ObjectiveBase (ST s) where
-  data Inst (ST s) f g = InstST (STRef s (Object f g))
-
-  invoke mr gr (InstST ref) e = do
-    o <- mr (readSTRef ref)
-    (a, o') <- gr (runObject o e)
-    mr (writeSTRef ref o')
-    return a
-  new o = InstST `fmap` newSTRef o
-
-newST :: Elevate (ST s) m => Object f g -> m (Inst (ST s) f g)
-newST = elevate . new
+{-# LANGUAGE TypeFamilies, ConstraintKinds, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Objective.ST+-- Copyright   :  (c) Corbin Simpson, Google Inc. 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (ST)+--+-- 'MonadObjective' 'ST' using 'STRef'+--+-----------------------------------------------------------------------------+module Control.Monad.Objective.ST where++import Control.Monad.Objective.Class+import Control.Monad.ST+import Control.Object.Object+import Data.STRef+import Control.Elevator++instance ObjectiveBase (ST s) where+  data Inst (ST s) f g = InstST (STRef s (Object f g))++  invoke mr gr (InstST ref) e = do+    o <- mr (readSTRef ref)+    (a, o') <- gr (runObject o e)+    mr (writeSTRef ref o')+    return a+  new o = InstST `fmap` newSTRef o++newST :: Elevate (ST s) m => Object f g -> m (Inst (ST s) f g)+newST = elevate . new

@@ -1,33 +1,33 @@-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE Rank2Types, FlexibleInstances, FlexibleContexts, TypeOperators, CPP, ConstraintKinds #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Object
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Stateful effect transducer: The Mealy machine for effects.
---
------------------------------------------------------------------------------
-module Control.Object
-  ( module Control.Object.Object,
-    module Control.Object.Stream,
-    module Control.Object.Mortal,
-    module Control.Object.Process,
-    module Control.Object.Extra,
-    module Data.Functor.Request,
-    module Data.Functor.PushPull
-  ) where
-
-import Control.Object.Object
-import Control.Object.Stream
-import Control.Object.Mortal
-import Control.Object.Process
-import Control.Object.Extra
-import Data.Functor.Request
-import Data.Functor.PushPull
+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Rank2Types, FlexibleInstances, FlexibleContexts, TypeOperators, CPP, ConstraintKinds #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Object+-- Copyright   :  (c) Fumiaki Kinoshita 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Stateful effect transducer: The Mealy machine for effects.+--+-----------------------------------------------------------------------------+module Control.Object+  ( module Control.Object.Object,+    module Control.Object.Stream,+    module Control.Object.Mortal,+    module Control.Object.Process,+    module Control.Object.Extra,+    module Data.Functor.Request,+    module Data.Functor.PushPull+  ) where++import Control.Object.Object+import Control.Object.Stream+import Control.Object.Mortal+import Control.Object.Process+import Control.Object.Extra+import Data.Functor.Request+import Data.Functor.PushPull

@@ -99,6 +99,6 @@   liftIO $ writeIORef r obj'   return a -invoke :: f a -> StateT (Object f m) m a-invoke = StateT #. flip runObject-{-# INLINE invoke #-}+invokeState :: f a -> StateT (Object f m) m a+invokeState = StateT #. flip runObject+{-# INLINE invokeState #-}

@@ -40,6 +40,9 @@     Left a -> runMortal (k a) f     Right (x, m') -> return (x, m' >>= k) +instance MonadTrans (Mortal f) where+  lift m = mortal $ const $ EitherT $ liftM Left m+ mortal :: (forall x. f x -> EitherT a m (x, Mortal f m a)) -> Mortal f m a mortal f = Mortal (Object (fmap unsafeCoerce f)) {-# INLINE mortal #-}

@@ -114,8 +114,8 @@ sharing m = go where   go s = Object $ \k -> liftM (fmap go) $ caseOf (getUnion k)     $ (\n cont -> return $ first cont $ runState n s)-    <$?~ (\e cont -> first cont `liftM` runStateT (m e) s)-    <$?~ Nil+    <?!~ (\e cont -> first cont `liftM` runStateT (m e) s)+    <?!~ Nil {-# INLINE sharing #-}  (@!) :: Monad m => Object e m -> ReifiedProgram e a -> m (a, Object e m)

@@ -1,60 +1,60 @@-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE ScopedTypeVariables, Rank2Types, DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, DataKinds, TypeFamilies, TypeOperators #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.PushPull
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Data.Functor.PushPull where
-import Data.Typeable
-import Control.Elevator
-import Control.Applicative
-import Data.Profunctor
-import Data.Functor.Day
-import Data.Extensible
-
--- | The type for asynchronous input/output.
-data PushPull a b r = Push a r | Pull (b -> r) deriving (Functor, Typeable)
-
-type PushPull' a = PushPull a a
-
-instance Profunctor (PushPull a) where
-  dimap _ g (Push a r) = Push a (g r)
-  dimap f g (Pull br) = Pull (dimap f g br)
-
-instance Tower (PushPull a b) where
-  type Floors (PushPull a b) = '[(,) a, (->) b]
-  stairs = uncurry Push `rung` Pull `rung` Nil
-
-push :: Elevate ((,) a) f => a -> f ()
-push a = elevate (a, ())
-
-pull :: Elevate ((->) a) f => f a
-pull = elevate id
-
-mapPush :: (a -> a') -> PushPull a b r -> PushPull a' b r
-mapPush f (Push a r) = Push (f a) r
-mapPush _ (Pull br) = Pull br
-
-bipush :: (i -> (a, c)) -> (b -> d -> o) -> PushPull i o r -> Day (PushPull a b) (PushPull c d) r
-bipush f g = go where
-  go (Pull r) = Day (Pull id) (Pull id) (fmap r . g)
-  go (Push i r) = let (a, b) = f i in Day (Push a ()) (Push b ()) (\_ _ -> r)
-{-# INLINE bipush #-}
-
-bipull :: (a -> b -> c) -> PushPull i c r -> Day (PushPull i a) (PushPull i b) r
-bipull = bipush (\x -> (x, x))
-{-# INLINE bipull #-}
-
--- | @filterPush :: (a -> Bool) -> PushPull a b r -> Program (PushPull a b) r@
-filterPush :: (Applicative f, Elevate (PushPull a b) f) => (a -> Bool) -> PushPull a b r -> f r
-filterPush p e@(Push a r)
-  | p a = elevate e
-  | otherwise = pure r
-filterPush _ e = elevate e
+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ScopedTypeVariables, Rank2Types, DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, DataKinds, TypeFamilies, TypeOperators #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.PushPull+-- Copyright   :  (c) Fumiaki Kinoshita 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Data.Functor.PushPull where+import Data.Typeable+import Control.Elevator+import Control.Applicative+import Data.Profunctor+import Data.Functor.Day+import Data.Extensible++-- | The type for asynchronous input/output.+data PushPull a b r = Push a r | Pull (b -> r) deriving (Functor, Typeable)++type PushPull' a = PushPull a a++instance Profunctor (PushPull a) where+  dimap _ g (Push a r) = Push a (g r)+  dimap f g (Pull br) = Pull (dimap f g br)++instance Tower (PushPull a b) where+  type Floors (PushPull a b) = '[(,) a, (->) b]+  stairs = uncurry Push `rung` Pull `rung` Nil++push :: Elevate ((,) a) f => a -> f ()+push a = elevate (a, ())++pull :: Elevate ((->) a) f => f a+pull = elevate id++mapPush :: (a -> a') -> PushPull a b r -> PushPull a' b r+mapPush f (Push a r) = Push (f a) r+mapPush _ (Pull br) = Pull br++bipush :: (i -> (a, c)) -> (b -> d -> o) -> PushPull i o r -> Day (PushPull a b) (PushPull c d) r+bipush f g = go where+  go (Pull r) = Day (Pull id) (Pull id) (fmap r . g)+  go (Push i r) = let (a, b) = f i in Day (Push a ()) (Push b ()) (\_ _ -> r)+{-# INLINE bipush #-}++bipull :: (a -> b -> c) -> PushPull i c r -> Day (PushPull i a) (PushPull i b) r+bipull = bipush (\x -> (x, x))+{-# INLINE bipull #-}++-- | @filterPush :: (a -> Bool) -> PushPull a b r -> Program (PushPull a b) r@+filterPush :: (Applicative f, Elevate (PushPull a b) f) => (a -> Bool) -> PushPull a b r -> f r+filterPush p e@(Push a r)+  | p a = elevate e+  | otherwise = pure r+filterPush _ e = elevate e

@@ -1,49 +1,49 @@-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, TypeOperators, DataKinds, TypeFamilies #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.Request
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Data.Functor.Request where
-import Data.Typeable
-import Control.Elevator
-import Data.Extensible
-import Control.Monad
-import Data.Monoid
-import Control.Applicative
-import Data.Profunctor
-
--- | 'Request a b' is the type of a request that sends @a@ to receive @b@.
-data Request a b r = Request a (b -> r) deriving (Functor, Typeable)
-
-mapRequest :: (a -> a') -> Request a b r -> Request a' b r
-mapRequest f (Request a br) = Request (f a) br
-{-# INLINE mapRequest #-}
-
-instance Profunctor (Request a) where
-  dimap f g (Request a br) = Request a (dimap f g br)
-  {-# INLINE dimap #-}
-
-instance Monoid a => Applicative (Request a b) where
-  pure a = Request mempty (const a)
-  Request a c <*> Request b d = Request (mappend a b) (c <*> d)
-
-instance Tower (Request a b) where
-  type Floors (Request a b) = '[]
-  stairs = Nil
-
-request :: (Elevate (Request a b) f) => a -> f b
-request a = elevate (Request a id)
-
-accept :: Functor f => (a -> f b) -> Request a b r -> f r
-accept f (Request a br) = fmap br (f a)
-
-acceptM :: Monad m => (a -> m b) -> Request a b r -> m r
-acceptM f (Request a br) = liftM br (f a)
+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, TypeOperators, DataKinds, TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Request+-- Copyright   :  (c) Fumiaki Kinoshita 2014+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Data.Functor.Request where+import Data.Typeable+import Control.Elevator+import Data.Extensible+import Control.Monad+import Data.Monoid+import Control.Applicative+import Data.Profunctor++-- | 'Request a b' is the type of a request that sends @a@ to receive @b@.+data Request a b r = Request a (b -> r) deriving (Functor, Typeable)++mapRequest :: (a -> a') -> Request a b r -> Request a' b r+mapRequest f (Request a br) = Request (f a) br+{-# INLINE mapRequest #-}++instance Profunctor (Request a) where+  dimap f g (Request a br) = Request a (dimap f g br)+  {-# INLINE dimap #-}++instance Monoid a => Applicative (Request a b) where+  pure a = Request mempty (const a)+  Request a c <*> Request b d = Request (mappend a b) (c <*> d)++instance Tower (Request a b) where+  type Floors (Request a b) = '[]+  stairs = Nil++request :: (Elevate (Request a b) f) => a -> f b+request a = elevate (Request a id)++accept :: Functor f => (a -> f b) -> Request a b r -> f r+accept f (Request a br) = fmap br (f a)++acceptM :: Monad m => (a -> m b) -> Request a b r -> m r+acceptM f (Request a br) = liftM br (f a)