{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- |
Module      : Test.Hindsight.Examples
Description : Example event definitions and test utilities
Copyright   : (c) 2024
License     : BSD3
Maintainer  : maintainer@example.com

Example event definitions used in test suites and store backend tests.
Includes utilities like 'DeterministicText' for reproducible testing.
-}
module Test.Hindsight.Examples where

import Data.Aeson
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Hindsight
import System.FilePath ((</>))
import Test.Hindsight.Generate
import Test.QuickCheck
import Test.Tasty

type UserCreated = "user_created"

type instance MaxVersion UserCreated = 2

type instance
    Versions UserCreated =
        '[UserInformation0, UserInformation1, UserInformation2]

instance Event UserCreated

-- Consecutive upcasts (define only version transitions)
instance Upcast 0 UserCreated where
    upcast :: PayloadAtVersion (ToPeanoNat 0) (EventVersionVector UserCreated)
-> PayloadAtVersion
     (ToPeanoNat (0 + 1)) (EventVersionVector UserCreated)
upcast UserInformation0{Int
Text
userId :: Int
userName :: Text
userName :: UserInformation0 -> Text
userId :: UserInformation0 -> Int
..} = UserInformation1{userEmail :: Maybe Text
userEmail = Maybe Text
forall a. Maybe a
Nothing, Int
Text
userId :: Int
userName :: Text
userName :: Text
userId :: Int
..}

instance Upcast 1 UserCreated where
    upcast :: PayloadAtVersion (ToPeanoNat 1) (EventVersionVector UserCreated)
-> PayloadAtVersion
     (ToPeanoNat (1 + 1)) (EventVersionVector UserCreated)
upcast UserInformation1{Int
Maybe Text
Text
userEmail :: UserInformation1 -> Maybe Text
userName :: UserInformation1 -> Text
userId :: UserInformation1 -> Int
userId :: Int
userName :: Text
userEmail :: Maybe Text
..} = UserInformation2{likeability :: Int
likeability = Int
0, Int
Maybe Text
Text
userId :: Int
userName :: Text
userEmail :: Maybe Text
userEmail :: Maybe Text
userName :: Text
userId :: Int
..}

-- Automatic migration instances (using default consecutive composition)
instance MigrateVersion 0 UserCreated -- Automatic: V0 → V1 → V2
instance MigrateVersion 1 UserCreated -- Automatic: V1 → V2
instance MigrateVersion 2 UserCreated -- Automatic: V2 → V2 (identity)

