{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
{-|
Module      : Program
Description : The main entry point of the implementation. 
Copyright   : (c) Jesper Kuiper, 2021
                  Leander van Boven, 2021
                  Ramon Meffert, 2021
License     : BSD3
-}
module Program

( runProgram,
)

where

import Control.Monad (when)
import System.Console.ANSI
import Data.Char ( isAlpha, toLower )
import Data.Graph.Inductive.Graph (hasLEdge, edges)

import GossipTypes
import GossipGraph
import GossipState
import GossipProtocol
import GossipKnowledge
import Util
import System.Directory (getCurrentDirectory)
import Text.Read (readMaybe)
import Data.List.Split (splitOn)

-- | Determines which color the (a) text is when requesting input from the user.  

--

-- Possible colors:  

-- - Black  

-- - Red  

-- - Green  

-- - Yellow  

-- - Blue  

-- - Magenta  

-- - Cyan  

-- - White

actionColor :: Color
actionColor :: Color
actionColor = Color
Blue

-- | Main entry point to the program.

runProgram :: IO ()
runProgram :: IO ()
runProgram = do
  -- parse GossipGraph from input (cli or txt)

  GossipGraph
tg <- IO GossipGraph
obtainInitialGraph
  let initState :: State
initState = GossipGraph -> GossipKnowledgeStructure -> [Call] -> State
State GossipGraph
tg (GossipGraph -> GossipKnowledgeStructure
fromGossipGraph GossipGraph
tg) []
  String -> IO ()
putStrLn String
"State initialized..."
  State -> IO ()
runAction State
initState
  where
    obtainPredefinedGraph :: IO GossipGraph
    obtainPredefinedGraph :: IO GossipGraph
obtainPredefinedGraph = do
      String -> IO ()
putStrLn String
"testGraph(1), testGraph(2) or biggerGraph(3)?"
      String
g <- IO String
getLine
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
g of
        Char
'1' -> GossipGraph -> IO GossipGraph
forall (m :: * -> *) a. Monad m => a -> m a
return GossipGraph
testGraph
        Char
'2' -> GossipGraph -> IO GossipGraph
forall (m :: * -> *) a. Monad m => a -> m a
return GossipGraph
testGraph2
        Char
'3' -> GossipGraph -> IO GossipGraph
forall (m :: * -> *) a. Monad m => a -> m a
return GossipGraph
biggerGraph
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          IO GossipGraph
obtainPredefinedGraph

    printInitGraphOptions :: IO ()
    printInitGraphOptions :: IO ()
printInitGraphOptions = do
      String -> IO ()
putStr String
"\nLoad ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"p"
      String -> IO ()
putStr String
")redefined graph, load graph from ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"t"
      String -> IO ()
putStr String
")ext file, ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"c"
      String -> IO ()
putStr String
")ustom input or view input ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"f"
      String -> IO ()
putStrLn String
")ormat?"

    printParseGraphRequirements :: IO ()
    printParseGraphRequirements :: IO ()
printParseGraphRequirements = do
      String -> IO ()
putStrLn String
"\nThe input should be of the form:"
      Color -> String -> IO ()
putStrFgc Color
Green String
"n"
      String -> IO ()
putStr String
" [('[a1]',['[na1]','[na2]','...'])], where "
      Color -> String -> IO ()
putStrFgc Color
Green String
"[a1]"
      String -> IO ()
putStr String
" is the name of agent as a char, and "
      Color -> String -> IO ()
putStrFgc Color
Green String
"['[na1]','[na2]','...']"
      String -> IO ()
putStr String
" a list of all the agents, whos number is known by "
      Color -> String -> IO ()
putStrFgc Color
Green String
"'[a1]'"
      String -> IO ()
putStrLn String
"."
      String -> IO ()
putStr String
"The input should contain "
      Color -> String -> IO ()
putStrFgc Color
Red String
"NO"
      String -> IO ()
putStr String
" spaces, except for after "
      Color -> String -> IO ()
putStrFgc Color
Green String
"n"
      String -> IO ()
putStrLn String
"!"

    readGraphText :: IO String
    readGraphText :: IO String
readGraphText = do
      String -> IO ()
putStrLn String
"Input filename below:"
      String
f <- IO String
getLine
      String -> IO String
readFile String
f

    obtainGraphText :: IO String
    obtainGraphText :: IO String
obtainGraphText = do
      String -> IO ()
putStrLn String
"Input graph structure below:"
      IO String
getLine

    parseTextGraph :: String -> IO GossipGraph
    parseTextGraph :: String -> IO GossipGraph
parseTextGraph String
str = do
      let [String
ns,String
rest] = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
" " String
str
      let n :: Int
n = String -> Int
forall a. Read a => String -> a
read String
ns :: Int
      let numbers :: Maybe [(Char, String)]
numbers = String -> Maybe [(Char, String)]
forall a. Read a => String -> Maybe a
readMaybe String
rest :: Maybe [(Char, [Char])]
      case Maybe [(Char, String)]
numbers of 
        Just [(Char, String)]
numbers -> GossipGraph -> IO GossipGraph
forall (m :: * -> *) a. Monad m => a -> m a
return (GossipGraph -> IO GossipGraph) -> GossipGraph -> IO GossipGraph
forall a b. (a -> b) -> a -> b
$ Int -> [(Char, String)] -> GossipGraph
initialGraph Int
n [(Char, String)]
numbers
        Maybe [(Char, String)]
Nothing -> do
          Color -> String -> IO ()
putStrFgc Color
Red String
"Error: "
          String -> IO ()
putStrLn String
"Invalid graph architecture input, using first predefined graph instead."
          GossipGraph -> IO GossipGraph
forall (m :: * -> *) a. Monad m => a -> m a
return GossipGraph
testGraph

    obtainInitialGraph :: IO GossipGraph
    obtainInitialGraph :: IO GossipGraph
obtainInitialGraph = do
      IO ()
printInitGraphOptions
      String
a <- IO String
getLine 
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
a of
        Char
'p' -> IO GossipGraph
obtainPredefinedGraph
        Char
't' -> do
          String
str <- IO String
readGraphText
          String -> IO GossipGraph
parseTextGraph  String
str
        Char
'c' -> do
          String
str <- IO String
obtainGraphText
          String -> IO GossipGraph
parseTextGraph String
str
        Char
'f' -> do
          IO ()
printParseGraphRequirements
          IO GossipGraph
obtainInitialGraph
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          IO GossipGraph
obtainInitialGraph

    printProtocols :: IO ()
    printProtocols :: IO ()
printProtocols = do
      String -> IO ()
putStrLn String
"\nWhat protocol would you like to use?"
      String -> IO ()
putStr String
"Call-("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"a"
      String -> IO ()
putStr String
")ny, ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"l"
      String -> IO ()
putStrLn String
")earn-new-secrets or"
      String -> IO ()
putStr String
"("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"p"
      String -> IO ()
putStrLn String
")ossible-information-growth?"

    obtainProtocol :: IO GossipProtocol
    obtainProtocol :: IO GossipProtocol
obtainProtocol = do
      IO ()
printProtocols
      String
prot <- IO String
getLine
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
prot of
        Char
'a' -> GossipProtocol -> IO GossipProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return GossipProtocol
callAny
        Char
'l' -> GossipProtocol -> IO GossipProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return GossipProtocol
learnNewSecrets
        Char
'p' -> GossipProtocol -> IO GossipProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return GossipProtocol
possibleInformationGrowth
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          IO GossipProtocol
obtainProtocol

    printOperationModes :: IO ()
    printOperationModes :: IO ()
printOperationModes = do
      String -> IO ()
putStrLn String
"\nWhat program operation mode must be used?"
      String -> IO ()
putStr String
"Use ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"u"
      String -> IO ()
putStr String
")seractions, ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"p"
      String -> IO ()
putStr String
")rotocol or ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"h"
      String -> IO ()
putStrLn String
")ybrid?"

    runAction :: State -> IO ()
    runAction :: State -> IO ()
runAction State
s = do
      IO ()
printOperationModes
      String
a <- IO String
getLine
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
a of
        Char
'u' -> State -> IO ()
userActions State
s
        Char
'p' -> do
          GossipProtocol
p <- IO GossipProtocol
obtainProtocol
          Color -> String -> IO ()
putStrFgc Color
Yellow String
"Selected protocol defined as: "
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> GossipProtocol -> String
showProtocol State
s GossipProtocol
p
          GossipProtocol -> State -> IO ()
protocolActions GossipProtocol
p State
s
        Char
'h' -> do
          GossipProtocol
p <- IO GossipProtocol
obtainProtocol
          Color -> String -> IO ()
putStrFgc Color
Yellow String
"Selected protocol defined as: "
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> GossipProtocol -> String
showProtocol State
s GossipProtocol
p
          GossipProtocol -> State -> IO ()
hybridActions GossipProtocol
p State
s
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          State -> IO ()
runAction State
s

-- | Combines both user and protocol actions into one function.

-- Each tick the user may choose to perform a custom action, protocol action or first custom and then protocol action.

hybridActions :: GossipProtocol -> State -> IO ()
hybridActions :: GossipProtocol -> State -> IO ()
hybridActions GossipProtocol
prot State
state = do
  State
newState <- IO State
executeAction
  GossipProtocol -> State -> IO ()
hybridActions GossipProtocol
prot State
newState
  where
    printHybridActions :: IO ()
    printHybridActions :: IO ()
printHybridActions = do
      String -> IO ()
putStrLn String
"Which type of actions would you like to perform?"
      String -> IO ()
putStr String
"Only ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"u"
      String -> IO ()
putStr String
")ser actions, only ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"p"
      String -> IO ()
putStr String
")rotocol actions or ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"b"
      String -> IO ()
putStrLn String
")oth?"

    executeAction :: IO State
    executeAction :: IO State
executeAction = do
      IO ()
printHybridActions
      String
a <- IO String
getLine
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
a of
        Char
'u' -> State -> IO State
performUserAction State
state
        Char
'p' -> GossipProtocol -> State -> IO State
performProtocolAction GossipProtocol
prot State
state
        Char
'b' -> do
          State
s <- State -> IO State
performUserAction State
state
          GossipProtocol -> State -> IO State
performProtocolAction GossipProtocol
prot State
s
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          IO State
executeAction

-- | Continuous execution of user-action.

userActions :: State -> IO ()
userActions :: State -> IO ()
userActions State
state = do
  State
newState <- State -> IO State
performUserAction State
state
  if GossipGraph -> Bool
isGraphComplete (State -> GossipGraph
stateGraph State
newState)
    then do
      Bool
continue <- IO Bool
requestContinuation
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> IO ()
userActions State
newState
    else State -> IO ()
userActions State
newState  -- Recursive call

  where
    requestContinuation :: IO Bool
    requestContinuation :: IO Bool
requestContinuation = do
      IO ()
printGraphComplete
      String -> IO ()
putStr String
"Would you like to continue? ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"y"
      String -> IO ()
putStr String
" / "
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"n"
      String -> IO ()
putStrLn String
")"
      String
a <- IO String
getLine
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (String -> Char
forall a. [a] -> a
head String
a) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'y'

-- | Execute action against GossipGraph:

--

-- Update GossipGraph

--

-- -> Present user with new state (i.e. valuation of observables, current knowledge)

--

-- -> Display implications of the performed action (i.e. what would be rational actions by the agents).

performUserAction :: State -> IO State
performUserAction :: State -> IO State
performUserAction = State -> IO State
executeUserAction
  where
    printCallNotAllowed :: Agent -> Agent -> IO ()
    printCallNotAllowed :: Agent -> Agent -> IO ()
printCallNotAllowed (Int
_,Char
f) (Int
_,Char
t) = do
      String -> IO ()
putStr String
"Call between "
      Color -> String -> IO ()
putStrFgc Color
Red (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
f
      String -> IO ()
putStr String
" and "
      Color -> String -> IO ()
putStrFgc Color
Red (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
t
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" is not allowed as N" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
f] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
t] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not in the statelaw."

    printInvalidCalls :: State -> [Call] -> IO ()
    printInvalidCalls :: State -> [Call] -> IO ()
printInvalidCalls State
state [Call]
calls = do
      Color -> String -> IO ()
putStrLnFgc Color
Red String
"Invalid calls:"
      (Call -> IO ()) -> [Call] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Agent -> Agent -> IO ()) -> Call -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Agent -> Agent -> IO ()
