{- | Run-scoped identities. Allocation belongs to actions and context setup;
observing a result only looks up identities and cannot allocate them.
-}
module Conformance.Story.Identity
    ( Identities
    , empty
    , identify
    , bind
    , observe
    , bindings
    ) where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map

newtype Identities identity = Identities (Map identity Integer)
    deriving stock (Int -> Identities identity -> ShowS
[Identities identity] -> ShowS
Identities identity -> String
(Int -> Identities identity -> ShowS)
-> (Identities identity -> String)
-> ([Identities identity] -> ShowS)
-> Show (Identities identity)
forall identity.
Show identity =>
Int -> Identities identity -> ShowS
forall identity. Show identity => [Identities identity] -> ShowS
forall identity. Show identity => Identities identity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall identity.
Show identity =>
Int -> Identities identity -> ShowS
showsPrec :: Int -> Identities identity -> ShowS
$cshow :: forall identity. Show identity => Identities identity -> String
show :: Identities identity -> String
$cshowList :: forall identity. Show identity => [Identities identity] -> ShowS
showList :: [Identities identity] -> ShowS
Show, Identities identity -> Identities identity -> Bool
(Identities identity -> Identities identity -> Bool)
-> (Identities identity -> Identities identity -> Bool)
-> Eq (Identities identity)
forall identity.
Eq identity =>
Identities identity -> Identities identity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall identity.
Eq identity =>
Identities identity -> Identities identity -> Bool
== :: Identities identity -> Identities identity -> Bool
$c/= :: forall identity.
Eq identity =>
Identities identity -> Identities identity -> Bool
/= :: Identities identity -> Identities identity -> Bool
Eq)

empty :: Identities identity
empty :: forall identity. Identities identity
empty = Map identity Integer -> Identities identity
forall identity. Map identity Integer -> Identities identity
Identities Map identity Integer
forall k a. Map k a
Map.empty

identify
    :: (Ord identity)
    => identity -> Identities identity -> (Integer, Identities identity)
identify :: forall identity.
Ord identity =>
identity -> Identities identity -> (Integer, Identities identity)
identify identity
identity original :: Identities identity
original@(Identities Map identity Integer
known) = case identity -> Map identity Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup identity
identity Map identity Integer
known of
    Just Integer
identifier -> (Integer
identifier, Identities identity
original)
    Maybe Integer
Nothing ->
        let identifier :: Integer
identifier = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map identity Integer -> Int
forall k a. Map k a -> Int
Map.size Map identity Integer
known) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
        in  (Integer
identifier, Map identity Integer -> Identities identity
forall identity. Map identity Integer -> Identities identity
Identities (identity -> Integer -> Map identity Integer -> Map identity Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert identity
identity Integer
identifier Map identity Integer
known))

{- | Bind a concrete identity to the abstract identity a scenario names.

Allocation during context and action construction, like 'identify', but the
scenario chooses the identifier instead of the order of encounter. Re-binding
the same pair is accepted; binding a second concrete identity to an identifier
already taken, or re-binding one already bound to a different identifier, is
refused — either would make an observation mean two things.
-}
bind
    :: (Ord identity)
    => identity
    -> Integer
    -> Identities identity
    -> Either String (Identities identity)
bind :: forall identity.
Ord identity =>
identity
-> Integer
-> Identities identity
-> Either String (Identities identity)
bind identity
identity Integer
identifier (Identities Map identity Integer
known) =
    case ( identity -> Map identity Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup identity
identity Map identity Integer
known
         , [identity
i | (identity
i, Integer
n) <- Map identity Integer -> [(identity, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map identity Integer
known, Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
identifier, identity
i identity -> identity -> Bool
forall a. Eq a => a -> a -> Bool
/= identity
identity]
         ) of
        (Just Integer
existing, [identity]
_)
            | Integer
existing Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
identifier ->
                String -> Either String (Identities identity)
forall a b. a -> Either a b
Left
                    String
"the scenario binds an identity that is already bound to another identifier"
        (Maybe Integer
_, identity
_ : [identity]
_) ->
            String -> Either String (Identities identity)
forall a b. a -> Either a b
Left String
"the scenario binds two concrete identities to one identifier"
        (Maybe Integer, [identity])
_ -> Identities identity -> Either String (Identities identity)
forall a b. b -> Either a b
Right (Map identity Integer -> Identities identity
forall identity. Map identity Integer -> Identities identity
Identities (identity -> Integer -> Map identity Integer -> Map identity Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert identity
identity Integer
identifier Map identity Integer
known))

observe
    :: (Ord identity)
    => identity -> Identities identity -> Either String Integer
observe :: forall identity.
Ord identity =>
identity -> Identities identity -> Either String Integer
observe identity
identity (Identities Map identity Integer
known) =
    Either String Integer
-> (Integer -> Either String Integer)
-> Maybe Integer
-> Either String Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ( String -> Either String Integer
forall a b. a -> Either a b
Left
            String
"observed an identity not established by the context or an action"
        )
        Integer -> Either String Integer
forall a b. b -> Either a b
Right
        (identity -> Map identity Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup identity
identity Map identity Integer
known)

bindings :: Identities identity -> [(identity, Integer)]
bindings :: forall identity. Identities identity -> [(identity, Integer)]
bindings (Identities Map identity Integer
known) = Map identity Integer -> [(identity, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map identity Integer
known