-- | Version 0 of user information
data UserInformation0 = UserInformation0
    { UserInformation0 -> Int
userId :: Int
    , UserInformation0 -> Text
userName :: T.Text
    }
    deriving stock (Int -> UserInformation0 -> ShowS
[UserInformation0] -> ShowS
UserInformation0 -> FilePath
(Int -> UserInformation0 -> ShowS)
-> (UserInformation0 -> FilePath)
-> ([UserInformation0] -> ShowS)
-> Show UserInformation0
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInformation0 -> ShowS
showsPrec :: Int -> UserInformation0 -> ShowS
$cshow :: UserInformation0 -> FilePath
show :: UserInformation0 -> FilePath
$cshowList :: [UserInformation0] -> ShowS
showList :: [UserInformation0] -> ShowS
Show, UserInformation0 -> UserInformation0 -> Bool
(UserInformation0 -> UserInformation0 -> Bool)
-> (UserInformation0 -> UserInformation0 -> Bool)
-> Eq UserInformation0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInformation0 -> UserInformation0 -> Bool
== :: UserInformation0 -> UserInformation0 -> Bool
$c/= :: UserInformation0 -> UserInformation0 -> Bool
/= :: UserInformation0 -> UserInformation0 -> Bool
Eq, (forall x. UserInformation0 -> Rep UserInformation0 x)
-> (forall x. Rep UserInformation0 x -> UserInformation0)
-> Generic UserInformation0
forall x. Rep UserInformation0 x -> UserInformation0
forall x. UserInformation0 -> Rep UserInformation0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInformation0 -> Rep UserInformation0 x
from :: forall x. UserInformation0 -> Rep UserInformation0 x
$cto :: forall x. Rep UserInformation0 x -> UserInformation0
to :: forall x. Rep UserInformation0 x -> UserInformation0
Generic)
    deriving anyclass (Maybe UserInformation0
Value -> Parser [UserInformation0]
Value -> Parser UserInformation0
(Value -> Parser UserInformation0)
-> (Value -> Parser [UserInformation0])
-> Maybe UserInformation0
-> FromJSON UserInformation0
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UserInformation0
parseJSON :: Value -> Parser UserInformation0
$cparseJSONList :: Value -> Parser [UserInformation0]
parseJSONList :: Value -> Parser [UserInformation0]
$comittedField :: Maybe UserInformation0
omittedField :: Maybe UserInformation0
FromJSON, [UserInformation0] -> Value
[UserInformation0] -> Encoding
UserInformation0 -> Bool
UserInformation0 -> Value
UserInformation0 -> Encoding
(UserInformation0 -> Value)
-> (UserInformation0 -> Encoding)
-> ([UserInformation0] -> Value)
-> ([UserInformation0] -> Encoding)
-> (UserInformation0 -> Bool)
-> ToJSON UserInformation0
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserInformation0 -> Value
toJSON :: UserInformation0 -> Value
$ctoEncoding :: UserInformation0 -> Encoding
toEncoding :: UserInformation0 -> Encoding
$ctoJSONList :: [UserInformation0] -> Value
toJSONList :: [UserInformation0] -> Value
$ctoEncodingList :: [UserInformation0] -> Encoding
toEncodingList :: [UserInformation0] -> Encoding
$comitField :: UserInformation0 -> Bool
omitField :: UserInformation0 -> Bool
ToJSON)

-- | Version 1 of user information with optional email
data UserInformation1 = UserInformation1
    { UserInformation1 -> Int
userId :: Int
    , UserInformation1 -> Text
userName :: T.Text
    , UserInformation1 -> Maybe Text
userEmail :: Maybe T.Text
    }
    deriving stock (Int -> UserInformation1 -> ShowS
[UserInformation1] -> ShowS
UserInformation1 -> FilePath
(Int -> UserInformation1 -> ShowS)
-> (UserInformation1 -> FilePath)
-> ([UserInformation1] -> ShowS)
-> Show UserInformation1
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInformation1 -> ShowS
showsPrec :: Int -> UserInformation1 -> ShowS
$cshow :: UserInformation1 -> FilePath
show :: UserInformation1 -> FilePath
$cshowList :: [UserInformation1] -> ShowS
showList :: [UserInformation1] -> ShowS
Show, UserInformation1 -> UserInformation1 -> Bool
(UserInformation1 -> UserInformation1 -> Bool)
-> (UserInformation1 -> UserInformation1 -> Bool)
-> Eq UserInformation1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInformation1 -> UserInformation1 -> Bool
== :: UserInformation1 -> UserInformation1 -> Bool
$c/= :: UserInformation1 -> UserInformation1 -> Bool
/= :: UserInformation1 -> UserInformation1 -> Bool
Eq, (forall x. UserInformation1 -> Rep UserInformation1 x)
-> (forall x. Rep UserInformation1 x -> UserInformation1)
-> Generic UserInformation1
forall x. Rep UserInformation1 x -> UserInformation1
forall x. UserInformation1 -> Rep UserInformation1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInformation1 -> Rep UserInformation1 x
from :: forall x. UserInformation1 -> Rep UserInformation1 x
$cto :: forall x. Rep UserInformation1 x -> UserInformation1
to :: forall x. Rep UserInformation1 x -> UserInformation1
Generic)
    deriving anyclass (Maybe UserInformation1
Value -> Parser [UserInformation1]
Value -> Parser UserInformation1
(Value -> Parser UserInformation1)
-> (Value -> Parser [UserInformation1])
-> Maybe UserInformation1
-> FromJSON UserInformation1
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UserInformation1
parseJSON :: Value -> Parser UserInformation1
$cparseJSONList :: Value -> Parser [UserInformation1]
parseJSONList :: Value -> Parser [UserInformation1]
$comittedField :: Maybe UserInformation1
omittedField :: Maybe UserInformation1
FromJSON, [UserInformation1] -> Value
[UserInformation1] -> Encoding
UserInformation1 -> Bool
UserInformation1 -> Value
UserInformation1 -> Encoding
(UserInformation1 -> Value)
-> (UserInformation1 -> Encoding)
-> ([UserInformation1] -> Value)
-> ([UserInformation1] -> Encoding)
-> (UserInformation1 -> Bool)
-> ToJSON UserInformation1
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserInformation1 -> Value
toJSON :: UserInformation1 -> Value
$ctoEncoding :: UserInformation1 -> Encoding
toEncoding :: UserInformation1 -> Encoding
$ctoJSONList :: [UserInformation1] -> Value
toJSONList :: [UserInformation1] -> Value
$ctoEncodingList :: [UserInformation1] -> Encoding
toEncodingList :: [UserInformation1] -> Encoding
$comitField :: UserInformation1 -> Bool
omitField :: UserInformation1 -> Bool
ToJSON)