printCallNotAllowed) [Call
c | c :: Call
c@((Int
i, Char
_), (Int
j, Char
_)) <- [Call]
calls, Bool -> Bool
not (GossipGraph -> LEdge Kind -> Bool
forall (gr :: * -> * -> *) b a.
(Graph gr, Eq b) =>
gr a b -> LEdge b -> Bool
hasLEdge (State -> GossipGraph
stateGraph State
state) (Int
i, Int
j, Kind
Number))]

    createCall :: Char -> Char -> Call
    createCall :: Char -> Char -> Call
createCall Char
f Char
t = Char -> Agent
agentFromLab Char
f Agent -> Agent -> Call
☎ Char -> Agent
agentFromLab Char
t

    callsAllowed :: State -> [Call] -> Bool
    callsAllowed :: State -> [Call] -> Bool
callsAllowed State
state [Call]
calls = (Call -> Bool) -> [Call] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ ((Int
i,Char
_), (Int
j, Char
_)) -> GossipGraph -> LEdge Kind -> Bool
forall (gr :: * -> * -> *) b a.
(Graph gr, Eq b) =>
gr a b -> LEdge b -> Bool
hasLEdge (State -> GossipGraph
stateGraph State
state) (Int
i, Int
j, Kind
Number)) [Call]
calls

    obtainCallDetails :: State -> IO [Call]
    obtainCallDetails :: State -> IO [Call]
