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
|
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
module Data.Wrapper.PSQ
#if 0
( module Data.Wrapper.PSQ , module Data.PSQueue ) where
import Data.PSQueue hiding (foldr, foldl)
import qualified Data.PSQueue as PSQueue
type PSQKey k = (Ord k)
-- | Wrapper over PSQueue-style foldr to implement a psqueues-style interface.
fold' :: (Ord k, Ord p) => (k -> p -> () -> a -> a) -> a -> PSQ k p -> a
fold' f a q = PSQueue.foldr f' a q
where
f' (k :-> prio) x = f k prio () x
#else
( module Data.Wrapper.PSQ , module HashPSQ ) where
-- import Data.OrdPSQ as OrdPSQ hiding (insert, map, singleton, minView)
-- import qualified Data.OrdPSQ as OrdPSQ
import Data.Hashable
import qualified Data.HashPSQ as Q
;import Data.HashPSQ as HashPSQ hiding (insert, map, minView,
singleton)
import Data.Time.Clock.POSIX (POSIXTime)
-- type PSQ' k p v = HashPSQ k p v
type PSQ' = HashPSQ
type PSQ k p = PSQ' k p ()
type Binding' k p v = (k,p,v)
type Binding k p = Binding' k p ()
type PSQKey k = (Hashable k, Ord k)
pattern (:->) :: k -> p -> Binding k p
pattern k :-> p <- (k,p,_) where k :-> p = (k,p,())
-- I tried defining (::->) :: (k,v) -> p -> Binding' k p v
-- but no luck...
pattern Binding :: k -> v -> p -> Binding' k p v
pattern Binding k v p <- (k,p,v) where Binding k v p = (k,p,v)
key :: (k,p,v) -> k
key (k,p,v) = k
{-# INLINE key #-}
prio :: (k,p,v) -> p
prio (k,p,v) = p
{-# INLINE prio #-}
insert :: (PSQKey k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k p q = Q.insert k p () q
{-# INLINE insert #-}
insert' :: (PSQKey k, Ord p) => k -> v -> p -> PSQ' k p v -> PSQ' k p v
insert' k v p q = Q.insert k p v q
{-# INLINE insert' #-}
insertWith :: (PSQKey k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWith f k p0 q = snd $ Q.alter f' k q
where
f' (Just (p,())) = ((),Just (f p0 p, ()))
f' Nothing = ((),Just (p0,()))
{-# INLINE insertWith #-}
singleton :: (PSQKey k, Ord p) => k -> p -> PSQ k p
singleton k p = Q.singleton k p ()
{-# INLINE singleton #-}
singleton' :: (PSQKey k, Ord p) => k -> v -> p -> PSQ' k p v
singleton' k v p = Q.singleton k p v
{-# INLINE singleton' #-}
minView :: (PSQKey k, Ord p) => PSQ' k p v -> Maybe (Binding' k p v, PSQ' k p v)
minView q = fmap (\(k,p,v,q') -> (Binding k v p, q')) $ Q.minView q
{-# INLINE minView #-}
-- | Utility to convert a 'POSIXTime' delta into microseconds suitable for
-- passing to 'threadDelay'.
toMicroseconds :: POSIXTime -> Int
toMicroseconds = round . (* 1000) . (* 1000)
#endif
|