data UserInformation2 = UserInformation2
    { UserInformation2 -> Int
userId :: Int
    , UserInformation2 -> Text
userName :: T.Text
    , UserInformation2 -> Maybe Text
userEmail :: Maybe T.Text
    , UserInformation2 -> Int
likeability :: Int
    }
    deriving stock (Int -> UserInformation2 -> ShowS
[UserInformation2] -> ShowS
UserInformation2 -> FilePath
(Int -> UserInformation2 -> ShowS)
-> (UserInformation2 -> FilePath)
-> ([UserInformation2] -> ShowS)
-> Show UserInformation2
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInformation2 -> ShowS
showsPrec :: Int -> UserInformation2 -> ShowS
$cshow :: UserInformation2 -> FilePath
show :: UserInformation2 -> FilePath
$cshowList :: [UserInformation2] -> ShowS
showList :: [UserInformation2] -> ShowS
Show, UserInformation2 -> UserInformation2 -> Bool
(UserInformation2 -> UserInformation2 -> Bool)
-> (UserInformation2 -> UserInformation2 -> Bool)
-> Eq UserInformation2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInformation2 -> UserInformation2 -> Bool
== :: UserInformation2 -> UserInformation2 -> Bool
$c/= :: UserInformation2 -> UserInformation2 -> Bool
/= :: UserInformation2 -> UserInformation2 -> Bool
Eq, (forall x. UserInformation2 -> Rep UserInformation2 x)
-> (forall x. Rep UserInformation2 x -> UserInformation2)
-> Generic UserInformation2
forall x. Rep UserInformation2 x -> UserInformation2
forall x. UserInformation2 -> Rep UserInformation2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInformation2 -> Rep UserInformation2 x
from :: forall x. UserInformation2 -> Rep UserInformation2 x
$cto :: forall x. Rep UserInformation2 x -> UserInformation2
to :: forall x. Rep UserInformation2 x -> UserInformation2
Generic)
    deriving anyclass (Maybe UserInformation2
Value -> Parser [UserInformation2]
Value -> Parser UserInformation2
(Value -> Parser UserInformation2)
-> (Value -> Parser [UserInformation2])
-> Maybe UserInformation2
-> FromJSON UserInformation2
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UserInformation2
parseJSON :: Value -> Parser UserInformation2
$cparseJSONList :: Value -> Parser [UserInformation2]
parseJSONList :: Value -> Parser [UserInformation2]
$comittedField :: Maybe UserInformation2
omittedField :: Maybe UserInformation2
FromJSON, [UserInformation2] -> Value
[UserInformation2] -> Encoding
UserInformation2 -> Bool
UserInformation2 -> Value
UserInformation2 -> Encoding
(UserInformation2 -> Value)
-> (UserInformation2 -> Encoding)
-> ([UserInformation2] -> Value)
-> ([UserInformation2] -> Encoding)
-> (UserInformation2 -> Bool)
-> ToJSON UserInformation2
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserInformation2 -> Value
toJSON :: UserInformation2 -> Value
$ctoEncoding :: UserInformation2 -> Encoding
toEncoding :: UserInformation2 -> Encoding
$ctoJSONList :: [UserInformation2] -> Value
toJSONList :: [UserInformation2] -> Value
$ctoEncodingList :: [UserInformation2] -> Encoding
toEncodingList :: [UserInformation2] -> Encoding
$comitField :: UserInformation2 -> Bool
omitField :: UserInformation2 -> Bool
ToJSON)

