diff options
author | James Crayne <jim.crayne@gmail.com> | 2019-09-28 13:43:29 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 19:27:53 -0500 |
commit | 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch) | |
tree | 5716463275c2d3e902889db619908ded2a73971c /src/Data/TableMethods.hs | |
parent | add2c76bced51fde5e9917e7449ef52be70faf87 (diff) |
Factor out some new libraries
word64-map:
Data.Word64Map
network-addr:
Network.Address
tox-crypto:
Crypto.Tox
lifted-concurrent:
Control.Concurrent.Lifted.Instrument
Control.Concurrent.Async.Lifted.Instrument
psq-wrap:
Data.Wrapper.PSQInt
Data.Wrapper.PSQ
minmax-psq:
Data.MinMaxPSQ
tasks:
Control.Concurrent.Tasks
kad:
Network.Kademlia
Network.Kademlia.Bootstrap
Network.Kademlia.Routing
Network.Kademlia.CommonAPI
Network.Kademlia.Persistence
Network.Kademlia.Search
Diffstat (limited to 'src/Data/TableMethods.hs')
-rw-r--r-- | src/Data/TableMethods.hs | 105 |
1 files changed, 0 insertions, 105 deletions
diff --git a/src/Data/TableMethods.hs b/src/Data/TableMethods.hs deleted file mode 100644 index e4208a69..00000000 --- a/src/Data/TableMethods.hs +++ /dev/null | |||
@@ -1,105 +0,0 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | {-# LANGUAGE GADTs #-} | ||
3 | {-# LANGUAGE LambdaCase #-} | ||
4 | {-# LANGUAGE PartialTypeSignatures #-} | ||
5 | {-# LANGUAGE RankNTypes #-} | ||
6 | {-# LANGUAGE ScopedTypeVariables #-} | ||
7 | {-# LANGUAGE TupleSections #-} | ||
8 | module Data.TableMethods where | ||
9 | |||
10 | import Data.Functor.Contravariant | ||
11 | import Data.Time.Clock.POSIX | ||
12 | import Data.Word | ||
13 | import qualified Data.IntMap.Strict as IntMap | ||
14 | ;import Data.IntMap.Strict (IntMap) | ||
15 | import qualified Data.Map.Strict as Map | ||
16 | ;import Data.Map.Strict (Map) | ||
17 | import qualified Data.Word64Map as W64Map | ||
18 | ;import Data.Word64Map (Word64Map) | ||
19 | |||
20 | import Data.Wrapper.PSQ as PSQ | ||
21 | |||
22 | type Priority = POSIXTime | ||
23 | |||
24 | data OptionalPriority t tid x | ||
25 | = NoPriority | ||
26 | | HasPriority (Priority -> t x -> ([(tid, Priority, x)], t x)) | ||
27 | |||
28 | -- | The standard lookup table methods. | ||
29 | data TableMethods t tid = TableMethods | ||
30 | { -- | Insert a new /tid/ entry into the transaction table. | ||
31 | tblInsert :: forall a. tid -> a -> Priority -> t a -> t a | ||
32 | -- | Delete transaction /tid/ from the transaction table. | ||
33 | , tblDelete :: forall a. tid -> t a -> t a | ||
34 | -- | Lookup the value associated with transaction /tid/. | ||
35 | , tblLookup :: forall a. tid -> t a -> Maybe a | ||
36 | } | ||
37 | |||
38 | data QMethods t tid x = QMethods | ||
39 | { qTbl :: TableMethods t tid | ||
40 | , qAtMostView :: OptionalPriority t tid x | ||
41 | } | ||
42 | |||
43 | vanillaTable :: TableMethods t tid -> QMethods t tid x | ||
44 | vanillaTable tbl = QMethods tbl NoPriority | ||
45 | |||
46 | priorityTable :: TableMethods t tid | ||
47 | -> (Priority -> t x -> ([(k, Priority, x)], t x)) | ||
48 | -> (k -> x -> tid) | ||
49 | -> QMethods t tid x | ||
50 | priorityTable tbl atmost f = QMethods | ||
51 | { qTbl = tbl | ||
52 | , qAtMostView = HasPriority $ \p t -> case atmost p t of | ||
53 | (es,t') -> (map (\(k,p,a) -> (f k a, p, a)) es, t') | ||
54 | } | ||
55 | |||
56 | -- | Methods for using 'Data.IntMap'. | ||
57 | intMapMethods :: TableMethods IntMap Int | ||
58 | intMapMethods = TableMethods | ||
59 | { tblInsert = \tid a p -> IntMap.insert tid a | ||
60 | , tblDelete = IntMap.delete | ||
61 | , tblLookup = IntMap.lookup | ||
62 | } | ||
63 | |||
64 | -- | Methods for using 'Data.Word64Map'. | ||
65 | w64MapMethods :: TableMethods Word64Map Word64 | ||
66 | w64MapMethods = TableMethods | ||
67 | { tblInsert = \tid a p -> W64Map.insert tid a | ||
68 | , tblDelete = W64Map.delete | ||
69 | , tblLookup = W64Map.lookup | ||
70 | } | ||
71 | |||
72 | -- | Methods for using 'Data.Map' | ||
73 | mapMethods :: Ord tid => TableMethods (Map tid) tid | ||
74 | mapMethods = TableMethods | ||
75 | { tblInsert = \tid a p -> Map.insert tid a | ||
76 | , tblDelete = Map.delete | ||
77 | , tblLookup = Map.lookup | ||
78 | } | ||
79 | |||
80 | -- psqMethods :: PSQKey tid => QMethods (HashPSQ tid Priority) tid x | ||
81 | psqMethods :: PSQKey k => (tid -> k) -> (k -> x -> tid) -> QMethods (PSQ' k Priority) tid x | ||
82 | psqMethods g f = priorityTable (contramap g tbl) PSQ.atMostView f | ||
83 | where | ||
84 | tbl :: PSQKey tid => TableMethods (PSQ' tid Priority) tid | ||
85 | tbl = TableMethods | ||
86 | { tblInsert = PSQ.insert' | ||
87 | , tblDelete = PSQ.delete | ||
88 | , tblLookup = \tid t -> case PSQ.lookup tid t of | ||
89 | Just (p,a) -> Just a | ||
90 | Nothing -> Nothing | ||
91 | } | ||
92 | |||
93 | |||
94 | -- | Change the key type for a lookup table implementation. | ||
95 | -- | ||
96 | -- This can be used with 'intMapMethods' or 'mapMethods' to restrict lookups to | ||
97 | -- only a part of the generated /tid/ value. This is useful for /tid/ types | ||
98 | -- that are especially large due their use for other purposes, such as secure | ||
99 | -- nonces for encryption. | ||
100 | instance Contravariant (TableMethods t) where | ||
101 | -- contramap :: (tid -> t1) -> TableMethods t t1 -> TableMethods t tid | ||
102 | contramap f (TableMethods ins del lookup) = | ||
103 | TableMethods (\k p v t -> ins (f k) p v t) | ||
104 | (\k t -> del (f k) t) | ||
105 | (\k t -> lookup (f k) t) | ||