-- Communicating Haskell Processes.
-- Copyright (c) 2009-2010, Neil Brown.
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--  * Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--  * 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.
--  * Neither the name of the University of Kent 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 OWNER 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.

-- | A module containing a 'Composed' monad.
--
-- The 'Composed' monad can be thought of as an equivalent to functions elsewhere
-- in chp-plus (especially the "Control.Concurrent.CHP.Connect" module) that support
-- partial application of processes when wiring them up.
--
-- Binding in this monad can be thought of as \"and then wire that like this\".
--  You compose your processes together with a series of monadic actions, feeding
-- processes into each function that wires up the next parameter, then taking the
-- results of that action and further wiring it up another way.  At the end of
-- the monadic block you should return the full list of wired-up processes, to
-- be run in parallel using the 'run' (or 'run_') functions.
--
-- Here is a simple example.  You have a list of processes that take an incoming
-- and outgoing channel end and a barrier, and you want to wire them into a cycle
-- and enroll them all on the barrier:
--
-- > processes :: [Chanin a -> Chanout a -> EnrolledBarrier -> CHP ()]
-- >
-- > runProcesses = do b <- newBarrier
-- >                   run $ cycleR processes >>= enrollAllR b
--
-- The order of the actions in this monad tends not to matter (it is a commutative
-- monad for the most part) so you could equally have written:
--
-- > processes :: [EnrolledBarrier -> Chanin a -> Chanout a -> CHP ()]
-- >
-- > runProcesses = do b <- newBarrier
-- >                   run $ enrollAllR b processes >>= cycleR
--
-- Remember with this monad to return all the processes to be run in parallel;
-- if they are not returned, they will not be run and you will likely get deadlock.
--
-- A little more background on the monad is available in this blog post: <http://chplib.wordpress.com/2010/01/19/the-process-composition-monad/>
module Control.Concurrent.CHP.Composed
  (Composed, runWith, run, run_, enrollR, enrollAllR, connectR, pipelineR, pipelineCompleteR, cycleR,
    wrappedGridFourR)
    where

import Control.Applicative
import Control.Concurrent.CHP
import Control.Concurrent.CHP.Connect
import Control.Concurrent.CHP.Connect.TwoDim (FourWay(..))
import Control.Monad
import Control.Monad.Trans
import Data.List (transpose)

-- | A monad for composing together CHP processes in cross-cutting ways; e.g. wiring
-- together a list of processes into a pipeline, but also enrolling them all on
-- a barrier.
newtype Composed a = Composed {
  runWith :: forall b. (a -> CHP b) -> CHP b
  -- ^ See 'run' and 'run_'
  }

instance Monad Composed where
  return x = Composed ($ x)
  (>>=) m f = Composed (\r -> m `runWith` ((`runWith` r) . f))

instance MonadCHP Composed where
  liftCHP x = Composed (x >>=)

instance MonadIO Composed where
  liftIO x = Composed (liftIO x >>=)

instance Functor Composed where
  fmap = liftM

instance Applicative Composed where
  pure = return
  (<*>) = ap

-- | Given a list of CHP processes composed using the Composed monad, runs them
-- as a parallel bunch of CHP results (with 'runParallel') and returns the results.
run :: Composed [CHP a] -> CHP [a]
run p = p `runWith` runParallel

-- | Like 'run' but discards the results (uses 'runParallel_').
run_ :: Composed [CHP a] -> CHP ()
run_ p = p `runWith` runParallel_

-- | Like 'enroll', this takes a barrier and a process wanting a barrier, and enrolls
-- it for the duration, but operates using the 'Composed' monad.
enrollR :: Enrollable b p => b p -> (Enrolled b p -> a) -> Composed a
enrollR b p = Composed (\r -> enroll b (r . p))

-- | Given an 'Enrollable' item (such as a 'Barrier'), and a list of processes,
-- composes them by enrolling them all on the given barrier.
enrollAllR :: Enrollable b p => b p -> [Enrolled b p -> a] -> Composed [a]
enrollAllR b ps = Composed (\r -> enrollAllT r (return b) ps)

-- | Like 'connect' but operates in the 'Composed' monad.
connectR :: Connectable l r => ((l, r) -> a) -> Composed a
connectR p = Composed (\r -> connect (r . p))

-- | Wires a list of processes into a pipeline that takes the two channels for
-- the ends of the pipeline and returns the list of wired-up processes.
pipelineR :: Connectable l r => [r -> l -> a] -> Composed (r -> l -> [a])
pipelineR [] = return $ const $ const []
pipelineR (first:rest) = foldM pcr (\x y -> [first x y]) rest
  where
    pcr p q = connectR $ \(l, r) x y -> (p x l) ++ [q r y]

-- Similar to 'pipelineR' but puts a process at the beginning and end of the pipeline.
--  The list is returned in the order @[start] ++ middle ++ [end]@.
pipelineCompleteR :: Connectable l r => (l -> a) -> [r -> l -> a] -> (r -> a) -> Composed [a]
pipelineCompleteR start middle end
  = do midWired <- pipelineR middle
       startAndMiddle <- connectR $ \(l, r) e -> start l : midWired r e
       connectR $ \(l, r) -> startAndMiddle l ++ [end r]

-- | Connects together a list of processes into a cycle.
cycleR :: Connectable l r => [r -> l -> a] -> Composed [a]
cycleR [] = return []
cycleR [p] = (:[]) <$> connectR (uncurry $ flip p)
cycleR ps = pipelineR ps >>= connectR . uncurry . flip

-- | Like 'wrappedGridFour', but in the 'Composed' monad.
wrappedGridFourR :: (Connectable below above, Connectable right left) =>
  [[FourWay above below left right -> a]] -> Composed [[a]]
wrappedGridFourR = (return . transpose) <=< mapM cycleR <=< (return . transpose) <=< mapM (connectRowR)
  where
--    connectRowR :: [FourWay above below left right -> a] -> [below -> above -> a]
    connectRowR ps = cycleR [\l r a b -> p (FourWay a b l r) | p <- ps]

--wrappedGridFourR' :: (Connectable below above, Connectable right left) =>
--  [[above -> below -> left -> right -> a]] -> Composed [[a]]
--wrappedGridFourR' = (mapM cycleConnectR . transpose) <=< (mapM cycleConnectR . transpose)
--  where
--    connectRowR :: [FourWay above below left right -> a] -> [below -> above -> a]
--    connectRowR ps = cycleConnectR [\l r a b -> p (FourWay a b l r) | p <- ps]