diff --git a/examples/Main.hs b/examples/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Main.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} + +module Main where + +import Control.Natural (nat, run) +import Control.Remote.Monad +import Control.Remote.Monad.Packet.Weak + +data Command :: * where + Say :: String -> Command + +data Procedure :: * -> * where + Temperature :: Procedure Int + +say :: String -> RemoteMonad Command Procedure () +say s = command (Say s) + +temperature :: RemoteMonad Command Procedure Int +temperature = procedure Temperature + + +runWP :: WeakPacket Command Procedure a -> IO a +runWP (Command (Say s)) = print s +runWP (Procedure Temperature) = return 42 + +send :: RemoteMonad Command Procedure a -> IO a +send = run $ runMonad $ nat runWP + +main :: IO () +main = send $ do + say "Howdy doodly do" + say "How about a muffin?" + t <- temperature + say (show t ++ "F") + diff --git a/remote-monad.cabal b/remote-monad.cabal --- a/remote-monad.cabal +++ b/remote-monad.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: remote-monad -version: 0.1.0.1 +version: 0.2 synopsis: An parametrizable Remote Monad, and parametrizable Applicative Functor description: An implementation of the concepts behind Remote Monads. There is support for various bundling strategies. @@ -13,6 +13,7 @@ . module Main where . + import Control.Natural (nat, (#)) import Control.Remote.Monad import Control.Remote.Monad.Packet.Weak . @@ -29,11 +30,11 @@ temperature = procedure Temperature . runWP :: WeakPacket Command Procedure a -> IO a - runWP (Command (Say s)) = print s + runWP (Command (Say s)) = print s runWP (Procedure Temperature) = return 42 . send :: RemoteMonad Command Procedure a -> IO a - send m = runMonad runWP m + send = run $ runMonad $ nat runWP . main = send $ do say "Howdy doodly do" @@ -62,25 +63,36 @@ Control.Remote.Monad.Packet.Applicative Control.Remote.Monad.Packet.Strong Control.Remote.Monad.Packet.Weak - Control.Remote.Monad.Packet.Transport Control.Remote.Applicative Control.Remote.Monad other-modules: + Control.Remote.Monad.Packet.Transport Control.Remote.Monad.Types other-extensions: GADTs, RankNTypes, ScopedTypeVariables build-depends: base >=4.7 && < 5 - , natural-transformation >= 0.3 && < 0.4 + , natural-transformation >= 0.3.1 && < 0.4 , transformers >= 0.4 && < 0.6 hs-source-dirs: src default-language: Haskell2010 +test-suite remote-monad-example + type: exitcode-stdio-1.0 + main-is: Main.hs + build-depends: base >= 4.7 && < 5 + , natural-transformation >= 0.3.1 && < 0.4 + , remote-monad == 0.2 + hs-source-dirs: examples + default-language: Haskell2010 + ghc-options: -Wall + test-suite remote-monad-properties type: exitcode-stdio-1.0 main-is: Test.hs build-depends: base >= 4.7 && < 5 , containers >= 0.1 && < 0.6 - , remote-monad == 0.1.0.1 + , natural-transformation >= 0.3.1 && < 0.4 + , remote-monad == 0.2 , QuickCheck == 2.8.* , quickcheck-instances >= 0.1 && < 0.4 , tasty >= 0.8 && < 0.12 diff --git a/src/Control/Remote/Applicative.hs b/src/Control/Remote/Applicative.hs --- a/src/Control/Remote/Applicative.hs +++ b/src/Control/Remote/Applicative.hs @@ -50,7 +50,7 @@ class RunApplicative f where -- | This overloaded function chooses the appropriate bundling strategy -- based on the type of the handler your provide. - runApplicative :: (Monad m) => (f c p ~> m) -> (RemoteApplicative c p ~> m) + runApplicative :: (Monad m) => (f c p :~> m) -> (RemoteApplicative c p :~> m) instance RunApplicative WeakPacket where runApplicative = runWeakApplicative @@ -62,14 +62,17 @@ runApplicative = runApplicativeApplicative -- | The weak remote applicative, that sends commands and procedures piecemeal. -runWeakApplicative :: forall m c p . (Applicative m) => (WeakPacket c p ~> m) -> (RemoteApplicative c p ~> m) -runWeakApplicative f (RemoteApplicative (Command g c)) = runWeakApplicative f (RemoteApplicative g) <* f (Weak.Command c) -runWeakApplicative f (RemoteApplicative (Procedure g p)) = runWeakApplicative f (RemoteApplicative g) <*> f (Weak.Procedure p) -runWeakApplicative f (RemoteApplicative (Pure a)) = pure a +runWeakApplicative :: forall m c p . (Applicative m) => (WeakPacket c p :~> m) -> (RemoteApplicative c p :~> m) +runWeakApplicative (Nat f) = nat go + where + go :: forall a . RemoteApplicative c p a -> m a + go (RemoteApplicative (Command g c)) = go (RemoteApplicative g) <* f (Weak.Command c) + go (RemoteApplicative (Procedure g p)) = go (RemoteApplicative g) <*> f (Weak.Procedure p) + go (RemoteApplicative (Pure a)) = pure a -- | The strong remote applicative, that bundles together commands. -runStrongApplicative :: forall m c p . (Monad m) => (StrongPacket c p ~> m) -> (RemoteApplicative c p ~> m) -runStrongApplicative f (RemoteApplicative p) = do +runStrongApplicative :: forall m c p . (Monad m) => (StrongPacket c p :~> m) -> (RemoteApplicative c p :~> m) +runStrongApplicative (Nat f) = nat $ \ (RemoteApplicative p) -> do (r,HStrongPacket h) <- runStateT (go p) (HStrongPacket id) f $ h $ Strong.Done return r @@ -88,5 +91,5 @@ return $ r1 r2 -- | The applicative remote applicative, that is the identity function. -runApplicativeApplicative :: (ApplicativePacket c p ~> m) -> (RemoteApplicative c p ~> m) -runApplicativeApplicative f (RemoteApplicative m) = f m +runApplicativeApplicative :: (ApplicativePacket c p :~> m) -> (RemoteApplicative c p :~> m) +runApplicativeApplicative f = nat $ \ (RemoteApplicative m) -> f # m diff --git a/src/Control/Remote/Monad.hs b/src/Control/Remote/Monad.hs --- a/src/Control/Remote/Monad.hs +++ b/src/Control/Remote/Monad.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} @@ -46,11 +47,11 @@ procedure :: p a -> RemoteMonad c p a procedure = Appl . A.procedure --- 'RunMonad' is the overloading for choosing the appropriate bundling strategy for a monad. +-- | 'RunMonad' is the overloading for choosing the appropriate bundling strategy for a monad. class RunMonad f where -- | This overloaded function chooses the appropriate bundling strategy -- based on the type of the handler your provide. - runMonad :: (Monad m) => (f c p ~> m) -> (RemoteMonad c p ~> m) + runMonad :: (Monad m) => (f c p :~> m) -> (RemoteMonad c p :~> m) instance RunMonad WeakPacket where runMonad = runWeakMonad @@ -67,20 +68,21 @@ -- Every '>>=' will generate a call to the 'RemoteApplicative' -- handler; as well as one terminating call. -- Using 'runBindeeMonad' with a 'runWeakApplicative' gives the weakest remote monad. -runMonadSkeleton :: (Monad m) => (RemoteApplicative c p ~> m) -> (RemoteMonad c p ~> m) -runMonadSkeleton f (Appl g) = f g -runMonadSkeleton f (Bind g k) = f g >>= runMonadSkeleton f . k +runMonadSkeleton :: (Monad m) => (RemoteApplicative c p :~> m) -> (RemoteMonad c p :~> m) +runMonadSkeleton f = nat $ \ case + Appl g -> run f g + Bind g k -> run f g >>= \ a -> runMonadSkeleton f # (k a) -- | This is the classic weak remote monad, or technically the -- weak remote applicative weak remote monad. -runWeakMonad :: (Monad m) => (WeakPacket c p ~> m) -> (RemoteMonad c p ~> m) -runWeakMonad f = runMonadSkeleton (A.runWeakApplicative f) +runWeakMonad :: (Monad m) => (WeakPacket c p :~> m) -> (RemoteMonad c p :~> m) +runWeakMonad = runMonadSkeleton . A.runWeakApplicative -- | This is the classic strong remote monad. It bundles -- packets (of type 'StrongPacket') as large as possible, -- including over some monadic binds. -runStrongMonad :: forall m c p . (Monad m) => (StrongPacket c p ~> m) -> (RemoteMonad c p ~> m) -runStrongMonad f p = do +runStrongMonad :: forall m c p . (Monad m) => (StrongPacket c p :~> m) -> (RemoteMonad c p :~> m) +runStrongMonad (Nat f) = nat $ \ p -> do (r,HStrongPacket h) <- runStateT (go2 p) (HStrongPacket id) f $ h $ Strong.Done return r @@ -108,8 +110,8 @@ -- | The is the strong applicative strong remote monad. It bundles -- packets (of type 'RemoteApplicative') as large as possible, -- including over some monadic binds. -runApplicativeMonad :: forall m c p . (Monad m) => (A.ApplicativePacket c p ~> m) -> (RemoteMonad c p ~> m) -runApplicativeMonad f p = do +runApplicativeMonad :: forall m c p . (Monad m) => (A.ApplicativePacket c p :~> m) -> (RemoteMonad c p :~> m) +runApplicativeMonad (Nat f) = nat $ \ p -> do (r,h) <- runStateT (go2 p) (pure ()) f $ h return r diff --git a/src/Control/Remote/Monad/Packet/Strong.hs b/src/Control/Remote/Monad/Packet/Strong.hs --- a/src/Control/Remote/Monad/Packet/Strong.hs +++ b/src/Control/Remote/Monad/Packet/Strong.hs @@ -26,12 +26,5 @@ Procedure :: p a -> StrongPacket c p a Done :: StrongPacket c p () --- | promote a Weak packet transporter, into a Strong packet transporter. -runStrongPacket :: (Applicative m) => (WeakPacket c p ~> m) -> (StrongPacket c p ~> m) -runStrongPacket f (Command c pk) = f (Weak.Command c) *> runStrongPacket f pk -runStrongPacket f (Procedure p) = f (Weak.Procedure p) -runStrongPacket f Done = pure () - -- | A Hughes-style version of 'StrongPacket', with efficent append. newtype HStrongPacket c p = HStrongPacket (StrongPacket c p ~> StrongPacket c p) - diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -21,13 +21,14 @@ import Data.Foldable (toList) import Data.Sequence (Seq, fromList) +import Control.Natural (nat,(:~>),(#)) + import qualified Control.Remote.Monad as M import Control.Remote.Monad.Packet.Applicative as AP import qualified Control.Remote.Monad.Packet.Weak as WP import qualified Control.Remote.Monad.Packet.Strong as SP import qualified Control.Remote.Applicative as A - import Test.QuickCheck import Test.QuickCheck.Instances () import Test.Tasty (TestTree, defaultMain, testGroup) @@ -92,7 +93,7 @@ ---------------------------------------------------------------- -- The different ways of running remote monads. -data RemoteMonad = RemoteMonad String (forall a . IORef [String] -> IORef [A] -> M.RemoteMonad C P a -> IO a) +data RemoteMonad = RemoteMonad String (forall a . IORef [String] -> IORef [A] -> M.RemoteMonad C P :~> IO) instance Show RemoteMonad where show (RemoteMonad msg _) = "Remote Monad: " ++ msg @@ -100,10 +101,7 @@ instance Arbitrary RemoteMonad where arbitrary = elements [ runWeakMonadWeakPacket - , runStrongMonadWeakPacket , runStrongMonadStrongPacket --- , runApplicativeMonadWeakPacket --- , runApplicativeMonadStrongPacket , runApplicativeMonadApplicativePacket ] @@ -111,35 +109,23 @@ runWeakMonadWeakPacket :: RemoteMonad runWeakMonadWeakPacket = RemoteMonad "WeakMonadWeakPacket" - $ \ tr ref -> M.runWeakMonad (runWP tr ref) - -runStrongMonadWeakPacket :: RemoteMonad -runStrongMonadWeakPacket = RemoteMonad "StrongMonadWeakPacket" - $ \ tr ref -> M.runStrongMonad (SP.runStrongPacket (runWP tr ref)) + $ \ tr ref -> M.runWeakMonad (nat $ runWP tr ref) runStrongMonadStrongPacket :: RemoteMonad runStrongMonadStrongPacket = RemoteMonad "StrongMonadStrongPacket" - $ \ tr ref -> M.runStrongMonad (runSP tr ref) -{- -runApplicativeMonadWeakPacket :: RemoteMonad -runApplicativeMonadWeakPacket = RemoteMonad "ApplicativeMonadWeakPacket" - $ \ tr ref -> M.runApplicativeMonad (A.runApplicative (runWP tr ref)) + $ \ tr ref -> M.runStrongMonad (nat $ runSP tr ref) -runApplicativeMonadStrongPacket :: RemoteMonad -runApplicativeMonadStrongPacket = RemoteMonad "ApplicativeMonadStrongPacket" - $ \ tr ref -> M.runApplicativeMonad (A.runApplicative (runSP tr ref)) --} runApplicativeMonadApplicativePacket :: RemoteMonad runApplicativeMonadApplicativePacket = RemoteMonad "ApplicativeMonadApplicativePacket" - $ \ tr ref -> M.runApplicativeMonad (runAppP tr ref) + $ \ tr ref -> M.runApplicativeMonad (nat $ runAppP tr ref) ---------------------------------------------------------------- -data DeviceM = Device (IORef [String]) (IORef [A]) (forall a . M.RemoteMonad C P a -> IO a) +data DeviceM = Device (IORef [String]) (IORef [A]) (M.RemoteMonad C P :~> IO) sendM :: DeviceM -> M.RemoteMonad C P a -> IO a -sendM (Device _ _ f) = f +sendM (Device _ _ f) m = f # m newDevice :: [A] -> RemoteMonad