-- This file is part of Diohsc -- Copyright (C) 2020-23 Martin Bays -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of version 3 of the GNU General Public License as -- published by the Free Software Foundation, or any later version. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. module Queue where import Data.Char (isAlpha) import Data.Maybe import Safe (readMay) import qualified Data.Map as M import History import URI data QueueItem = QueueURI (Maybe HistoryOrigin) URI | QueueHistory HistoryItem queueUri :: QueueItem -> URI queueUri (QueueURI _ uri) = uri queueUri (QueueHistory item) = historyUri item type QueueMap = M.Map String [QueueItem] data QueueSpec = QueueSpec { queueSpecName :: String , queueSpecPos :: Maybe Int } parseQueueSpec :: [String] -> Maybe QueueSpec parseQueueSpec [] = Just $ QueueSpec "" Nothing parseQueueSpec [a] | Just n <- readMay a = Just . QueueSpec "" $ Just n parseQueueSpec (a:as) | not (null a), all isAlpha a , Just mn <- case as of [] -> Just Nothing [a'] | Just n <- readMay a' -> Just (Just n) _ -> Nothing = Just $ QueueSpec a mn parseQueueSpec _ = Nothing enqueue :: QueueSpec -> [QueueItem] -> QueueMap -> QueueMap enqueue _ [] = id enqueue (QueueSpec qname after) qs = M.alter (Just . insertInNubbedList after qs queueUri) qname where insertInNubbedList :: Eq b => Maybe Int -> [a] -> (a -> b) -> Maybe [a] -> [a] insertInNubbedList mn as f mbs = let bs = fromMaybe [] mbs (bs',bs'') = maybe (bs,[]) (`splitAt` bs) mn del as' = filter $ (`notElem` (f <$> as')) . f in del as bs' ++ as ++ del as bs'' unqueueFrom :: String -> URI -> QueueMap -> QueueMap unqueueFrom qname uri = (`M.adjust` qname) . filter $ (/= uri) . queueUri unqueue :: URI -> QueueMap -> QueueMap unqueue uri = M.map . filter $ (/= uri) . queueUri