obtainCallDetails State
s = do
      String -> IO ()
putStrLn String
"\nWho is calling?"
      String
fromStr <- IO String
getLine
      String -> IO ()
putStrLn String
"Who is being called? (multiple agents for groupcall)"
      String
toStr <- IO String
getLine
      let to :: String
to = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlpha String
toStr
      let mainCalls :: [Call]
mainCalls = (Char -> Call) -> String -> [Call]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Call
createCall (Char -> Char -> Call) -> Char -> Char -> Call
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
fromStr) String
to
      if State -> [Call] -> Bool
callsAllowed State
s [Call]
mainCalls
        then [Call] -> IO [Call]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Call] -> IO [Call]) -> [Call] -> IO [Call]
forall a b. (a -> b) -> a -> b
$ [Call]
mainCalls [Call] -> [Call] -> [Call]
forall a. [a] -> [a] -> [a]
++ [Char -> Char -> Call
createCall Char
ta Char
tb | Char
ta <- String
to, Char
tb <- String
to, Char
ta Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
tb]
        else do
          State -> [Call] -> IO ()
printInvalidCalls State
s [Call]
mainCalls
          String -> IO ()
putStrLn String
"Resubmit call details..."
          State -> IO [Call]
obtainCallDetails State
s

    printUserActions :: IO ()
    printUserActions :: IO ()
