-- | Streams are the fundamental unit of organization of evented, service-oriented systems.
-- They are both the storage and the transport of messages in message-based systems.
-- And they are the principle storage medium of applicative entity data.
--
-- Streams are created by writing a message to the stream. Messages are appended to the end of streams.
-- If the stream doesn't exist when an event is appended to it, the event will be appended at position 0.
-- If the stream already exists, the event will be appended at the next position number.
--
-- Read more at: http://docs.eventide-project.org/core-concepts/streams
module MessageDb.StreamName
  ( StreamName (..)

    -- * Category
  , Category
  , categoryOfStream
  , categoryToText
  , category

    -- * Identifier
  , Identifier (..)
  , identifierOfStream
  , addIdentifierToCategory
  , addMaybeIdentifierToCategory
  )
where

import qualified Data.Aeson as Aeson
import Data.Coerce (coerce)
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text


-- | Name of a stream. Look into 'categoryOfStream' or 'identifierOfStream' to parse out the category or identifier from the stream name.
newtype StreamName = StreamName
  { StreamName -> Text
streamNameToText :: Text
  -- ^ Convert the 'StreamName' to 'Text'.
  }
  deriving (StreamName -> StreamName -> Bool
(StreamName -> StreamName -> Bool)
-> (StreamName -> StreamName -> Bool) -> Eq StreamName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamName -> StreamName -> Bool
$c/= :: StreamName -> StreamName -> Bool
== :: StreamName -> StreamName -> Bool
$c== :: StreamName -> StreamName -> Bool
Eq, Eq StreamName
Eq StreamName
-> (StreamName -> StreamName -> Ordering)
-> (StreamName -> StreamName -> Bool)
-> (StreamName -> StreamName -> Bool)
-> (StreamName -> StreamName -> Bool)
-> (StreamName -> StreamName -> Bool)
-> (StreamName -> StreamName -> StreamName)
-> (StreamName -> StreamName -> StreamName)
-> Ord StreamName
StreamName -> StreamName -> Bool
StreamName -> StreamName -> Ordering
StreamName -> StreamName -> StreamName
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 :: StreamName -> StreamName -> StreamName
$cmin :: StreamName -> StreamName -> StreamName
max :: StreamName -> StreamName -> StreamName
$cmax :: StreamName -> StreamName -> StreamName
>= :: StreamName -> StreamName -> Bool
$c>= :: StreamName -> StreamName -> Bool
> :: StreamName -> StreamName -> Bool
$c> :: StreamName -> StreamName -> Bool
<= :: StreamName -> StreamName -> Bool
$c<= :: StreamName -> StreamName -> Bool
< :: StreamName -> StreamName -> Bool
$c< :: StreamName -> StreamName -> Bool
compare :: StreamName -> StreamName -> Ordering
$ccompare :: StreamName -> StreamName -> Ordering
$cp1Ord :: Eq StreamName
Ord, String -> StreamName
(String -> StreamName) -> IsString StreamName
forall a. (String -> a) -> IsString a
fromString :: String -> StreamName
$cfromString :: String -> StreamName
IsString, b -> StreamName -> StreamName
NonEmpty StreamName -> StreamName
StreamName -> StreamName -> StreamName
(StreamName -> StreamName -> StreamName)
-> (NonEmpty StreamName -> StreamName)
-> (forall b. Integral b => b -> StreamName -> StreamName)
-> Semigroup StreamName
forall b. Integral b => b -> StreamName -> StreamName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> StreamName -> StreamName
$cstimes :: forall b. Integral b => b -> StreamName -> StreamName
sconcat :: NonEmpty StreamName -> StreamName
$csconcat :: NonEmpty StreamName -> StreamName
<> :: StreamName -> StreamName -> StreamName
$c<> :: StreamName -> StreamName -> StreamName
Semigroup)
  deriving (Int -> StreamName -> ShowS
[StreamName] -> ShowS
StreamName -> String
(Int -> StreamName -> ShowS)
-> (StreamName -> String)
-> ([StreamName] -> ShowS)
-> Show StreamName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamName] -> ShowS
$cshowList :: [StreamName] -> ShowS
show :: StreamName -> String
$cshow :: StreamName -> String
showsPrec :: Int -> StreamName -> ShowS
$cshowsPrec :: Int -> StreamName -> ShowS
Show) via Text


instance Aeson.ToJSON StreamName where
  toJSON :: StreamName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> (StreamName -> Text) -> StreamName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamName -> Text
streamNameToText
  toEncoding :: StreamName -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding (Text -> Encoding)
-> (StreamName -> Text) -> StreamName -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamName -> Text
streamNameToText


instance Aeson.FromJSON StreamName where
  parseJSON :: Value -> Parser StreamName
parseJSON = (Text -> StreamName) -> Parser Text -> Parser StreamName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StreamName
StreamName (Parser Text -> Parser StreamName)
-> (Value -> Parser Text) -> Value -> Parser StreamName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON


separator :: Char
separator :: Char
separator = Char
'-'


-- | A 'Category' represents everything in the 'StreamName' up to the first hyphen (-).
-- For example, the category for the stream name, "account-1234", is "account".
newtype Category = Category Text
  deriving (Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq, Eq Category
Eq Category
-> (Category -> Category -> Ordering)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Category)
-> (Category -> Category -> Category)
-> Ord Category
Category -> Category -> Bool
Category -> Category -> Ordering
Category -> Category -> Category
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 :: Category -> Category -> Category
$cmin :: Category -> Category -> Category
max :: Category -> Category -> Category
$cmax :: Category -> Category -> Category
>= :: Category -> Category -> Bool
$c>= :: Category -> Category -> Bool
> :: Category -> Category -> Bool
$c> :: Category -> Category -> Bool
<= :: Category -> Category -> Bool
$c<= :: Category -> Category -> Bool
< :: Category -> Category -> Bool
$c< :: Category -> Category -> Bool
compare :: Category -> Category -> Ordering
$ccompare :: Category -> Category -> Ordering
$cp1Ord :: Eq Category
Ord)
  deriving (Int -> Category -> ShowS
[Category] -> ShowS
Category -> String
(Int -> Category -> ShowS)
-> (Category -> String) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> Category -> ShowS
Show) via Text


