StateSpec.hs

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

{- HLINT ignore "Monoid law, left identity" -}
{- HLINT ignore "Monoid law, right identity" -}

module Effectful.OpenTelemetry.Tracing.Trace.StateSpec where

import Arbitrary ()
import Data.List qualified as List
import Data.List.Extra qualified as List
import Effectful
import Effectful.Hspec
import Effectful.OpenTelemetry.Tracing.Trace.State
import Effectful.OpenTelemetry.Tracing.Trace.State qualified as State
import Effectful.QuickCheck
import Prelude

isValid :: State -> Property es
isValid (toList -> s) = List.nubOrdOn fst s === s .&&. List.length s <= 32

spec :: (Hspec :> es) => Eff es ()
spec = parallel do
    prop "construction" isValid
    prop "associativity" \(a :: State) b c -> (a <> b) <> c === a <> (b <> c)
    prop "identity" \(a :: State) -> (mempty <> a === a) .&&. (a <> mempty === a)
    prop "toList/fromList round trip" \s -> fromList (toList s) === s
    prop "toText/fromText round trip" \s -> fromText (toText s) === s
    prop "toByteString/fromByteString round trip" \s -> fromByteString (toByteString s) === s
    prop "concatenation with self" \s -> isValid (s <> s)
    prop "concatenation" \s1 s2 -> isValid (s1 <> s2)
    prop "lookup" \s (NonNegative (Small i)) ->
        let
            l = toList s
            (k, v) = l !! i
         in
            length l > i ==> State.lookup k s === Just v
    prop "insert" \s (k, v) ->
        let
            s' = insert k v s
         in
            counterexample (show s') $
                isValid s' .&&. case toList s' of
                    (k', v') : _ -> (k, v) === (k', v')
                    _ -> property False
    prop "delete" \s (NonNegative (Small i)) ->
        let
            l = toList s
            (k, _) = l !! i
            s' = State.delete k s
            l' = toList s'
            (a, b) = splitAt i l
         in
            (length l > i) ==> l' === a <> drop 1 b
    prop "left-bias" $ \k v1 v2 ->
        let left = insert k v1 mempty
            right = insert k v2 mempty
            combined = left <> right
         in State.lookup k combined === Just v1