{-|
Module      : Network.MQTT.Topic.
Description : MQTT Topic types and utilities.
Copyright   : (c) Dustin Sallings, 2019
License     : BSD3
Maintainer  : dustin@spy.net
Stability   : experimental

Topic and topic related utiilities.
-}

{-# 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 separates a `Filter` or `Topic` into its `/`-separated components.
  split :: a -> [a]

-- | An MQTT topic.
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 creates a topic from a text representation of a valid filter.
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

-- | An MQTT topic filter.
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 creates a filter from a text representation of a valid filter.
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 returns true iff the given pattern can be matched by the
-- specified Topic as defined in the
-- <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718107 MQTT 3.1.1 specification>.
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

-- | Convert a 'Topic' to a 'Filter' as all 'Topic's are valid 'Filter's
toFilter :: Topic -> Filter
toFilter :: Topic -> Filter
toFilter (Topic Text
t) = Text -> Filter
Filter Text
t