{-|
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
(Int -> Topic -> ShowS)
-> (Topic -> String) -> ([Topic] -> ShowS) -> Show Topic
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
Eq Topic
-> (Topic -> Topic -> Ordering)
-> (Topic -> Topic -> Bool)
-> (Topic -> Topic -> Bool)
-> (Topic -> Topic -> Bool)
-> (Topic -> Topic -> Bool)
-> (Topic -> Topic -> Topic)
-> (Topic -> Topic -> Topic)
-> Ord 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
$cp1Ord :: Eq Topic
Ord, Topic -> Topic -> Bool
(Topic -> Topic -> Bool) -> (Topic -> Topic -> Bool) -> Eq Topic
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
(String -> Topic) -> IsString 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 (Text -> Topic) -> [Text] -> [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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> 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
"" = Maybe Topic
forall a. Maybe a
Nothing
mkTopic Text
t = Text -> Topic
Topic (Text -> Topic) -> Maybe Text -> Maybe Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
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]
_) = Maybe Text
forall a. Maybe a
Nothing
    validate (a
"+":[a]
_) = Maybe Text
forall a. Maybe a
Nothing
    validate []      = Text -> Maybe Text
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
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
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
Eq Filter
-> (Filter -> Filter -> Ordering)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Filter)
-> (Filter -> Filter -> Filter)
-> Ord 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
$cp1Ord :: Eq Filter
Ord, Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
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
(String -> Filter) -> IsString 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 (Text -> Filter) -> [Text] -> [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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> 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
"" = Maybe Filter
forall a. Maybe a
Nothing
mkFilter Text
t = Text -> Filter
Filter (Text -> Filter) -> Maybe Text -> Maybe Filter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
forall a. (Eq a, IsString a) => [a] -> Maybe Text
validate (Text -> Text -> [Text]
splitOn Text
"/" Text
t)
  where
    validate :: [a] -> Maybe Text
validate [a
"#"]   = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    validate (a
"#":[a]
_) = Maybe Text
forall a. Maybe a
Nothing
    validate []      = Text -> Maybe Text
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
False
    cmp [Text
"#"] (Text
t:[Text]
_) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t = [Text] -> [Text] -> Bool
cmp [Text]
ps [Text]
ts
      | Text
p Text -> Text -> Bool
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