{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : GossipGraph
Description : Implements a graph structure for gossip and operations hereon, as defined in (Van Ditmarsch, 2017).
Copyright   : (c) Jesper Kuiper, 2021
                  Leander van Boven, 2021
                  Ramon Meffert, 2021
License     : BSD3
-}

module GossipGraph 
  ( -- * Gossip Graph types

    GossipGraph
  , Kind ( Number, Secret )
  , Relation
  -- * Pre-made graphs

  , testGraph
  , testGraph2
  , biggerGraph
  , defaultGraph
  -- * Graph construction

  , initialGraph
  -- * Graph inspection

  , numbersKnownBy
  , secretsKnownBy
  , hasRelationWith
  , isGraphComplete
  , noAgents
  -- * Agent-specific functions

  , idToLab
  , labToId
  -- * Agent construction

  , agentFromId
  , agentFromLab
  -- * Relation construction

  , relation
  -- * Graph printing

  , printGraph
  ) where


import Control.Arrow ((***))
import Control.Monad (join)
import qualified Data.Char as Char
import Data.Graph.Inductive (Gr, LEdge, LNode, prettyPrint, Graph (noNodes))
import Data.Graph.Inductive.Graph --(Graph (mkGraph), prettify, labNodes, hasLEdge)

import Data.List (find, filter)
import Data.Map (Map, (!))
import Data.Set (Set)
import Data.Tuple (swap)

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import GossipTypes ( AgentName, AgentId, Agent )

-- | An agent relation label, indicating whether x knows the number of y, or x knows the secret of y.

data Kind
  = Number
  | Secret
  deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c== :: Kind -> Kind -> Bool
Eq, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
Show)

-- | A relation between to agents, either knowledge of number or knowledge of secret.

type Relation = LEdge Kind

-- | The gossip graph. This is defined in terms of the `Data.Graph.Inductive.Graph` module. 

type GossipGraph = Gr AgentName Kind

-- | Prints the graph in a readable manner. 

printGraph :: GossipGraph -> IO ()
printGraph :: GossipGraph -> IO ()
printGraph = GossipGraph -> IO ()
forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> IO ()
prettyPrint

-- | Simple graph to be used for testing

testGraph :: GossipGraph
testGraph :: GossipGraph
testGraph = Int -> [(Char, String)] -> GossipGraph
initialGraph Int
3 [(Char
'a',[Char
'a',Char
'b']),(Char
'b',[Char
'b',Char
'c']),(Char
'c',[Char
'c'])]

-- | Another simple graph with slightly different number relations. 

testGraph2 :: GossipGraph
testGraph2 :: GossipGraph
testGraph2 = Int -> [(Char, String)] -> GossipGraph
initialGraph Int
3 [(Char
'a',[Char
'a',Char
'b',Char
'c']),(Char
'b',[Char
'b']),(Char
'c',[Char
'c'])]

-- | A slightly bigger graph, with five instead of three agents. 

biggerGraph :: GossipGraph
biggerGraph :: GossipGraph
biggerGraph = Int -> [(Char, String)] -> GossipGraph
initialGraph Int
5 [(Char
'a', String
"abc"), (Char
'b', String
"be"), (Char
'c', String
"acd"), (Char
'd', String
"ce"), (Char
'e', String
"e")]

-- | A default graph with generic size. In this graph, every agent only knows their own number. 

--

-- >>> defaultGraph 3

-- mkGraph [(0,'a'),(1,'b'),(2,'c')] [(0,0,Number),(0,0,Secret),(1,1,Number),(1,1,Secret),(2,2,Number),(2,2,Secret)]

