module Main (main) where

import           Choreography
import           Choreography.Network.Http
import           System.Environment        (getArgs)

$(mkLoc "alice")
$(mkLoc "bob")
$(mkLoc "carol")

type Participants = '["alice", "bob", "carol", "jimmy"]
type Worker = '["bob", "carol"]

worker :: Subset Worker Participants
worker = explicitSubset

subChoreography ::  Bool -> Choreo Worker IO ()
subChoreography b = do
    if b then do
      bob `_locally_` putStrLn "Bob says: I still need to work."
      instruction_carol <- (
        bob,
        pure "Alice decided you can go home now.")
        -~> carol @@ nobody
      carol `locally_` \un -> putStrLn $ "Carol received: " ++ un singleton instruction_carol
    else do
      carol `_locally_` putStrLn "Carol says: I still need to work."
      instruction_bob <- (
        carol,
        pure "Alice decided you can go home now.")
        -~> bob @@ nobody
      bob `locally_` \un -> putStrLn $ "Bob received: " ++ un singleton instruction_bob
    return ()

choreography :: Choreo Participants IO ()
choreography = do
    let allParticipants = allOf @Participants
    alice `_locally_` putStrLn "Alice: Please enter who needs to work (bob | alice):"
    decision :: Located '["alice"] Bool <- alice `_locally` fmap (== "bob") getLine
    sharedDecision :: Located Participants Bool <- (alice, decision) ~> allParticipants
    _ <- (worker, (worker, sharedDecision)) `cond` subChoreography
    pure ()

{-
main :: IO ()
main = do
  runChoreo choreography
-}

main :: IO ()
main = do
  [loc] <- getArgs
  _ <- case loc of
    "alice" -> runChoreography cfg choreography "alice"
    "bob"   -> runChoreography cfg choreography "bob"
    "carol" -> runChoreography cfg choreography "carol"
    _       -> error "Unknown location"
  return ()
  where
    cfg =
      mkHttpConfig
        [ ("alice", ("localhost", 4242)),
          ("bob", ("localhost", 4343)),
          ("carol", ("localhost", 4444))
        ]