module Crem.StateMachineSpec where import Crem.Example.BooleanStateMachine (booleanStateMachine) import Crem.Example.LockDoor import Crem.Example.PlusOneUpToFour (plus1UpTo4) import Crem.Example.Switch (switchMachine) import "base" Control.Category qualified import "base" Data.Functor.Identity (Identity (..)) import "base" Data.List (singleton) import "crem" Crem.StateMachine import "hspec" Test.Hspec (Expectation, Spec, describe, it, shouldBe) import "profunctors" Data.Profunctor (rmap) import "singletons-base" Data.Singletons.Base.TH shouldOutput :: (Eq b, Show b) => Identity (b, c) -> b -> Expectation shouldOutput (Identity (output, _)) expectedOutput = output `shouldBe` expectedOutput spec :: Spec spec = describe "StateMachine" $ do describe "run" $ do describe "switch machine" $ do it "outputs () when the state is False" $ do run (Basic $ switchMachine SFalse) () `shouldOutput` () it "outputs () when the state is True" $ do run (Basic $ switchMachine STrue) () `shouldOutput` () describe "lock door machine" $ do it "outputs Opened when it is closed and receive an Open command" $ do run (Basic $ lockDoorMachine SIsLockClosed) LockOpen `shouldOutput` LockOpened it "outputs NoOp when it is closed and receive a Close command" $ do run (Basic $ lockDoorMachine SIsLockClosed) LockClose `shouldOutput` LockNoOp it "outputs Locked when it is closed and receive a Lock command" $ do run (Basic $ lockDoorMachine SIsLockClosed) LockLock `shouldOutput` LockLocked it "outputs NoOp when it is closed and receive an Unlock command" $ do run (Basic $ lockDoorMachine SIsLockClosed) LockUnlock `shouldOutput` LockNoOp it "outputs NoOp when it is open and receive an Open command" $ do run (Basic $ lockDoorMachine SIsLockOpen) LockOpen `shouldOutput` LockNoOp it "outputs Closed when it is open and receive a Close command" $ do run (Basic $ lockDoorMachine SIsLockOpen) LockClose `shouldOutput` LockClosed it "outputs NoOp when it is open and receive a Lock command" $ do run (Basic $ lockDoorMachine SIsLockOpen) LockLock `shouldOutput` LockNoOp it "outputs NoOp when it is open and receive an Unlock command" $ do run (Basic $ lockDoorMachine SIsLockOpen) LockUnlock `shouldOutput` LockNoOp it "outputs NoOp when it is locked and receive an Open command" $ do run (Basic $ lockDoorMachine SIsLockLocked) LockOpen `shouldOutput` LockNoOp it "outputs NoOp when it is locked and receive a Close command" $ do run (Basic $ lockDoorMachine SIsLockLocked) LockClose `shouldOutput` LockNoOp it "outputs NoOp when it is locked and receive a Lock command" $ do run (Basic $ lockDoorMachine SIsLockLocked) LockLock `shouldOutput` LockNoOp it "outputs Unlocked when it is locked and receive an Unlock command" $ do run (Basic $ lockDoorMachine SIsLockLocked) LockUnlock `shouldOutput` LockUnlocked it "outputs Locked when it is open and receive a Close and a Lock command" $ do let runOnce :: StateMachineT Identity LockDoorCommand LockDoorEvent runOnce = runIdentity $ snd <$> run (Basic $ lockDoorMachine SIsLockOpen @Identity) LockClose run runOnce LockLock `shouldOutput` LockLocked it "outputs Opened when it is locked and receive a Unlock and an Open command" $ do let runOnce :: StateMachineT Identity LockDoorCommand LockDoorEvent runOnce = runIdentity $ snd <$> run (Basic $ lockDoorMachine SIsLockLocked @Identity) LockUnlock run runOnce LockOpen `shouldOutput` LockOpened describe "boolean state machine" $ do it "outputs 1 when it is in a False state and receives a 0" $ do run (booleanStateMachine SFalse) 0 `shouldOutput` 1 it "outputs 3 when it is in a False state and receives a 1" $ do run (booleanStateMachine SFalse) 1 `shouldOutput` 3 it "outputs -1 when it is in a True state and receives a 0" $ do run (booleanStateMachine STrue) 0 `shouldOutput` (-1) it "outputs 5 when it is in a True state and receives a 1" $ do run (booleanStateMachine STrue) 1 `shouldOutput` 5 -- describe "cotabulate and cosieve are each other inverses" $ do -- prop "cotabulate . cosieve = id" $ do -- forAll (arbitrary @Int) $ do -- \input -> -- run (booleanStateMachine SFalse) input -- `shouldHaveTheSameOutputAs` run (cotabulate . cosieve $ booleanStateMachine SFalse) input -- prop "cosieve . cotabulate = id" $ do -- let -- nonEmptyFunction :: NonEmpty Int -> Int -- nonEmptyFunction = sum -- forAll (fromList <$> (arbitrary @[Int] `suchThat` (not . null))) $ do -- \input -> -- nonEmptyFunction input -- `shouldBe` (cosieve . cotabulate @StateMachine $ nonEmptyFunction) input describe "Feedback constructor runs correctly" $ do describe "with the plus1UpTo4 machine" $ do let echo :: StateMachine a [a] echo = rmap singleton Control.Category.id it "runs correctly on a single input" $ do run (Feedback echo plus1UpTo4) 1 `shouldOutput` [1, 2, 3, 4, 5] run (Feedback echo plus1UpTo4) 5 `shouldOutput` [5] it "processes correctly multiple inputs" $ do runMultiple (Feedback echo plus1UpTo4) [1, 1] `shouldOutput` [1, 2, 3, 4, 5, 1, 2, 3, 4, 5]