Queue.hs

   1 -- This file is part of Diohsc
   2 -- Copyright (C) 2020-23 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Queue where
  12
  13 import           Data.Char  (isAlpha)
  14 import           Data.Maybe
  15 import           Safe       (readMay)
  16
  17 import qualified Data.Map   as M
  18
  19 import           History
  20 import           URI
  21
  22 data QueueItem
  23     = QueueURI (Maybe HistoryOrigin) URI
  24     | QueueHistory HistoryItem
  25
  26 queueUri :: QueueItem -> URI
  27 queueUri (QueueURI _ uri)    = uri
  28 queueUri (QueueHistory item) = historyUri item
  29
  30 type QueueMap = M.Map String [QueueItem]
  31
  32 data QueueSpec = QueueSpec
  33     { queueSpecName :: String
  34     , queueSpecPos  :: Maybe Int
  35     }
  36
  37 parseQueueSpec :: [String] -> Maybe QueueSpec
  38 parseQueueSpec [] = Just $ QueueSpec "" Nothing
  39 parseQueueSpec [a] | Just n <- readMay a = Just . QueueSpec "" $ Just n
  40 parseQueueSpec (a:as) | not (null a), all isAlpha a
  41     , Just mn <- case as of
  42         []                          -> Just Nothing
  43         [a'] | Just n <- readMay a' -> Just (Just n)
  44         _                           -> Nothing
  45     = Just $ QueueSpec a mn
  46 parseQueueSpec _ = Nothing
  47
  48 enqueue :: QueueSpec -> [QueueItem] -> QueueMap -> QueueMap
  49 enqueue _ [] = id
  50 enqueue (QueueSpec qname after) qs =
  51         M.alter (Just . insertInNubbedList after qs queueUri) qname
  52     where
  53         insertInNubbedList :: Eq b => Maybe Int -> [a] -> (a -> b) -> Maybe [a] -> [a]
  54         insertInNubbedList mn as f mbs =
  55             let bs = fromMaybe [] mbs
  56                 (bs',bs'') = maybe (bs,[]) (`splitAt` bs) mn
  57                 del as' = filter $ (`notElem` (f <$> as')) . f
  58             in del as bs' ++ as ++ del as bs''
  59
  60 unqueueFrom :: String -> URI -> QueueMap -> QueueMap
  61 unqueueFrom qname uri = (`M.adjust` qname) . filter $ (/= uri) . queueUri
  62
  63 unqueue :: URI -> QueueMap -> QueueMap
  64 unqueue uri = M.map . filter $ (/= uri) . queueUri