forked from haskell/cabal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
PSQ.hs
93 lines (69 loc) · 2.64 KB
/
PSQ.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
module Distribution.Client.Dependency.Modular.PSQ where
-- Priority search queues.
--
-- I am not yet sure what exactly is needed. But we need a datastructure with
-- key-based lookup that can be sorted. We're using a sequence right now with
-- (inefficiently implemented) lookup, because I think that queue-based
-- opertions and sorting turn out to be more efficiency-critical in practice.
import Control.Applicative
import Data.Foldable
import Data.Function
import Data.List as S hiding (foldr)
import Data.Traversable
import Prelude hiding (foldr)
newtype PSQ k v = PSQ [(k, v)]
deriving (Eq, Show)
instance Functor (PSQ k) where
fmap f (PSQ xs) = PSQ (fmap (\ (k, v) -> (k, f v)) xs)
instance Foldable (PSQ k) where
foldr op e (PSQ xs) = foldr op e (fmap snd xs)
instance Traversable (PSQ k) where
traverse f (PSQ xs) = PSQ <$> traverse (\ (k, v) -> (\ x -> (k, x)) <$> f v) xs
lookup :: Eq k => k -> PSQ k v -> Maybe v
lookup k (PSQ xs) = S.lookup k xs
map :: (v1 -> v2) -> PSQ k v1 -> PSQ k v2
map f (PSQ xs) = PSQ (fmap (\ (k, v) -> (k, f v)) xs)
mapKeys :: (k1 -> k2) -> PSQ k1 v -> PSQ k2 v
mapKeys f (PSQ xs) = PSQ (fmap (\ (k, v) -> (f k, v)) xs)
mapWithKey :: (k -> a -> b) -> PSQ k a -> PSQ k b
mapWithKey f (PSQ xs) = PSQ (fmap (\ (k, v) -> (k, f k v)) xs)
delete :: Eq k => k -> PSQ k a -> PSQ k a
delete k (PSQ xs) = PSQ (snd (partition ((== k) . fst) xs))
fromList :: [(k, a)] -> PSQ k a
fromList = PSQ
cons :: k -> a -> PSQ k a -> PSQ k a
cons k x (PSQ xs) = PSQ ((k, x) : xs)
snoc :: PSQ k a -> k -> a -> PSQ k a
snoc (PSQ xs) k x = PSQ (xs ++ [(k, x)])
casePSQ :: PSQ k a -> r -> (k -> a -> PSQ k a -> r) -> r
casePSQ (PSQ xs) n c =
case xs of
[] -> n
(k, v) : ys -> c k v (PSQ ys)
splits :: PSQ k a -> PSQ k (a, PSQ k a)
splits xs =
casePSQ xs
(PSQ [])
(\ k v ys -> cons k (v, ys) (fmap (\ (w, zs) -> (w, cons k v zs)) (splits ys)))
sortBy :: (a -> a -> Ordering) -> PSQ k a -> PSQ k a
sortBy cmp (PSQ xs) = PSQ (S.sortBy (cmp `on` snd) xs)
sortByKeys :: (k -> k -> Ordering) -> PSQ k a -> PSQ k a
sortByKeys cmp (PSQ xs) = PSQ (S.sortBy (cmp `on` fst) xs)
filterKeys :: (k -> Bool) -> PSQ k a -> PSQ k a
filterKeys p (PSQ xs) = PSQ (S.filter (p . fst) xs)
filter :: (a -> Bool) -> PSQ k a -> PSQ k a
filter p (PSQ xs) = PSQ (S.filter (p . snd) xs)
length :: PSQ k a -> Int
length (PSQ xs) = S.length xs
-- | "Lazy length".
--
-- Only approximates the length, but doesn't force the list.
llength :: PSQ k a -> Int
llength (PSQ []) = 0
llength (PSQ (_:[])) = 1
llength (PSQ (_:_:[])) = 2
llength (PSQ _) = 3
null :: PSQ k a -> Bool
null (PSQ xs) = S.null xs
toList :: PSQ k a -> [(k, a)]
toList (PSQ xs) = xs