defaultGraph :: Int -> GossipGraph
defaultGraph :: Int -> GossipGraph
defaultGraph Int
n = Int -> [(Char, String)] -> GossipGraph
initialGraph Int
n ([(Char, String)] -> GossipGraph)
-> [(Char, String)] -> GossipGraph
forall a b. (a -> b) -> a -> b
$ (Int -> (Char, String)) -> [Int] -> [(Char, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
x -> (Int -> Char
idToLab Int
x, [Int -> Char
idToLab Int
x])) [Int
0..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

-- | Generates an initial gossip graph (with no initial shared secrets), based on a list of agents and their known phone numbers. In this initial graph, everyone will only know their own secret.

--

-- >>> initialGraph 2 [('a', "ab"), ('b', "b")]

-- mkGraph [(0,'a'),(1,'b')] [(0,0,Number),(0,0,Secret),(0,1,Number),(1,1,Number),(1,1,Secret)]

initialGraph :: Int -> [(Char, [Char])] -> GossipGraph
initialGraph :: Int -> [(Char, String)] -> GossipGraph
initialGraph Int
nAgents [(Char, String)]
numberLists =
  let agIds :: [Int]
agIds = [Int
0 .. Int
nAgents Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      agLabs :: String
agLabs = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
idToLab [Int]
agIds

      nodes :: [Agent]
      nodes :: [Agent]
nodes = [Int] -> String -> [Agent]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
agIds String
agLabs

      secrets :: [(Int, Int, Kind)]
      secrets :: [(Int, Int, Kind)]
secrets = [Int] -> [Int] -> [Kind] -> [(Int, Int, Kind)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
agIds [Int]
agIds ([Kind] -> [(Int, Int, Kind)]) -> [Kind] -> [(Int, Int, Kind)]
forall a b. (a -> b) -> a -> b
$ Kind -> [Kind]
forall a. a -> [a]
repeat Kind
Secret

      charmap :: Map Char Int
      charmap :: Map Char Int
charmap = [(Char, Int)] -> Map Char Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Char, Int)] -> Map Char Int) -> [(Char, Int)] -> Map Char Int
forall a b. (a -> b) -> a -> b
$ (Agent -> (Char, Int)) -> [Agent] -> [(Char, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Agent -> (Char, Int)
forall a b. (a, b) -> (b, a)
swap [Agent]
nodes

      flatten :: [(Char, [Char])] -> [(Char, Char)]
      flatten :: [(Char, String)] -> [(Char, Char)]
flatten = ((Char, String) -> [(Char, Char)] -> [(Char, Char)])
-> [(Char, Char)] -> [(Char, String)] -> [(Char, Char)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, String) -> [(Char, Char)] -> [(Char, Char)]
forall a b. (a, [b]) -> [(a, b)] -> [(a, b)]
fun []
        where fun :: (a, [b]) -> [(a, b)] -> [(a, b)]
fun (a, [b])
tup = [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
(++) [((a, [b]) -> a
forall a b. (a, b) -> a
fst (a, [b])
tup, b
x) | b
x <- (a, [b]) -> [b]
forall a b. (a, b) -> b
snd (a, [b])
tup]

      tupCharToInt :: (Char, Char) -> (Int, Int)
      tupCharToInt :: (Char, Char) -> (Int, Int)
tupCharToInt = ((Char -> Int) -> (Char -> Int) -> (Char, Char) -> (Int, Int))
-> (Char -> Int) -> (Char, Char) -> (Int, Int)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Char -> Int) -> (Char -> Int) -> (Char, Char) -> (Int, Int)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (Map Char Int
charmap Map Char Int -> Char -> Int
forall k a. Ord k => Map k a -> k -> a
!)

      withKind :: (Int, Int) -> (Int, Int, Kind)
      withKind :: (Int, Int) -> (Int, Int, Kind)
withKind (Int, Int)
tup = ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
tup, (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
tup, Kind
Number)

      numbers :: [(Int, Int, Kind)]
      numbers :: [(Int, Int, Kind)]
numbers = (((Char, Char) -> (Int, Int, Kind))
-> [(Char, Char)] -> [(Int, Int, Kind)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> (Int, Int, Kind)
withKind ((Int, Int) -> (Int, Int, Kind))
-> ((Char, Char) -> (Int, Int)) -> (Char, Char) -> (Int, Int, Kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> (Int, Int)
tupCharToInt) ([(Char, Char)] -> [(Int, Int, Kind)])
-> ([(Char, String)] -> [(Char, Char)])
-> [(Char, String)]
-> [(Int, Int, Kind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, String)] -> [(Char, Char)]
flatten) [(Char, String)]
numberLists
   in [Agent] -> [(Int, Int, Kind)] -> GossipGraph
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [Agent]
nodes ([(Int, Int, Kind)]
secrets [(Int, Int, Kind)] -> [(Int, Int, Kind)] -> [(Int, Int, Kind)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int, Kind)]
numbers)

-- | Converts an agent ID to an agent label. 

--

-- >>> idToLab 0

-- 'a'

-- >>> idToLab 12

-- 'm'

idToLab :: Int -> Char
idToLab :: Int -> Char
idToLab = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)

-- | Converts an agent label to an agent ID.

--

-- >>> labToId 'a'

-- 0

-- >>> labToId 'w'

-- 22

labToId :: Char -> Int
labToId :: Char -> Int
labToId = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int
97 (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Checks whether two agents have some relation, either secret or number. 

hasRelationWith :: GossipGraph -> Agent -> Kind -> Agent -> Bool
hasRelationWith :: GossipGraph -> Agent -> Kind -> Agent -> Bool
hasRelationWith GossipGraph
g (Int
ag1, Char
_) Kind
kind (Int
ag2, Char
_) = GossipGraph -> (Int, Int, Kind) -> Bool
forall (gr :: * -> * -> *) b a.
(Graph gr, Eq b) =>
gr a b -> LEdge b -> Bool
hasLEdge GossipGraph
g (Int
ag1, Int
ag2, Kind
kind)

-- | Returns the list of agents of which an agent knows the number, given a gossip graph. 

numbersKnownBy :: GossipGraph -> Agent -> [Agent]
--numbersKnownBy graph agent = filter (hasRelationWith graph agent Number) (labNodes graph)

numbersKnownBy :: GossipGraph -> Agent -> [Agent]
numbersKnownBy GossipGraph
graph Agent
agent = ((Int, Kind) -> Agent) -> [(Int, Kind)] -> [Agent]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Agent
agentFromId (Int -> Agent) -> ((Int, Kind) -> Int) -> (Int, Kind) -> Agent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Kind) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Kind)] -> [Agent]) -> [(Int, Kind)] -> [Agent]
forall a b. (a -> b) -> a -> b
$ ((Int, Kind) -> Bool) -> [(Int, Kind)] -> [(Int, Kind)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
(==) Kind
Number (Kind -> Bool) -> ((Int, Kind) -> Kind) -> (Int, Kind) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Kind) -> Kind
forall a b. (a, b) -> b
snd) (GossipGraph -> Int -> [(Int, Kind)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc GossipGraph
graph (Int -> [(Int, Kind)]) -> Int -> [(Int, Kind)]
forall a b. (a -> b) -> a -> b
$ Agent -> Int
forall a b. (a, b) -> a
fst Agent
agent)

-- | Returns the list of agents of which an agent knows the secret, given a gossip graph. 

secretsKnownBy :: GossipGraph -> Agent -> [Agent]
secretsKnownBy :: GossipGraph -> Agent -> [Agent]
secretsKnownBy GossipGraph
graph Agent
agent = ((Int, Kind) -> Agent) -> [(Int, Kind)] -> [Agent]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Agent
agentFromId (Int -> Agent) -> ((Int, Kind) -> Int) -> (Int, Kind) -> Agent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Kind) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Kind)] -> [Agent]) -> [(Int, Kind)] -> [Agent]
forall a b. (a -> b) -> a -> b
$ ((Int, Kind) -> Bool) -> [(Int, Kind)] -> [(Int, Kind)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
(==) Kind
Secret (Kind -> Bool) -> ((Int, Kind) -> Kind) -> (Int, Kind) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Kind) -> Kind
forall a b. (a, b) -> b
snd) (GossipGraph -> Int -> [(Int, Kind)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc GossipGraph
graph (Int -> [(Int, Kind)]) -> Int -> [(Int, Kind)]
forall a b. (a -> b) -> a -> b
$ Agent -> Int
forall a b. (a, b) -> a
fst Agent
agent)

-- | Returns the amount of agents that are present in a gossip graph. 

--

-- >>> noAgents testGraph

-- 3

noAgents :: GossipGraph -> Int
noAgents :: GossipGraph -> Int
noAgents = GossipGraph -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
noNodes

-- | Creates an agent. Warning, ignores the Char argument! Remains for legacy purposes. 

agent :: Int -> Char -> Agent
agent :: Int -> Char -> Agent
agent Int
_id Char
_ = Int -> Agent
agentFromId Int
_id

-- | Generates an agent, based on its ID. 

--

-- >>> agentFromId 0

-- (0, 'a')

-- >>> agentFromId 2

-- (2, 'c')

agentFromId :: Int -> Agent
agentFromId :: Int -> Agent
agentFromId Int
id = (Int
id, Int -> Char
idToLab Int
id)

-- | Generates an agent, based on its label character. 

--

-- >>> agentFromLab 'a'

-- (0, 'a')

-- >>> agentFromLab 'd'

-- (3, 'd')

agentFromLab :: Char -> Agent
agentFromLab :: Char -> Agent
agentFromLab Char
lab = (Char -> Int
labToId Char
lab, Char
lab)

-- | Generates a relation between to agents, given a relation kind. 

relation :: Agent -> Agent -> Kind -> Relation
relation :: Agent -> Agent -> Kind -> (Int, Int, Kind)
relation (Int
from, Char
_) (Int
to, Char
_) Kind
kind = (Int
from, Int
to, Kind
kind)

-- | Given a list of agents and a name, try to find a matching agent

findAgentByName :: [Agent] -> AgentName -> Maybe Agent
findAgentByName :: [Agent] -> Char -> Maybe Agent
findAgentByName [Agent]
agents Char
name =
  (Agent -> Bool) -> [Agent] -> Maybe Agent
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Agent
a -> Agent -> Char
forall a. (a, Char) -> Char
getCharName Agent
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
Char.toUpper Char
name) [Agent]
agents
  where
    getCharName :: (a, Char) -> Char
