mqtt-0.1.1.0: An MQTT protocol implementation.

Copyright(c) Lars Petersen 2016
LicenseMIT
Maintainerinfo@lars-petersen.net
Stabilityexperimental
Safe HaskellSafe
LanguageHaskell2010

Network.MQTT.Trie

Contents

Description

 

Synopsis

Trie

newtype Trie a Source #

The Trie is a map-like data structure designed to hold elements that can efficiently be queried according to the matching rules specified by MQTT. The primary purpose is to manage client subscriptions, but it can just as well be used to manage permissions etc.

The tree consists of nodes that may or may not contain values. The edges are filter components. As some value types have the concept of a null (i.e. an empty set) the TrieValue is a class defining the data family TrieNode. This is a performance and size optimization to avoid unnecessary boxing and case distinction.

Constructors

Trie 

Fields

Instances

(TrieValue a, Eq a) => Eq (Trie a) Source # 

Methods

(==) :: Trie a -> Trie a -> Bool #

(/=) :: Trie a -> Trie a -> Bool #

(TrieValue a, Show a) => Show (Trie a) Source # 

Methods

showsPrec :: Int -> Trie a -> ShowS #

show :: Trie a -> String #

showList :: [Trie a] -> ShowS #

(TrieValue a, Monoid a) => Monoid (Trie a) Source # 

Methods

mempty :: Trie a #

mappend :: Trie a -> Trie a -> Trie a #

mconcat :: [Trie a] -> Trie a #

Binary (Trie ()) Source # 

Methods

put :: Trie () -> Put #

get :: Get (Trie ()) #

putList :: [Trie ()] -> Put #

class TrieValue a where Source #

Minimal complete definition

node, nodeNull, nodeTree, nodeValue

Associated Types

data TrieNode a Source #

null

empty

size

size :: TrieValue a => Trie a -> Int Source #

Count all trie nodes that are not nodeNull.

sizeWith

sizeWith :: TrieValue a => (a -> Int) -> Trie a -> Int Source #

singleton

matchTopic

matchTopic :: TrieValue a => Topic -> Trie a -> Bool Source #

Match a Topic against a Trie.

The function returns true iff the tree contains at least one node that matches the topic and contains a value (including nodes that are indirectly matched by wildcard characters like + and # as described in the MQTT specification).

matchFilter

matchFilter :: TrieValue a => Filter -> Trie a -> Bool Source #

Match a Filter against a Trie.

The function returns true iff the tree contains a path that is less or equally specific than the filter and the terminal node contains a value that is not nodeNull.

match (singleton "#") "a"     = True
match (singleton "#") "+"     = True
match (singleton "#") "a/+/b" = True
match (singleton "#") "a/+/#" = True
match (singleton "+") "a"     = True
match (singleton "+") "+"     = True
match (singleton "+") "+/a"   = False
match (singleton "+") "#"     = False
match (singleton "a") "a"     = True
match (singleton "a") "b"     = False
match (singleton "a") "+"     = False
match (singleton "a") "#"     = False

lookup

lookup :: (TrieValue a, Monoid a) => Topic -> Trie a -> a Source #

Collect all values of nodes that match a given topic (according to the matching rules specified by the MQTT protocol).

findMaxBounded

findMaxBounded :: (TrieValue a, Ord a, Bounded a) => Topic -> Trie a -> Maybe a Source #

Find the greatest value in a trie that matches the topic.

  • Stops search as soon as a maxBound element has been found.
  • Doesn't match into $ topics.

insert

insert :: TrieValue a => Filter -> a -> Trie a -> Trie a Source #

insertWith

insertWith :: TrieValue a => (a -> a -> a) -> Filter -> a -> Trie a -> Trie a Source #

insertFoldable

insertFoldable :: (TrieValue a, Foldable t) => t (Filter, a) -> Trie a -> Trie a Source #

map

map :: (TrieValue a, TrieValue b) => (a -> b) -> Trie a -> Trie b Source #

mapMaybe

mapMaybe :: (TrieValue a, TrieValue b) => (a -> Maybe b) -> Trie a -> Trie b Source #

Applies a functor to a try and removes nodes for which the mapping function returns Nothing.

foldl'

foldl' :: TrieValue b => (a -> b -> a) -> a -> Trie b -> a Source #

delete

delete :: TrieValue a => Filter -> Trie a -> Trie a Source #

union

union :: (TrieValue a, Monoid a) => Trie a -> Trie a -> Trie a Source #

unionWith

unionWith :: TrieValue a => (a -> a -> a) -> Trie a -> Trie a -> Trie a Source #

differenceWith

differenceWith :: (TrieValue a, TrieValue b) => (a -> b -> Maybe a) -> Trie a -> Trie b -> Trie a Source #