printUserActions = do
      String -> IO ()
putStrLn String
"\nWhat action would you like to perform?"
      String -> IO ()
putStr String
"Make a ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"c"
      String -> IO ()
putStr String
")all, view ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"p"
      String -> IO ()
putStr String
")ossible calls or view current ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"s"
      String -> IO ()
putStrLn String
")tate?"

    executeUserAction :: State -> IO State
    executeUserAction :: State -> IO State
executeUserAction State
s = do
      IO ()
printUserActions
      String
a <- IO String
getLine
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
a of
        Char
'c' -> do
          [Call]
c <- State -> IO [Call]
obtainCallDetails State
s
          [Call] -> State -> IO State
executeCalls [Call]
c State
s
        Char
'p' -> do
          ([Call], [GroupCall]) -> IO ()
printAllCalls (([Call], [GroupCall]) -> IO ()) -> ([Call], [GroupCall]) -> IO ()
forall a b. (a -> b) -> a -> b
$ GossipGraph -> ([Call], [GroupCall])
validCalls (GossipGraph -> ([Call], [GroupCall]))
-> GossipGraph -> ([Call], [GroupCall])
forall a b. (a -> b) -> a -> b
$ State -> GossipGraph
stateGraph State
s
          String -> IO ()
putStr String
"\n"
          State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
s
        Char
's' -> do
          State -> Bool -> IO ()
printState State
s Bool
False
          State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
s
        Char
other -> do
          Char -> IO ()
printInvalidAction Char
other
          State -> IO State
executeUserAction State
s

-- | Continuous execution of protocol-actions.

protocolActions :: GossipProtocol -> State -> IO ()
protocolActions :: GossipProtocol -> State -> IO ()
protocolActions GossipProtocol
prot State
state = do
  State
newState <- GossipProtocol -> State -> IO State
performProtocolAction GossipProtocol
prot State
state
  if GossipGraph -> Bool
isGraphComplete (State -> GossipGraph
stateGraph State
newState)
    then do
      IO ()
printGraphComplete
      Color -> String -> IO ()
putStrLnFgc Color
Red String
"Stopping protocol..."
      Bool
continue <- IO Bool
requestContinuation
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> IO ()
userActions State
newState
    else GossipProtocol -> State -> IO ()
protocolActions GossipProtocol
prot State
newState  -- Recursive call


  where
    requestContinuation :: IO Bool
    requestContinuation :: IO Bool
requestContinuation = do
      String -> IO ()
putStr String
"Would you like to continue with useractions? ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"y"
      String -> IO ()
putStr String
" / "
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"n"
      String -> IO ()
