{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Control.State.Transition.Examples.RecRule where

import Control.Monad (when)
import Control.State.Transition.Extended
import Data.Functor.Identity (Identity (..))
import Test.Hspec (Spec, describe, it, shouldBe)
import Validation

data RecRule

instance STS RecRule where
  type Environment RecRule = ()
  type Signal RecRule = Int
  type State RecRule = ()

  type PredicateFailure RecRule = String

  transitionRules :: [TransitionRule RecRule]
transitionRules =
    [ do
        TRC (_, _, n) <- Rule RecRule 'Transition (RuleContext 'Transition RecRule)
F (Clause RecRule 'Transition) (TRC RecRule)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
        even n ?! show n <> " is not even"
        n >= 3 ?! show n <> " is less than 3"
        when (n == 4) . validate $ Failure ["foo"] <> Failure ["bar"]
        when (n > 0) $ trans @RecRule $ TRC ((), (), n - 1)
    ]

spec :: Spec
spec :: Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RecRule" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Predicate failures happen in the right order" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    Identity (Either (NonEmpty String) ())
-> Either (NonEmpty String) ()
forall a. Identity a -> a
runIdentity (forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTS @RecRule (RuleContext 'Transition RecRule
 -> Identity
      (Either (NonEmpty (PredicateFailure RecRule)) (State RecRule)))
-> RuleContext 'Transition RecRule
-> Identity
     (Either (NonEmpty (PredicateFailure RecRule)) (State RecRule))
forall a b. (a -> b) -> a -> b
$ (Environment RecRule, State RecRule, Signal RecRule) -> TRC RecRule
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), (), Int
Signal RecRule
5))
      Either (NonEmpty String) ()
-> Either (NonEmpty String) () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` NonEmpty String -> Either (NonEmpty String) ()
forall a b. a -> Either a b
Left
        [ String
Item (NonEmpty String)
"5 is not even"
        , String
Item (NonEmpty String)
"foo"
        , String
Item (NonEmpty String)
"bar"
        , String
Item (NonEmpty String)
"3 is not even"
        , String
Item (NonEmpty String)
"2 is less than 3"
        , String
Item (NonEmpty String)
"1 is not even"
        , String
Item (NonEmpty String)
"1 is less than 3"
        , String
Item (NonEmpty String)
"0 is less than 3"
        ]