getCharName (a
_, Char
n) = Char -> Char
Char.toUpper Char
n

-- | Check whether each agent is an expert; i.e. knows the secret of everyone.

isGraphComplete :: GossipGraph -> Bool
isGraphComplete :: GossipGraph -> Bool
isGraphComplete GossipGraph
g = [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GossipGraph -> [(Int, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges GossipGraph
g) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* GossipGraph -> Int
noAgents GossipGraph
g Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2 --ufold ((&&) . isExpert (noAgents g)) True g


    -- isExpert :: Int -> ([(Kind, Node)], Node, AgentName, [(Kind, Node)]) -> Bool

    -- isExpert n c@(i, _, _, _) = length i == n * 2


-- === Parsing stuff below === --


-- | Possible tokens in the input string

data LexToken
  = Token Kind AgentName AgentId
  | Separator
  deriving (LexToken -> LexToken -> Bool
(LexToken -> LexToken -> Bool)
-> (LexToken -> LexToken -> Bool) -> Eq LexToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexToken -> LexToken -> Bool
$c/= :: LexToken -> LexToken -> Bool
== :: LexToken -> LexToken -> Bool
$c== :: LexToken -> LexToken -> Bool
Eq, Int -> LexToken -> ShowS
[LexToken] -> ShowS
LexToken -> String
(Int -> LexToken -> ShowS)
-> (LexToken -> String) -> ([LexToken] -> ShowS) -> Show LexToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LexToken] -> ShowS
$cshowList :: [LexToken] -> ShowS
show :: LexToken -> String
$cshow :: LexToken -> String
showsPrec :: Int -> LexToken -> ShowS
$cshowsPrec :: Int -> LexToken -> ShowS
Show)

-- | Lexing for gossip graph input

lexer :: String -> Maybe [LexToken]
lexer :: String -> Maybe [LexToken]
lexer String
input =
  Int -> String -> Maybe [LexToken]
charLexer Int
0 (String -> Maybe [LexToken]) -> String -> Maybe [LexToken]
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
input
  where
    charLexer :: AgentId -> String -> Maybe [LexToken]
    charLexer :: Int -> String -> Maybe [LexToken]
charLexer Int
_id String
chars =
      case String
chars of
        [] ->
          [LexToken] -> Maybe [LexToken]
forall a. a -> Maybe a
Just []
        Char
c : String
cs ->
          if Char -> Bool
Char.isAlpha Char
c
            then case Int -> String -> Maybe [LexToken]
charLexer Int
_id String
cs of
              Just [LexToken]
tokens ->
                if Char -> Bool
Char.isUpper Char
c
                  then [LexToken] -> Maybe [LexToken]
forall a. a -> Maybe a
Just ([LexToken] -> Maybe [LexToken]) -> [LexToken] -> Maybe [LexToken]
forall a b. (a -> b) -> a -> b
$ Kind -> Char -> Int -> LexToken
Token Kind
Secret Char
c Int
_id LexToken -> [LexToken] -> [LexToken]
forall a. a -> [a] -> [a]
: [LexToken]
tokens
                  else [LexToken] -> Maybe [LexToken]
forall a. a -> Maybe a
Just ([LexToken] -> Maybe [LexToken]) -> [LexToken] -> Maybe [LexToken]
forall a b. (a -> b) -> a -> b
$ Kind -> Char -> Int -> LexToken
Token Kind
Number Char
c Int
_id LexToken -> [LexToken] -> [LexToken]
forall a. a -> [a] -> [a]
: [LexToken]
tokens
              Maybe [LexToken]
Nothing ->
                Maybe [LexToken]
forall a. Maybe a
Nothing
            else
              if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
                then case Int -> String -> Maybe [LexToken]
charLexer (Int
_id Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
cs of
                  Just [LexToken]
tokens ->
                    [LexToken] -> Maybe [LexToken]
forall a. a -> Maybe a
Just ([LexToken] -> Maybe [LexToken]) -> [LexToken] -> Maybe [LexToken]
forall a b. (a -> b) -> a -> b
$ LexToken
Separator LexToken -> [LexToken] -> [LexToken]
forall a. a -> [a] -> [a]
: [LexToken]
tokens
                  Maybe [LexToken]
Nothing ->
                    Maybe [LexToken]
forall a. Maybe a
Nothing
                else Maybe [LexToken]
forall a. Maybe a
Nothing

-- | Extract the agents from the lexed input string

parseAgents :: [LexToken] -> Maybe [Agent]
parseAgents :: [LexToken] -> Maybe [Agent]
parseAgents [LexToken]
tokens =
  [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
tokens Set Char
forall a. Set a
Set.empty Set Char
forall a. Set a
Set.empty (-Int
1) Int
1 Int
1
    Maybe [Agent] -> ([Agent] -> Maybe [Agent]) -> Maybe [Agent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Agent] -> Maybe [Agent]
validateNumberOfAgents
  where
    maybeAddName :: LexToken -> Set Char -> Set Char
maybeAddName LexToken
el Set Char
acc =
      case LexToken
el of
        Token Kind
_ Char
n Int
_ ->
          Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert (Char -> Char
Char.toUpper Char
n) Set Char
acc
        LexToken
_ ->
          Set Char
acc

    agentNames :: Set Char
agentNames = (LexToken -> Set Char -> Set Char)
-> Set Char -> [LexToken] -> Set Char
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LexToken -> Set Char -> Set Char
maybeAddName Set Char
forall a. Set a
Set.empty [LexToken]
tokens

    numberOfSegments :: Int
numberOfSegments = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [LexToken] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LexToken] -> Int) -> [LexToken] -> Int
forall a b. (a -> b) -> a -> b
$ (LexToken -> Bool) -> [LexToken] -> [LexToken]
forall a. (a -> Bool) -> [a] -> [a]
filter (LexToken -> LexToken -> Bool
forall a. Eq a => a -> a -> Bool
== LexToken
Separator) [LexToken]
tokens

    validateNumberOfAgents :: [Agent] -> Maybe [Agent]
    validateNumberOfAgents :: [Agent] -> Maybe [Agent]
validateNumberOfAgents [Agent]
agents
      -- No secrets, so ???

      | Int
numberOfNames Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe [Agent]
forall a. Maybe a
Nothing
      -- More segments than agents

      | Int
numberOfAgents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numberOfSegments = Maybe [Agent]
forall a. Maybe a
Nothing
      -- Different number of agents than names ???

      | Int
numberOfAgents Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
numberOfNames = Maybe [Agent]
forall a. Maybe a
Nothing
      -- All above is false, so input is correct

      | Bool
otherwise = [Agent] -> Maybe [Agent]
forall a. a -> Maybe a
Just [Agent]
agents
      where
        numberOfNames :: Int
numberOfNames = Set Char -> Int
forall a. Set a -> Int
Set.size Set Char
agentNames
        numberOfAgents :: Int
numberOfAgents = [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
agents

    parser ::
      [LexToken] ->
      Set.Set AgentName ->
      Set.Set AgentName ->
      AgentId ->
      Int ->
      Int ->
      Maybe [Agent]
    parser :: [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
ts Set Char
segmentNames Set Char
allNames Int
highestIdAdded Int
segmentStart Int
pos =
      case [LexToken]
ts of
        [] ->
          [Agent] -> Maybe [Agent]
forall a. a -> Maybe a
Just []
        LexToken
token : [LexToken]
rest ->
          case LexToken
token of
            Token Kind
kind Char
_name Int
_id ->
              if Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Char
ucName Set Char
segmentNames
                then -- Duplicate agent name in a segment

                  Maybe [Agent]
forall a. Maybe a
Nothing
                else
                  if Kind
kind Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
Number
                    then -- number relation, so just add it to the list of segment names and continue


                      [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
rest (Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert Char
ucName Set Char
segmentNames) Set Char
allNames Int
highestIdAdded Int
segmentStart (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        Maybe [Agent] -> ([Agent] -> Maybe [Agent]) -> Maybe [Agent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Agent] -> Maybe [Agent]
forall a. a -> Maybe a
Just
                    else -- secret relation

                      if Int
_id Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
highestIdAdded Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Char
ucName Set Char
allNames)
                        then -- an agent name we haven't seen before! add it to the list.


                          [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
rest (Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert Char
ucName Set Char
segmentNames) (Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert Char
ucName Set Char
allNames) Int
_id Int
segmentStart (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            Maybe [Agent] -> ([Agent] -> Maybe [Agent]) -> Maybe [Agent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[Agent]
list -> [Agent] -> Maybe [Agent]
forall a. a -> Maybe a
Just (Int -> Char -> Agent
agent Int
_id Char
ucName Agent -> [Agent] -> [Agent]
forall a. a -> [a] -> [a]
: [Agent]
list))
                        else -- an agent name we have seen before. BORING! just continue.


                          [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
rest (Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert Char
ucName Set Char
segmentNames) Set Char
allNames Int
highestIdAdded Int
segmentStart (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            Maybe [Agent] -> ([Agent] -> Maybe [Agent]) -> Maybe [Agent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Agent] -> Maybe [Agent]
forall a. a -> Maybe a
Just
              where
                ucName :: AgentName
                ucName :: Char
ucName = Char -> Char
Char.toUpper Char
_name
            LexToken
Separator ->
              case [LexToken] -> LexToken
forall a. [a] -> a
head [LexToken]
rest of
                LexToken
Separator ->
                  Maybe [Agent]
forall a. Maybe a
Nothing
                LexToken
_ ->
                  [LexToken]
-> Set Char -> Set Char -> Int -> Int -> Int -> Maybe [Agent]
parser [LexToken]
rest Set Char
forall a. Set a
Set.empty Set Char
allNames Int
highestIdAdded (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Extract the relations from the parsed agents and the lexed input string

parseRelations :: [Agent] -> [LexToken] -> Maybe [Relation]
parseRelations :: [Agent] -> [LexToken] -> Maybe [(Int, Int, Kind)]
parseRelations [Agent]
agents [LexToken]
tokens =
  case [LexToken]
tokens of
    [] ->
      [(Int, Int, Kind)] -> Maybe [(Int, Int, Kind)]
forall a. a -> Maybe a
Just []
    LexToken
Separator : [LexToken]
rest ->
      [Agent] -> [LexToken] -> Maybe [(Int, Int, Kind)]
parseRelations [Agent]
agents [LexToken]
rest
    Token Kind
kind Char
name Int
_id : [LexToken]
rest ->
      case [Agent] -> [LexToken] -> Maybe [(Int, Int, Kind)]
parseRelations [Agent]
agents [LexToken]
rest of
        Just [(Int, Int, Kind)]
relations ->
          case [Agent] -> Char -> Maybe Agent
findAgentByName [Agent]
agents Char
name of
            Just Agent
ag ->
              [(Int, Int, Kind)] -> Maybe [(Int, Int, Kind)]
forall a. a -> Maybe a
Just ([(Int, Int, Kind)] -> Maybe [(Int, Int, Kind)])
-> [(Int, Int, Kind)] -> Maybe [(Int, Int, Kind)]
forall a b. (a -> b) -> a -> b
$ Agent -> Agent -> Kind -> (Int, Int, Kind)
relation (Int -> Char -> Agent
agent Int
_id Char
name) Agent
ag Kind
kind (Int, Int, Kind) -> [(Int, Int, Kind)] -> [(Int, Int, Kind)]
forall a. a -> [a] -> [a]
: [(Int, Int, Kind)]
relations
            Maybe Agent
Nothing ->
              Maybe [(Int, Int, Kind)]
forall a. Maybe a
Nothing
        Maybe [(Int, Int, Kind)]
Nothing ->
          Maybe [(Int, Int, Kind)]
forall a. Maybe a
Nothing

-- | Try to parse a string representation of a gossip graph into a gossip graph

fromString :: String -> Maybe (Gr AgentName Kind)
fromString :: String -> Maybe GossipGraph
fromString String
input =
  case (Maybe [Agent]
agents, Maybe [(Int, Int, Kind)]
relations) of
    (Just [Agent]
ag, Just [(Int, Int, Kind)]
rel) ->
      GossipGraph -> Maybe GossipGraph
forall a. a -> Maybe a
Just (GossipGraph -> Maybe GossipGraph)
-> GossipGraph -> Maybe GossipGraph
forall a b. (a -> b) -> a -> b
$ [Agent] -> [(Int, Int, Kind)] -> GossipGraph
fromAgentsAndRelations [Agent]
ag [(Int, Int, Kind)]
rel
    (Maybe [Agent], Maybe [(Int, Int, Kind)])
_ ->
      Maybe GossipGraph
forall a. Maybe a
Nothing
  where
    lexresult :: Maybe [LexToken]
lexresult = String -> Maybe [LexToken]
lexer String
input
    agents :: Maybe [Agent]
agents = Maybe [LexToken]
lexresult Maybe [LexToken] -> ([LexToken] -> Maybe [Agent]) -> Maybe [Agent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [LexToken] -> Maybe [Agent]
parseAgents
    relations :: Maybe [(Int, Int, Kind)]
relations =
      case Maybe [Agent]
agents of
        Just [Agent]
ag ->
          Maybe [LexToken]
lexresult Maybe [LexToken]
-> ([LexToken] -> Maybe [(Int, Int, Kind)])
-> Maybe [(Int, Int, Kind)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Agent] -> [LexToken] -> Maybe [(Int, Int, Kind)]
parseRelations [Agent]
ag
        Maybe [Agent]
_ ->
          Maybe [(Int, Int, Kind)]
forall a. Maybe a
Nothing

-- | Given a set of agents and corresponding relations, construct a gossip graph

fromAgentsAndRelations :: [Agent] -> [Relation] -> Gr AgentName Kind
fromAgentsAndRelations :: [Agent] -> [(Int, Int, Kind)] -> GossipGraph
fromAgentsAndRelations = [Agent] -> [(Int, Int, Kind)] -> GossipGraph
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph

-- | Debugging function to check if parsing was successful

toStringIfSuccessful :: Maybe (Gr Agent Relation) -> String
toStringIfSuccessful :: Maybe (Gr Agent (Int, Int, Kind)) -> String
toStringIfSuccessful Maybe (Gr Agent (Int, Int, Kind))
graph =
  case Maybe (Gr Agent (Int, Int, Kind))
graph of
    Just Gr Agent (Int, Int, Kind)
g ->
      Gr Agent (Int, Int, Kind) -> String
forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> String
prettify Gr Agent (Int, Int, Kind)
g
    Maybe (Gr Agent (Int, Int, Kind))
_ ->
      String
"Failed to generate a gossip graph"