putStrLn String
")"
      String
a <- IO String
getLine
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (String -> Char
forall a. [a] -> a
head String
a) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'y'

-- | Perform protocol tick:

--

-- Explain the to be performed actions

--

-- -> performProtocolTick

--

-- -> Present user with new state (i.e. valuation of observables, current knowledge).

performProtocolAction :: GossipProtocol -> State -> IO State
performProtocolAction :: GossipProtocol -> State -> IO State
performProtocolAction GossipProtocol
prot State
state = do
  let calls :: ([Call], [GroupCall])
calls = GossipProtocol -> State -> ([Call], [GroupCall])
selectedCalls GossipProtocol
prot State
state

  Color -> String -> IO ()
putStrLnFgc Color
Yellow String
"\nCalls allowed by the protocol for this tick:"
  ([Call], [GroupCall]) -> IO ()
printAllCalls ([Call], [GroupCall])
calls

  State
newState <- ([Call], [GroupCall]) -> State -> IO State
executeCall ([Call], [GroupCall])
calls State
state
  State -> Bool -> IO ()
printState State
newState Bool
True

  Color -> String -> IO ()
putStrLnFgc Color
Green String
"\nPress enter for next tick."
  String
_ <- IO String
getLine

  State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
newState

  where
    executeDirectCall :: [Call] -> State -> IO State
    executeDirectCall :: [Call] -> State -> IO State
executeDirectCall [Call]
d State
s = do
      Call -> IO ()
printMakeCall (Call -> IO ()) -> Call -> IO ()
forall a b. (a -> b) -> a -> b
$ [Call] -> Call
forall a. [a] -> a
head [Call]
d
      String -> IO ()
putStrLn String
""
      State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ (Call -> State -> State) -> State -> Call -> State
forall a b c. (a -> b -> c) -> b -> a -> c
flip Call -> State -> State
makeCall State
s (Call -> State) -> Call -> State
forall a b. (a -> b) -> a -> b
$ [Call] -> Call
forall a. [a] -> a
head [Call]
d

    executeGroupCall :: [GroupCall] -> State -> IO State
    executeGroupCall :: [GroupCall] -> State -> IO State
executeGroupCall [GroupCall]
g State
s = do
      Color -> String -> IO ()
putStrLnFgc Color
Green String
"Making group call:"
      GroupCall -> IO ()
printMakeGroupCall (GroupCall -> IO ()) -> GroupCall -> IO ()
forall a b. (a -> b) -> a -> b
$ [GroupCall] -> GroupCall
forall a. [a] -> a
head [GroupCall]
g
      ([Call] -> State -> IO State) -> State -> [Call] -> IO State
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Call] -> State -> IO State
executeCalls State
s ([Call] -> IO State) -> [Call] -> IO State
forall a b. (a -> b) -> a -> b
$ GroupCall -> [Call]
toCalls (GroupCall -> [Call]) -> GroupCall -> [Call]
forall a b. (a -> b) -> a -> b
$ [GroupCall] -> GroupCall
forall a. [a] -> a
head [GroupCall]
g

    getCallType :: IO String
    getCallType :: IO String
getCallType = do
      String -> IO ()
putStrLn String
"Both direct and group calls possible."
      String -> IO ()
putStr String
"Perform ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"d"
      String -> IO ()
putStr String
")irect call or ("
      Color -> String -> IO ()
putStrFgc Color
actionColor String
"g"
      String -> IO ()
putStrLn String
")roup call?"
      IO String
getLine

    executeCall :: ([Call], [GroupCall]) -> State -> IO State
    -- No calls possible:

    executeCall :: ([Call], [GroupCall]) -> State -> IO State
executeCall ([], []) State
s = do
      String -> IO ()
putStrLn String
"As there is no call allowed, the state will not be updated..."
      State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
s
    -- Only direct calls possible:

    executeCall ([Call]
d, []) State
s = [Call] -> State -> IO State
executeDirectCall [Call]
d State
s
    -- Only groupcalls possible:

    executeCall ([], [GroupCall]
g) State
s = [GroupCall] -> State -> IO State
executeGroupCall [GroupCall]
g State
s
    -- Both direct and groupcalls possible:

    executeCall ([Call]
d,[GroupCall]
g) State
s = do
      String
t <- IO String
getCallType
      case Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
t of
        Char
'd' -> [Call] -> State -> IO State
executeDirectCall [Call]
d State
s
        Char
'g' -> [GroupCall] -> State -> IO State
executeGroupCall [GroupCall]
g State
s