{- | Newtype wrapper for deterministic Text generation in property tests.

TODO: Move this to a dedicated testing utilities module (e.g., Test.Hindsight.Util.Arbitrary)
once the test-lib structure is finalized. This is a general-purpose testing utility
that shouldn't be tied to the Examples module.
-}
newtype DeterministicText = DeterministicText Text
    deriving (Int -> DeterministicText -> ShowS
[DeterministicText] -> ShowS
DeterministicText -> FilePath
(Int -> DeterministicText -> ShowS)
-> (DeterministicText -> FilePath)
-> ([DeterministicText] -> ShowS)
-> Show DeterministicText
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeterministicText -> ShowS
showsPrec :: Int -> DeterministicText -> ShowS
$cshow :: DeterministicText -> FilePath
show :: DeterministicText -> FilePath
$cshowList :: [DeterministicText] -> ShowS
showList :: [DeterministicText] -> ShowS
Show, DeterministicText -> DeterministicText -> Bool
(DeterministicText -> DeterministicText -> Bool)
-> (DeterministicText -> DeterministicText -> Bool)
-> Eq DeterministicText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeterministicText -> DeterministicText -> Bool
== :: DeterministicText -> DeterministicText -> Bool
$c/= :: DeterministicText -> DeterministicText -> Bool
/= :: DeterministicText -> DeterministicText -> Bool
Eq)

instance Arbitrary DeterministicText where
    arbitrary :: Gen DeterministicText
arbitrary = Text -> DeterministicText
DeterministicText (Text -> DeterministicText)
-> (FilePath -> Text) -> FilePath -> DeterministicText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> DeterministicText)
-> Gen FilePath -> Gen DeterministicText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen FilePath
forall a. Gen a -> Gen [a]
listOf (FilePath -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements FilePath
validChars)
      where
        -- Use only ASCII letters and numbers for deterministic generation
        validChars :: FilePath
validChars = [Char
'a' .. Char
'z'] FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9']

    -- Shrink by removing characters from the end
    shrink :: DeterministicText -> [DeterministicText]
