From 5c24fa2792e0249101bc1c6de70120c6656dbe1f Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <nerfingen@yahoo.de>
Date: Mon, 24 Aug 2020 22:40:31 +0200
Subject: [PATCH] redesigned TickLeiste. Functions are in progress

---
 src/Data/Queue.hs      |  25 +++++++++
 src/Data/TickLeiste.hs | 114 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 139 insertions(+)
 create mode 100644 src/Data/Queue.hs
 create mode 100644 src/Data/TickLeiste.hs

diff --git a/src/Data/Queue.hs b/src/Data/Queue.hs
new file mode 100644
index 0000000..7393b2c
--- /dev/null
+++ b/src/Data/Queue.hs
@@ -0,0 +1,25 @@
+-- |
+-- Module: Queue
+-- Description: A simple functional Queue
+-- Stability: experimental
+module Data.Queue where
+
+  data Queue a = Queue [a] [a]
+    deriving (Show)
+
+  instance Foldable Queue where
+    foldr f a (Queue xs ys) = foldr f a (xs ++ (reverse ys))
+
+  enqueue :: Queue a -> a -> Queue a
+  enqueue (Queue xs ys) a = Queue (a:xs) ys
+
+  dequeue :: Queue a -> (Queue a,Maybe a)
+  dequeue q@(Queue [] []) = (q,Nothing)
+  dequeue q@(Queue xs (y:ys)) = (Queue xs ys, Just y)
+  dequeue q@(Queue xs@(t:ts) []) = let ys = reverse xs in (Queue [] (tail ys), Just (head ys))
+
+  isEmpty :: Queue a -> Bool
+  isEmpty (Queue [] []) = True
+  isEmpty _             = False
+
+
diff --git a/src/Data/TickLeiste.hs b/src/Data/TickLeiste.hs
new file mode 100644
index 0000000..4f0211d
--- /dev/null
+++ b/src/Data/TickLeiste.hs
@@ -0,0 +1,114 @@
+-- |
+-- Module: TickLeiste
+-- Description: Short Implementation of Splittermonds Tickleiste
+-- Stability: experimental
+module Data.TickLeiste (
+  TickLeiste,
+  newTickLeiste,
+  addPlayer,
+  addTicksToPlayer,
+  isAbwarten,
+  isBereithalten,
+  Player,
+  getPlayerTick,
+  getTickPlayers,
+  getTickValue,
+  Tick (..)
+  ) where
+  import Data.Maybe (fromMaybe)
+  import qualified Data.Map.Strict as M
+  import qualified Data.Text as T
+
+  -- |A Tick is just a number
+  data Tick = Abwarten | Bereithalten | Tick Int
+    deriving (Show, Eq, Ord)
+
+  isAbwarten :: Tick -> Bool
+  isAbwarten Abwarten = True
+  isAbwarten _        = False
+
+  isBereithalten :: Tick -> Bool
+  isBereithalten Bereithalten = True
+  isBereithalten _            = False
+
+  getTickValue :: Tick -> Maybe Int
+  getTickValue (Tick n) = Just n
+  getTickValue _        = Nothing
+  -- |A Player has a name as identifier
+  type Player = T.Text
+
+  -- |The TickLeiste consists of a List of Ticks and for each Tick a
+  -- Queue of players, that play at that turn.
+
+  -- This is a bit wierd as it introduces redundancy, but I don't have a
+  -- better idea.
+  -- NOTE: the first player in the list is the first to move.
+  data TickLeiste = TickLeiste { leiste :: M.Map Tick [Player], player :: M.Map Player Tick }
+    deriving (Show)
+
+  -- |Empty Tickleiste
+  newTickLeiste :: TickLeiste
+  newTickLeiste = TickLeiste M.empty M.empty
+
+  -- |Add a 'Player' to the 'TickLeiste'
+  addPlayer :: Player     -- ^ the Player to add
+            -> Tick       -- ^ the Tick we add the Player to
+            -> TickLeiste -- ^ the TickLeiste we add the player to
+            -> TickLeiste -- ^ the resulting TickLeiste
+  addPlayer p t (TickLeiste l pl) = TickLeiste tlm pm
+    where
+      tlm :: M.Map Tick [Player]
+      tlm = insertPlayerToLeiste p t l
+      pm :: M.Map Player Tick
+      pm = setPlayerTickToPlayer p t pl
+
+  -- | Adds a number of ticks to the player, if the player is not on
+  -- the TickLeiste, Abwarten or Bereithalten then this function returns
+  -- Nothing
+
+  -- Would it be better to return the original 'TickLeiste' instead of 'Nothing'?
+  addTicksToPlayer :: Player -- ^ the Player we want to add ticks to
+                   -> Int   -- ^ the number of Ticks we want to add
+                   -> TickLeiste -- ^ the TickLeiste we want to modify
+                   -> Maybe TickLeiste -- ^ the result
+
+  addTicksToPlayer p t tl@(TickLeiste l pl) = {- fromMaybe tl $ -}do
+    pt  <- pl M.!? p
+    ptv <- getTickValue pt
+    let npt = Tick $ ptv + t
+        tlm = (insertPlayerToLeiste p npt . removePlayerFromLeiste p pt) l
+        pm  = setPlayerTickToPlayer p npt pl
+    return $ TickLeiste tlm pm
+
+
+  -- |We get the tick a 'Player' is on
+  getPlayerTick :: Player -- ^ the 'Player'
+                -> TickLeiste
+                -> Maybe Tick
+  getPlayerTick p (TickLeiste _ pl) = pl M.!? p
+
+  -- |get a list of 'Player' that move at a tick in order.
+  getTickPlayers :: Tick
+                 -> TickLeiste
+                 -> [Player]
+  getTickPlayers t (TickLeiste l _) = fromMaybe [] $ l M.!? t
+                 
+
+  
+  -- this is just an internal helper
+  -- it removes a player from a specific tick, if the player
+  -- wasn't at the tick it is the identity.
+  removePlayerFromLeiste :: Player -> Tick -> M.Map Tick [Player] -> M.Map Tick [Player]
+  removePlayerFromLeiste p t l = fromMaybe l $ do
+    list <- l M.!? t
+    let list' = filter ( /= p) list
+    if null list' then
+      return $ M.delete t l
+    else
+      return $ M.insert t list' l
+
+  insertPlayerToLeiste :: Player -> Tick -> M.Map Tick [Player] -> M.Map Tick [Player]
+  insertPlayerToLeiste p t l = M.insert t (M.findWithDefault [] t l ++ [p]) l
+
+  setPlayerTickToPlayer :: Player -> Tick -> M.Map Player Tick -> M.Map Player Tick
+  setPlayerTickToPlayer = M.insert