{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.MQTT.Topic (
Filter, unFilter, Topic, unTopic, match,
mkFilter, mkTopic, split, toFilter
) where
import Data.String (IsString (..))
import Data.Text (Text, isPrefixOf, splitOn)
class Splittable a where
split :: a -> [a]
newtype Topic = Topic { Topic -> Text
unTopic :: Text } deriving (Int -> Topic -> ShowS
[Topic] -> ShowS
Topic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Topic] -> ShowS
$cshowList :: [Topic] -> ShowS
show :: Topic -> String
$cshow :: Topic -> String
showsPrec :: Int -> Topic -> ShowS
$cshowsPrec :: Int -> Topic -> ShowS
Show, Eq Topic
Topic -> Topic -> Bool
Topic -> Topic -> Ordering
Topic -> Topic -> Topic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Topic -> Topic -> Topic
$cmin :: Topic -> Topic -> Topic
max :: Topic -> Topic -> Topic
$cmax :: Topic -> Topic -> Topic
>= :: Topic -> Topic -> Bool
$c>= :: Topic -> Topic -> Bool
> :: Topic -> Topic -> Bool
$c> :: Topic -> Topic -> Bool
<= :: Topic -> Topic -> Bool
$c<= :: Topic -> Topic -> Bool
< :: Topic -> Topic -> Bool
$c< :: Topic -> Topic -> Bool
compare :: Topic -> Topic -> Ordering
$ccompare :: Topic -> Topic -> Ordering
Ord, Topic -> Topic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Topic -> Topic -> Bool
$c/= :: Topic -> Topic -> Bool
== :: Topic -> Topic -> Bool
$c== :: Topic -> Topic -> Bool
Eq, String -> Topic
forall a. (String -> a) -> IsString a
fromString :: String -> Topic
$cfromString :: String -> Topic
IsString)
instance Splittable Topic where
split :: Topic -> [Topic]
split (Topic Text
t) = Text -> Topic
Topic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
splitOn Text
"/" Text
t
instance Semigroup Topic where
(Topic Text
a) <> :: Topic -> Topic -> Topic
<> (Topic Text
b) = Text -> Topic
Topic (Text
a forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
b)
mkTopic :: Text -> Maybe Topic
mkTopic :: Text -> Maybe Topic
mkTopic Text
"" = forall a. Maybe a
Nothing
mkTopic Text
t = Text -> Topic
Topic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. (Eq a, IsString a) => [a] -> Maybe Text
validate (Text -> Text -> [Text]
splitOn Text
"/" Text
t)
where
validate :: [a] -> Maybe Text
validate (a
"#":[a]
_) = forall a. Maybe a
Nothing
validate (a
"+":[a]
_) = forall a. Maybe a
Nothing
validate [] = forall a. a -> Maybe a
Just Text
t
validate (a
_:[a]
xs) = [a] -> Maybe Text
validate [a]
xs
newtype Filter = Filter { Filter -> Text
unFilter :: Text } deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, Eq Filter
Filter -> Filter -> Bool
Filter -> Filter -> Ordering
Filter -> Filter -> Filter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Filter -> Filter -> Filter
$cmin :: Filter -> Filter -> Filter
max :: Filter -> Filter -> Filter
$cmax :: Filter -> Filter -> Filter
>= :: Filter -> Filter -> Bool
$c>= :: Filter -> Filter -> Bool
> :: Filter -> Filter -> Bool
$c> :: Filter -> Filter -> Bool
<= :: Filter -> Filter -> Bool
$c<= :: Filter -> Filter -> Bool
< :: Filter -> Filter -> Bool
$c< :: Filter -> Filter -> Bool
compare :: Filter -> Filter -> Ordering
$ccompare :: Filter -> Filter -> Ordering
Ord, Filter -> Filter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq, String -> Filter
forall a. (String -> a) -> IsString a
fromString :: String -> Filter
$cfromString :: String -> Filter
IsString)
instance Splittable Filter where
split :: Filter -> [Filter]
split (Filter Text
f) = Text -> Filter
Filter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
splitOn Text
"/" Text
f
instance Semigroup Filter where
(Filter Text
a) <> :: Filter -> Filter -> Filter
<> (Filter Text
b) = Text -> Filter
Filter (Text
a forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
b)
mkFilter :: Text -> Maybe Filter
mkFilter :: Text -> Maybe Filter
mkFilter Text
"" = forall a. Maybe a
Nothing
mkFilter Text
t = Text -> Filter
Filter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. (Eq a, IsString a) => [a] -> Maybe Text
validate (Text -> Text -> [Text]
splitOn Text
"/" Text
t)
where
validate :: [a] -> Maybe Text
validate [a
"#"] = forall a. a -> Maybe a
Just Text
t
validate (a
"#":[a]
_) = forall a. Maybe a
Nothing
validate [] = forall a. a -> Maybe a
Just Text
t
validate (a
_:[a]
xs) = [a] -> Maybe Text
validate [a]
xs
match :: Filter -> Topic -> Bool
match :: Filter -> Topic -> Bool
match (Filter Text
pat) (Topic Text
top) = [Text] -> [Text] -> Bool
cmp (Text -> Text -> [Text]
splitOn Text
"/" Text
pat) (Text -> Text -> [Text]
splitOn Text
"/" Text
top)
where
cmp :: [Text] -> [Text] -> Bool
cmp [] [] = Bool
True
cmp [] [Text]
_ = Bool
False
cmp [Text
"#"] [] = Bool
True
cmp [Text]
_ [] = Bool
False
cmp [Text
"#"] (Text
t:[Text]
_) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"$" Text -> Text -> Bool
`isPrefixOf` Text
t
cmp (Text
p:[Text]
ps) (Text
t:[Text]
ts)
| Text
p forall a. Eq a => a -> a -> Bool
== Text
t = [Text] -> [Text] -> Bool
cmp [Text]
ps [Text]
ts
| Text
p forall a. Eq a => a -> a -> Bool
== Text
"+" Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"$" Text -> Text -> Bool
`isPrefixOf` Text
t) = [Text] -> [Text] -> Bool
cmp [Text]
ps [Text]
ts
| Bool
otherwise = Bool
False
toFilter :: Topic -> Filter
toFilter :: Topic -> Filter
toFilter (Topic Text
t) = Text -> Filter
Filter Text
t