-- | Convert from a 'Category' to a 'Text'.
categoryToText :: Category -> Text
categoryToText :: Category -> Text
categoryToText (Category Text
text) =
  Text
text


-- | Gets the category of a stream.
-- For example for "account-123" it would return "account".
categoryOfStream :: StreamName -> Category
categoryOfStream :: StreamName -> Category
categoryOfStream (StreamName Text
text) =
  case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
separator) Text
text of
    (Text
name : [Text]
_) -> Text -> Category
Category Text
name
    [Text]
_ -> Text -> Category
Category Text
"" -- 'Text.split' never returns an empty list


category :: Text -> Category
category :: Text -> Category
category =
  StreamName -> Category
categoryOfStream (StreamName -> Category)
-> (Text -> StreamName) -> Text -> Category
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StreamName
StreamName


instance Aeson.ToJSON Category where
  toJSON :: Category -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> (Category -> Text) -> Category -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Category -> Text
categoryToText
  toEncoding :: Category -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding (Text -> Encoding) -> (Category -> Text) -> Category -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Category -> Text
categoryToText


instance Aeson.FromJSON Category where
  parseJSON :: Value -> Parser Category
parseJSON = (Text -> Category) -> Parser Text -> Parser Category
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Category
Category (Parser Text -> Parser Category)
-> (Value -> Parser Text) -> Value -> Parser Category
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON


-- | The identifier part of a stream name. Anything after the first hyphen (-).
newtype Identifier = Identifier
  { Identifier -> Text
identifierNameToText :: Text
  -- ^ Convert from an 'Identifier' to a 'Text.
  }
  deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Eq Identifier
Eq Identifier
-> (Identifier -> Identifier -> Ordering)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Identifier)
-> (Identifier -> Identifier -> Identifier)
-> Ord Identifier
Identifier -> Identifier -> Bool
Identifier -> Identifier -> Ordering
Identifier -> Identifier -> Identifier
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 :: Identifier -> Identifier -> Identifier
$cmin :: Identifier -> Identifier -> Identifier
max :: Identifier -> Identifier -> Identifier
$cmax :: Identifier -> Identifier -> Identifier
>= :: Identifier -> Identifier -> Bool
$c>= :: Identifier -> Identifier -> Bool
> :: Identifier -> Identifier -> Bool
$c> :: Identifier -> Identifier -> Bool
<= :: Identifier -> Identifier -> Bool
$c<= :: Identifier -> Identifier -> Bool
< :: Identifier -> Identifier -> Bool
$c< :: Identifier -> Identifier -> Bool
compare :: Identifier -> Identifier -> Ordering
$ccompare :: Identifier -> Identifier -> Ordering
$cp1Ord :: Eq Identifier
Ord)
  deriving (Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show) via Text


-- | Gets the identifier of a stream from a 'StreamName'.
-- For example "account-ed3b4af7-b4a0-499e-8a16-a09763811274" would return Just "ed3b4af7-b4a0-499e-8a16-a09763811274",
-- and "account" would return Nothing.
identifierOfStream :: StreamName -> Maybe Identifier
identifierOfStream :: StreamName -> Maybe Identifier
identifierOfStream (StreamName Text
text) =
  let separatorText :: Text
separatorText = String -> Text
Text.pack [Char
separator]
      value :: Text
value = Text -> [Text] -> Text
Text.intercalate Text
separatorText ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
separator) Text
text
   in if Text -> Bool
Text.null Text
value
        then Maybe Identifier
forall a. Maybe a
Nothing
        else Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier) -> Identifier -> Maybe Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
value


-- | Add an identifier to a 'Category'.
-- For example category "account" and identifier "123" would return "account-123".
addIdentifierToCategory :: Category -> Identifier -> StreamName
addIdentifierToCategory :: Category -> Identifier -> StreamName
addIdentifierToCategory (Category Text
categoryText) Identifier
identifierName =
  Text -> StreamName
StreamName (Text -> StreamName) -> Text -> StreamName
forall a b. (a -> b) -> a -> b
$ Text
categoryText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
identifierNameToText Identifier
identifierName


-- | Add a maybe identifier, allowing you to add an identifier to the stream name if it is Just.
addMaybeIdentifierToCategory :: Category -> Maybe Identifier -> StreamName
addMaybeIdentifierToCategory :: Category -> Maybe Identifier -> StreamName
addMaybeIdentifierToCategory Category
categoryText Maybe Identifier
maybeIdentifier =
  case Maybe Identifier
maybeIdentifier of
    Maybe Identifier
Nothing ->
      Category -> StreamName
coerce Category
categoryText
    Just Identifier
identifierName ->
      Category -> Identifier -> StreamName
addIdentifierToCategory Category
categoryText Identifier
identifierName


instance Aeson.ToJSON Identifier where
  toJSON :: Identifier -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> (Identifier -> Text) -> Identifier -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierNameToText
  toEncoding :: Identifier -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding (Text -> Encoding)
-> (Identifier -> Text) -> Identifier -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierNameToText


instance Aeson.FromJSON Identifier where
  parseJSON :: Value -> Parser Identifier
parseJSON = (Text -> Identifier) -> Parser Text -> Parser Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Identifier
Identifier (Parser Text -> Parser Identifier)
-> (Value -> Parser Text) -> Value -> Parser Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON