{-# LANGUAGE TypeFamilies #-}

-----------------------------------------------------------------------------

-- Copyright 2018, Ideas project team. This file is distributed under the

-- terms of the Apache License 2.0. For more information, see the files

-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.

-----------------------------------------------------------------------------

-- |

-- Maintainer  :  bastiaan.heeren@ou.nl

-- Stability   :  provisional

-- Portability :  portable (depends on ghc)

--

-- Processes support choices and sequences and are modelled after Hoare's CSP

-- calculus.

--

-----------------------------------------------------------------------------



module Ideas.Common.Strategy.Process

   ( Process, eqProcessBy, menu, withMenu

   , fold, runProcess

   ) where



import Ideas.Common.Classes

import Ideas.Common.Strategy.Choice

import Ideas.Common.Strategy.Sequence



------------------------------------------------------------------------

-- Process data type



-- | Process data type with efficient support for sequences

newtype Process a = P [Menu a (Process a)]



instance Eq a => Eq (Process a) where

   (==) = eqProcessBy (==)



instance Functor Process where

   fmap f = rec

    where

      rec (P xs) = P (map g xs)

      g = onMenu (\a q -> f a |-> rec q) doneMenu



instance Choice (Process a) where

   empty   = P [empty]

   x .|. y = P [menu x .|. menu y]

   x ./. y = P [menu x ./. menu y]

   x |>  y = P [menu x |>  menu y]



instance Sequence (Process a) where

   type Sym (Process a) = a



   done = P []

   a ~> b = P [a |-> b]

   P xs .*. P ys = P (xs ++ ys)

   sequence ps = P [ x | P xs <- ps, x <- xs ]



instance Fix (Process a)



instance Firsts (Process a) where

   type Elem (Process a) = a



   firsts = bests . menu

   ready  = hasDone . menu



runProcess :: Apply f => Process (f a) -> a -> [a]

runProcess p a = withMenu op [a] p

 where

   op f x = [ c | b <- applyAll f a, c <- runProcess x b ]



menu :: Process a -> Menu a (Process a)

menu (P zs) = rec zs

 where

   rec []     = doneMenu

   rec [x]    = x

   rec (x:xs) = onMenu (\a (P ys) -> a |-> P (ys ++ xs)) (rec xs) x



withMenu :: Choice b => (a -> Process a -> b) -> b -> Process a -> b

withMenu op e (P zs) = rec zs

 where

   rec []     = e

   rec [x]    = onMenu op e x

   rec (x:xs) = onMenu (\a (P ys) -> op a (P (ys ++ xs))) (rec xs) x



-- | Generalized equality of processes, which takes an equality function for

-- the symbols.

eqProcessBy :: (a -> a -> Bool) -> Process a -> Process a -> Bool

eqProcessBy eq = rec

 where

   rec p q = eqMenuBy eq rec (menu p) (menu q)



fold :: Choice b => (a -> b -> b) -> b -> Process a -> b

fold op e = rec

 where

   rec = withMenu (\a -> op a . rec) e