diohsc-0.1.14: Queue.hs

-- This file is part of Diohsc
-- Copyright (C) 2020-23 Martin Bays <mbays@sdf.org>
--
-- 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