{-# LANGUAGE PatternSignatures, FlexibleInstances, TypeSynonymInstances #-}

import IO
import Control.Concurrent
import Control.Concurrent.STM

import List

import MultiSetRewrite.StorePrettyPrinter
import Join.Base
import Join.Join
import Join.JoinPrettyPrinter

import Data.Time
import System.Time

-----------------------------------------------------------------------------------
{-

-- A helper will prep a potato if there's demand and there's
-- a potato available
Helper(x) & NeedPotato(style) & Potato() = do
   { case style of
      "cut"  -> do { -- cut potato
                   ; threadDelay 2
                   ; PotatoCuts() }
      "peel" -> do { -- peel potato
                   ; threadDelay 4
                   ; PotatoPeeled() }
   ; x .=. True }
   
-- No potatoes left. Helper grabs ten dollars to buy
-- ten potatoes
NeedPotato(style) \ Helper(x) & (map (\_ -> Dollar()) [1..10]) = do
   { -- buy potatoes
   ; threadDelay 5
   ; mapM (\_ -> Potato()) [1..10]
   ; x .=. True }
   
-- A chef will make fries if there's an order for fries and
-- potato cuts are available
Chef(x) & PotatoCuts() = do
   { -- Fry potato cuts
   ; threadDelay 2
   ; Food("Fries")
   ; x .=. True }
   
-- A chef will make baked potatoes if there's an order for baked 
-- potatoes and peeled potato are available 
Chef(x) & PotatoPeeled() = do
   { -- Bake peeled potato
   ; threadDelay 4
   ; Food("BakedPotato")
   ; x .=. True }
   
-- Processed potato for particular food order not available.
-- Request from helpers
Order(food) & Chef(x) = do
   { let style = case food of
                   "Fries"       -> "cut"
                   "BakedPotato" -> "peel"   
   ; NeedPotato(style)
   ; x .=. True }
   
-- A customer will order either fries or baked potatoes for
-- 2 and 3 dollars respectively.
Customer(x,food) & Food(food) = do
   { case food of
      "Fries"       -> do { Dollar() ; Dollar() }
      "BakedPotato" -> do { Dollar() ; Dollar() ; Dollar() }
   ; x .=. True }
   
-}
     
-----------------------------------------------------------------------------------

helper x = method "Helper" x
chef x   = method "Chef" x
customer x f = method "Customer" (x,f)
potato       = method "Potato" () 
potatoCuts   = method "PotatoCuts" ()
potatoPeeled = method "PotatoPeeled" ()
needPotato s = method "NeedPotato" s
dollar  = method "Dollar" ()
order f = method "Order" f
food f  = method "Food" f

call_helper join x = call join "Helper" x
call_chef join x   = call join "Chef" x
call_customer join x f = call join "Customer" (x,f)
call_potato join = call join "Potato" ()
call_potatoCuts join   = call join "PotatoCuts" ()
call_potatoPeeled join = call join "PotatoPeeled" ()
call_needPotato join s = call join "NeedPotato" s
call_dollar join  = call join "Dollar" ()
call_order join f = call join "Order" f
call_food join f  = call join "Food" f

potatoShackRules join activeMethod = do
  { x <- newVar :: IO (VAR (Sync Bool))
  ; f <- newVar :: IO (VAR String)
  ; s <- newVar :: IO (VAR String)
  ; let prog =
          translateJoinDefinitions
          [ 
            [helper x, needPotato s, potato] .->. do 
               { v_s <- readVar s
               ; case v_s of
                  "Cut"  -> do { threadDelay 2 -- cut potato
                               ; call_potatoCuts join }
                  "Peel" -> do { threadDelay 4 -- peel potato
                               ; call_potatoPeeled join }
               ; -- putStrLn "Helper worked"
               ; x .=. True }
               
          , ([needPotato s] .\. ([helper x] ++ (map (\_ -> dollar) [1..10]))) .->. do
               { threadDelay 5 -- go buy some potatoes
               ; mapM (\_ -> call_potato join) [1..10]
               ; x .=. True }
                 
          , [chef x, potatoCuts] .->. do 
               { threadDelay 2 -- make fries
               ; call_food join "Fries"
               ; x .=. True }
                        
          , [chef x, potatoPeeled] .->. do 
               { threadDelay 4 -- make baked potato
               ; call_food join "BakedPotato"
               ; x .=. True }
                       
          , ([chef x, order f]) .->. do
               { v_f <- readVar f
               ; let style = case v_f of
                              "Fries"       -> "Cut"
                              "BakedPotato" -> "Peel"   
               ; call_needPotato join style
               ; -- putStrLn "Chef worked"
               ; x .=. True }
   
          , [customer x f, food f] .->. do
               { v_f <- readVar f
               ; case v_f of
                  "Fries"       -> mapM_ (\_ -> call_dollar join) [1..2]
                  "BakedPotato" -> mapM_ (\_ -> call_dollar join) [1..3]
               ; x .=. True }     
          ]   
          
  ; res <- runJoinOnGoal (store join) activeMethod prog
  ; case res of
      Just action -> action
      Nothing     -> return () } 
      
customerRoutine :: Join -> TVar Int -> Int -> String -> IO ()
customerRoutine _ _ 0 _ = return ()
customerRoutine join cnt i f = do
  { x <- (newSync :: IO (Sync Bool))
  ; call_customer join x f
  ; call_order join f
  ; waitSync x
  ; atomically $ inc cnt
  ; customerRoutine join cnt (i-1) f }
  where
    inc cnt = do { v <- readTVar cnt
                 ; writeTVar cnt (v+1) }
  
chefRoutine :: Join -> IO ()
chefRoutine join = do
  { x <- (newSync :: IO (Sync Bool))
  ; call_chef join x
  ; waitSync x
  ; chefRoutine join }
  
helperRoutine :: Join -> IO ()
helperRoutine join = do
  { x <- (newSync :: IO (Sync Bool))
  ; call_helper join x
  ; waitSync x
  ; helperRoutine join }
  
newPotatoShack :: Int -> Int -> IO Join
newPotatoShack potatoes dollars = do
  { jStore <- newJoinStore
  ; let join = Join {store = jStore, rules = potatoShackRules }
  ; mapM_ (\_ -> call_potato join) [1..potatoes] 
  ; mapM_ (\_ -> call_dollar join) [1..dollars] 
  ; return join }
  
-----------------------------------
-- Test --
-----------------------------------

main = test1

numOfCustFries = 2
numOfCustBaked = 2
numOfReturn  = 6
numOfChefs   = 2
numOfHelpers = 2
initPotatoes = 0
initDollars  = 10

total = (numOfCustFries + numOfCustBaked)*numOfReturn

test1 = do 
  { join <- newPotatoShack initPotatoes initDollars
  ; cnt <- newTVarIO 0
  
  ; t1 <- getCurrentTime

  ; mapM_ (\_ -> forkIO $ customerRoutine join cnt numOfReturn "Fries") [1..numOfCustFries]
  ; mapM_ (\_ -> forkIO $ customerRoutine join cnt numOfReturn "BakedPotato") [1..numOfCustBaked]
  ; mapM_ (\_ -> forkIO $ chefRoutine join) [1..numOfChefs]
  ; mapM_ (\_ -> forkIO $ helperRoutine join) [1..numOfHelpers]
    

  ; atomically $ do { x <- readTVar cnt
                    ; if x == total then return ()
                                    else retry }
  
  ; t2 <- getCurrentTime
  
  ; s <- prettyIt $ store join
  ; putStrLn s
  
  ; let diff = diffUTCTime t2 t1
  ; putStrLn $ "\nTime Taken (Sec):\n" ++ (show diff) }