shrink (DeterministicText Text
t) =
        [Text -> DeterministicText
DeterministicText (Int -> Text -> Text
T.take Int
n Text
t) | Int
n <- [Int
0 .. Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- Use deterministic text generation for UserInformation instances
instance Arbitrary UserInformation0 where
    arbitrary :: Gen UserInformation0
arbitrary = do
        userId <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        DeterministicText userName <- arbitrary
        return $ UserInformation0 userId userName

    shrink :: UserInformation0 -> [UserInformation0]
shrink (UserInformation0 Int
uid Text
uname) =
        [ Int -> Text -> UserInformation0
UserInformation0 Int
uid' Text
uname'
        | (Int
uid', DeterministicText Text
uname') <- (Int, DeterministicText) -> [(Int, DeterministicText)]
forall a. Arbitrary a => a -> [a]
shrink (Int
uid, Text -> DeterministicText
DeterministicText Text
uname)
        ]

instance Arbitrary UserInformation1 where
    arbitrary :: Gen UserInformation1
arbitrary = do
        userId <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        DeterministicText userName <- arbitrary
        userEmail <- oneof [return Nothing, Just . (\(DeterministicText Text
t) -> Text
t) <$> arbitrary]
        return $ UserInformation1 userId userName userEmail

    shrink :: UserInformation1 -> [UserInformation1]
shrink (UserInformation1 Int
uid Text
uname Maybe Text
email) =
        [ Int -> Text -> Maybe Text -> UserInformation1
UserInformation1 Int
uid' Text
uname' Maybe Text
email''
        | (Int
uid', DeterministicText Text
uname', Maybe DeterministicText
email') <-
            (Int, DeterministicText, Maybe DeterministicText)
-> [(Int, DeterministicText, Maybe DeterministicText)]
forall a. Arbitrary a => a -> [a]
shrink (Int
uid, Text -> DeterministicText
DeterministicText Text
uname, (Text -> DeterministicText)
-> Maybe Text -> Maybe DeterministicText
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> DeterministicText
DeterministicText Maybe Text
email)
        , let email'' :: Maybe Text
email'' = (DeterministicText -> Text)
-> Maybe DeterministicText -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DeterministicText Text
t) -> Text
t) Maybe DeterministicText
email'
        ]

instance Arbitrary UserInformation2 where
    arbitrary :: Gen UserInformation2
arbitrary = do
        userId <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        DeterministicText userName <- arbitrary
        userEmail <- oneof [return Nothing, Just . (\(DeterministicText Text
t) -> Text
t) <$> arbitrary]
        likeability <- arbitrary
        return $ UserInformation2 userId userName userEmail likeability

    shrink :: UserInformation2 -> [UserInformation2]
shrink (UserInformation2 Int
uid Text
uname Maybe Text
email Int
lik) =
        [ Int -> Text -> Maybe Text -> Int -> UserInformation2
UserInformation2 Int
uid' Text
uname' Maybe Text
email'' Int
lik'
        | (Int
uid', DeterministicText Text
uname', Maybe DeterministicText
email', Int
lik') <-
            (Int, DeterministicText, Maybe DeterministicText, Int)
-> [(Int, DeterministicText, Maybe DeterministicText, Int)]
forall a. Arbitrary a => a -> [a]
shrink (Int
uid, Text -> DeterministicText
DeterministicText Text
uname, (Text -> DeterministicText)
-> Maybe Text -> Maybe DeterministicText
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> DeterministicText
DeterministicText Maybe Text
email, Int
lik)
        , let email'' :: Maybe Text
email'' = (DeterministicText -> Text)
-> Maybe DeterministicText -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DeterministicText Text
t) -> Text
t) Maybe DeterministicText
email'
        ]

-- Example usage:
tree :: TestTree
tree :: TestTree
tree =
    FilePath -> [TestTree] -> TestTree
testGroup
        FilePath
"Example Events"
        [ forall (event :: Symbol).
(KnownSymbol event,
 HasFullEvidenceList event ValidTestPayloadForVersion) =>
TestConfig -> TestTree
createRoundtripTests @UserCreated TestConfig
defaultTestConfig
        , -- Running only golden tests with custom config
          forall (event :: Symbol).
(KnownSymbol event,
 HasFullEvidenceList event ValidTestPayloadForVersion) =>
TestConfig -> TestTree
createGoldenTests @UserCreated TestConfig
customConfig
        ]
  where
    customConfig :: TestConfig
customConfig =
        TestConfig
defaultTestConfig
            { goldenPathFor = \(Proxy event
_ :: Proxy event) (Proxy ver
_ :: Proxy ver) ->
                FilePath
"golden" FilePath -> ShowS
</> FilePath
"events" FilePath -> ShowS
</> forall (event :: Symbol). KnownSymbol event => FilePath
eventToString @event FilePath -> ShowS
</> forall (n :: PeanoNat). ReifiablePeanoNat n => FilePath
showPeanoNat @ver FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".json"
            , goldenTestCaseCount = 10
            , goldenTestSeed = 12345
            , goldenTestSizeParam = 30 -- QuickCheck size parameter
            }