{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Network.AMQP.Worker.Key
    ( Key (..)
    , Binding (..)
    , Routing
    , key
    , word
    , any1
    , many
    , keyText
    , fromBind
    , toBind
    , toBindingKey
    , RequireRouting
    ) where

import Data.Kind (Constraint, Type)
import qualified Data.List as List
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.TypeLits (ErrorMessage (..), TypeError)

-- | Messages are published with a specific identifier called a Routing key. Queues can use Binding Keys to control which messages are delivered to them.
--
-- Routing keys have no dynamic component and can be used to publish messages
--
-- > commentsKey :: Key Routing Comment
-- > commentsKey = key "posts" & word "new"
--
-- Binding keys can contain wildcards, only used for matching messages
--
-- > commentsKey :: Key Binding Comment
-- > commentsKey = key "posts" & any1 & word "comments" & many
newtype Key a msg = Key [Binding]
    deriving (Key a msg -> Key a msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a msg. Key a msg -> Key a msg -> Bool
/= :: Key a msg -> Key a msg -> Bool
$c/= :: forall a msg. Key a msg -> Key a msg -> Bool
== :: Key a msg -> Key a msg -> Bool
$c== :: forall a msg. Key a msg -> Key a msg -> Bool
Eq, Int -> Key a msg -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a msg. Int -> Key a msg -> ShowS
forall a msg. [Key a msg] -> ShowS
forall a msg. Key a msg -> String
showList :: [Key a msg] -> ShowS
$cshowList :: forall a msg. [Key a msg] -> ShowS
show :: Key a msg -> String
$cshow :: forall a msg. Key a msg -> String
showsPrec :: Int -> Key a msg -> ShowS
$cshowsPrec :: forall a msg. Int -> Key a msg -> ShowS
Show, NonEmpty (Key a msg) -> Key a msg
Key a msg -> Key a msg -> Key a msg
forall b. Integral b => b -> Key a msg -> Key a msg
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a msg. NonEmpty (Key a msg) -> Key a msg
forall a msg. Key a msg -> Key a msg -> Key a msg
forall a msg b. Integral b => b -> Key a msg -> Key a msg
stimes :: forall b. Integral b => b -> Key a msg -> Key a msg
$cstimes :: forall a msg b. Integral b => b -> Key a msg -> Key a msg
sconcat :: NonEmpty (Key a msg) -> Key a msg
$csconcat :: forall a msg. NonEmpty (Key a msg) -> Key a msg
<> :: Key a msg -> Key a msg -> Key a msg
$c<> :: forall a msg. Key a msg -> Key a msg -> Key a msg
Semigroup, Key a msg
[Key a msg] -> Key a msg
Key a msg -> Key a msg -> Key a msg
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a msg. Semigroup (Key a msg)
forall a msg. Key a msg
forall a msg. [Key a msg] -> Key a msg
forall a msg. Key a msg -> Key a msg -> Key a msg
mconcat :: [Key a msg] -> Key a msg
$cmconcat :: forall a msg. [Key a msg] -> Key a msg
mappend :: Key a msg -> Key a msg -> Key a msg
$cmappend :: forall a msg. Key a msg -> Key a msg -> Key a msg
mempty :: Key a msg
$cmempty :: forall a msg. Key a msg
Monoid)

data Routing

data Binding
    = Word Text
    | Any
    | Many
    deriving (Binding -> Binding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show)

fromBind :: Binding -> Text
fromBind :: Binding -> Text
fromBind (Word Text
t) = Text
t
fromBind Binding
Any = Text
"*"
fromBind Binding
Many = Text
"#"

toBind :: Text -> Binding
toBind :: Text -> Binding
toBind = Text -> Binding
Word

keyText :: Key a msg -> Text
keyText :: forall a msg. Key a msg -> Text
keyText (Key [Binding]
ns) =
    Text -> [Text] -> Text
Text.intercalate Text
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map Binding -> Text
fromBind forall a b. (a -> b) -> a -> b
$ [Binding]
ns

-- | Match any one word. Equivalent to `*`. Converts to a Binding key and can no longer be used to publish messaages
any1 :: Key a msg -> Key Binding msg
any1 :: forall a msg. Key a msg -> Key Binding msg
any1 (Key [Binding]
ws) = forall a msg. [Binding] -> Key a msg
Key ([Binding]
ws forall a. [a] -> [a] -> [a]
++ [Binding
Any])

-- | Match zero or more words. Equivalient to `#`. Converts to a Binding key and can no longer be used to publish messages
many :: Key a msg -> Key Binding msg
many :: forall a msg. Key a msg -> Key Binding msg
many (Key [Binding]
ws) = forall a msg. [Binding] -> Key a msg
Key ([Binding]
ws forall a. [a] -> [a] -> [a]
++ [Binding
Many])

-- | A specific word. Can be used to chain Routing keys or Binding keys
word :: Text -> Key a msg -> Key a msg
word :: forall a msg. Text -> Key a msg -> Key a msg
word Text
w (Key [Binding]
ws) = forall a msg. [Binding] -> Key a msg
Key forall a b. (a -> b) -> a -> b
$ [Binding]
ws forall a. [a] -> [a] -> [a]
++ [Text -> Binding
toBind Text
w]

-- | Start a new routing key (can also be used for bindings)
key :: Text -> Key Routing msg
key :: forall msg. Text -> Key Routing msg
key Text
t = forall a msg. [Binding] -> Key a msg
Key [Text -> Binding
Word Text
t]

-- | We can convert Routing Keys to Binding Keys safely, as they are usable for both publishing and binding
toBindingKey :: Key a msg -> Key Binding msg
toBindingKey :: forall a msg. Key a msg -> Key Binding msg
toBindingKey (Key [Binding]
ws) = forall a msg. [Binding] -> Key a msg
Key [Binding]
ws

-- | Custom error message when trying to publish to Binding keys
type family RequireRouting (a :: Type) :: Constraint where
    RequireRouting Binding =
        TypeError
            ( 'Text "Expected Routing Key but got Binding Key instead. Messages can be published only with keys that exclusivlely use `key` and `word`"
                :$$: 'Text "\n          key \"message\" & word \"new\" \n"
            )
    RequireRouting a = ()