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