From 63827a606e17c5d510ff950ea03b1bcc7b91216c Mon Sep 17 00:00:00 2001 From: Mitch Stevens Date: Tue, 24 Sep 2024 19:12:18 +1000 Subject: [PATCH] added TestRunner component, integrated into sidebar --- docs/test_runner.md | 46 ++++++++++ src/Component/DataAttribute.purs | 6 +- src/Component/Marginalium.purs | 10 ++- src/Component/Sidebar/Render.purs | 20 ++--- src/Component/Sidebar/TestCaseTable.purs | 47 ---------- src/Component/Sidebar/Types.purs | 9 ++ src/Component/TestRunner.purs | 36 ++++++++ src/Component/TestRunner/Render.purs | 85 +++++++++++++++++++ src/Component/TestRunner/Types.purs | 68 +++++++++++++++ src/Data/LimitQueue.purs | 12 ++- src/Data/Zipper.purs | 17 ++-- src/Game/Level/Completion.purs | 10 +-- src/Game/Level/Problem.purs | 32 +++---- .../LevelSuites/IntermediateSuite.purs | 7 +- src/Resources/LevelSuites/ShiftingSuite.purs | 3 +- .../LevelSuites/TutorialSuite/Suite.purs | 9 +- src/Resources/LevelSuites/TwoBitSuite.purs | 9 +- 17 files changed, 313 insertions(+), 113 deletions(-) create mode 100644 docs/test_runner.md delete mode 100644 src/Component/Sidebar/TestCaseTable.purs create mode 100644 src/Component/TestRunner.purs create mode 100644 src/Component/TestRunner/Render.purs create mode 100644 src/Component/TestRunner/Types.purs diff --git a/docs/test_runner.md b/docs/test_runner.md new file mode 100644 index 0000000..4d1b8a0 --- /dev/null +++ b/docs/test_runner.md @@ -0,0 +1,46 @@ + +```mermaid +flowchart TD + not_started((Not Started)) + + check_for_port_mismatch + check_for_failed_restriction + convert_to_evaluable + + ready_for_testing + + + + + level_complete((Level Complete)) + + + not_started --- check_for_port_mismatch + test_n_succeeded --- check_for_port_mismatch + check_for_port_mismatch --- check_for_failed_restriction + check_for_failed_restriction --- convert_to_evaluable + convert_to_evaluable --- ready_for_testing + ready_for_testing --- run_tests + + + + + + subgraph test_runner + run_tests + all_tests_succeeded + test_n_failed + test_n_succeeded + run_test_n + + run_tests --- test_n_failed + run_tests --- all_tests_succeeded + test_n_failed --- run_test_n + run_test_n --- test_n_failed + run_test_n --- test_n_succeeded + + + + end + all_tests_succeeded --- level_complete +``` \ No newline at end of file diff --git a/src/Component/DataAttribute.purs b/src/Component/DataAttribute.purs index c42708e..ee55dcd 100755 --- a/src/Component/DataAttribute.purs +++ b/src/Component/DataAttribute.purs @@ -154,12 +154,12 @@ completionStatus = dataAttribute (AttrName "data-completion-status") attrPrint a where attrPrint = case _ of NotStarted -> "not-started" + PortMismatch _ -> "port-mismatch" FailedRestriction _ -> "failed-restriction" NotEvaluable _ -> "not-evaluable" - PortMismatch _ -> "port-mismatch" ReadyForTesting -> "ready-for-testing" - RunningTestCase _ -> "running-test" - TestCaseOutcome _ -> "testCaseOutcome" + --RunningTestCase _ -> "running-test" + --TestCaseOutcome _ -> "testCaseOutcome" Completed -> "completed" attrParse = fail "no parser for completion status!" diff --git a/src/Component/Marginalium.purs b/src/Component/Marginalium.purs index c0e4412..b1a4794 100755 --- a/src/Component/Marginalium.purs +++ b/src/Component/Marginalium.purs @@ -1,4 +1,12 @@ -module Component.Marginalium where +module Component.Marginalium + ( Action(..) + , Input + , Output(..) + , Query + , State + , component + ) + where import Prelude diff --git a/src/Component/Sidebar/Render.purs b/src/Component/Sidebar/Render.purs index 5187f8c..709de88 100644 --- a/src/Component/Sidebar/Render.purs +++ b/src/Component/Sidebar/Render.purs @@ -7,7 +7,9 @@ import Component.DataAttribute as DA import Component.Piece as Piece import Component.Rendering.BoardPortDiagram (renderBoardPortDiagram) import Component.Rendering.Piece (renderPiece) +import Component.TestRunner as TestRunner import Data.Array as A +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) import Data.Either (Either(..)) import Data.Filterable (eitherBool) import Data.List (List(..), (:)) @@ -31,7 +33,7 @@ import Halogen.HTML.Events as HE import Halogen.HTML.Extras (mapActionOverHTML) import Halogen.HTML.Properties as HP -render :: forall m s. State -> ComponentHTML Action s m +render :: forall m. State -> ComponentHTML Action Slots m render state = HH.div [ HP.id "sidebar-component" ] @@ -78,7 +80,7 @@ render state = [ HH.h3_ [ HH.text "Available pieces:"] , HH.span [ HP.class_ (ClassName "pieces") ] $ renderAvailablePiece <$> - A.nub state.problem.availablePieces + A.nub (A.fromFoldable state.problem.availablePieces) ] ] @@ -119,18 +121,8 @@ render state = ] ReadyForTesting -> [ HH.text "Ready for testing: " - , HH.button - [ HP.class_ (ClassName "ready-for-testing") - , HE.onClick (ButtonClicked RunTests) ] - [ HH.text "Run Tests"] - ] - RunningTestCase { testIndex, numTests } -> - [ HH.b_ [ HH.text "Running tests..." ] - , HH.br_ - , HH.text $ "Running "<> show (testIndex+1) <>"/"<> show numTests + , HH.slot_ TestRunner.slot unit TestRunner.component { ports: state.boardPorts, base: state.base, inputs: NonEmptyArray state.problem.testCases, model: state.problem.goal } ] - TestCaseOutcome failedTestCase -> [] - --[ renderTestError failedTestCase ] Completed -> [ HH.text "Level Complete!" , HH.button @@ -223,7 +215,7 @@ render state = ] ] where - signalRepresentationOption :: Base -> String -> ComponentHTML Action s m + signalRepresentationOption :: Base -> String -> ComponentHTML Action Slots m signalRepresentationOption base text = HH.span [ HE.onClick (ButtonClicked (Base base)) ] diff --git a/src/Component/Sidebar/TestCaseTable.purs b/src/Component/Sidebar/TestCaseTable.purs deleted file mode 100644 index b8dc019..0000000 --- a/src/Component/Sidebar/TestCaseTable.purs +++ /dev/null @@ -1,47 +0,0 @@ -module Component.Sidebar.TestCaseTable where - -import Prelude - -import Data.LimitQueue (LimitQueue) -import Data.LimitQueue as LQ -import Data.Map (Map) -import Game.Direction (CardinalDirection) -import Game.Level.Completion (TestCaseOutcome) -import Game.Port (Port(..)) -import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Properties as HP - -type Input = - { ports :: Map CardinalDirection Port - , limit :: Int - } - -type State = - { ports :: Map CardinalDirection Port - , testCaseOutcomes :: LimitQueue TestCaseOutcome - } - -data Query a - = AddTestCaseOutcome TestCaseOutcome - -data Action - -type Output = Void - ---component :: forall m. H.Component Query Input Output m ---component = H.mkComponent { eval , initialState , render } --- where --- initialState { ports, limit } = { ports, testCaseOutcomes: LQ.empty limit } --- --- render state = --- HH.table_ --- [ HH.th_ --- [ HH.td_ [ ] --- , HH.td --- [ HP.colSpan 2 ] --- [ HH.text "Inputs" ] --- ] --- ] --- where --- renderTestCase { testIndex, inputs, expected, recieved } = HH.text "" \ No newline at end of file diff --git a/src/Component/Sidebar/Types.purs b/src/Component/Sidebar/Types.purs index f0e12a1..99207d3 100644 --- a/src/Component/Sidebar/Types.purs +++ b/src/Component/Sidebar/Types.purs @@ -2,6 +2,7 @@ module Component.Sidebar.Types where import Prelude +import Component.TestRunner as TestRunner import Data.Map (Map) import Game.Direction (CardinalDirection) import Game.Level.Completion (CompletionStatus) @@ -9,6 +10,8 @@ import Game.Level.Problem (Problem) import Game.Piece (PieceId(..)) import Game.Port (Port(..)) import Game.Signal (Base, SignalRepresentation) +import Halogen (Slot) +import Type.Proxy (Proxy(..)) import Web.HTML.Event.DragEvent (DragEvent) import Web.UIEvent.MouseEvent (MouseEvent) @@ -60,3 +63,9 @@ data Action data Output = PieceDropped PieceId | ButtonOutput Button + +type Slots = + ( testRunner :: Slot TestRunner.Query TestRunner.Output Unit ) + +slot = + { testRunner: Proxy :: _ "testRunner" } diff --git a/src/Component/TestRunner.purs b/src/Component/TestRunner.purs new file mode 100644 index 0000000..2c6e98e --- /dev/null +++ b/src/Component/TestRunner.purs @@ -0,0 +1,36 @@ +module Component.TestRunner + ( component + , module Component.TestRunner.Types + ) where + +import Component.TestRunner.Render +import Component.TestRunner.Types +import Prelude + +import Control.Monad.State.Class (modify_) +import Data.Array as A +import Data.FunctorWithIndex (mapWithIndex) +import Data.LimitQueue (LimitQueue) +import Data.LimitQueue as LQ +import Data.Map (Map) +import Data.Map as M +import Data.Maybe (Maybe(..), maybe) +import Data.Set as S +import Data.Traversable (for) +import Data.TraversableWithIndex (forWithIndex) +import Game.Capacity (Capacity(..)) +import Game.Direction (CardinalDirection) +import Game.Level.Completion (TestCaseOutcome) +import Game.Port (Port(..), isInput, isOutput, portCapacity) +import Game.Signal (Base, Signal, SignalRepresentation(..), printSignal) +import Halogen (ComponentHTML, defaultEval, mkEval) +import Halogen as H +import Halogen.HTML (HTML) +import Halogen.HTML as HH +import Halogen.HTML.Properties as HP + +component :: forall m. H.Component Query Input Output m +component = H.mkComponent { eval, initialState, render } + where + eval = mkEval (defaultEval) + diff --git a/src/Component/TestRunner/Render.purs b/src/Component/TestRunner/Render.purs new file mode 100644 index 0000000..ce1499f --- /dev/null +++ b/src/Component/TestRunner/Render.purs @@ -0,0 +1,85 @@ +module Component.TestRunner.Render where + +import Component.TestRunner.Types +import Prelude + +import Data.Array (replicate) +import Data.Array as A +import Data.Foldable (length) +import Data.FunctorWithIndex (mapWithIndex) +import Data.Map as M +import Data.Maybe (maybe) +import Data.Set as S +import Data.Zipper as Z +import Game.Capacity (Capacity(..)) +import Game.Port (isInput, isOutput, portCapacity) +import Game.Signal (SignalRepresentation(..), printSignal) +import Halogen (ComponentHTML) +import Halogen.HTML as HH +import Halogen.HTML.Properties as HP + +render :: forall s m. State -> ComponentHTML Action s m +render state = HH.table_ (renderHeaders <> renderRows) + where + inputDirs = M.keys $ M.filter isInput state.ports + outputDirs = M.keys $ M.filter isOutput state.ports + + renderHeaders = + [ HH.tr_ + [ HH.td_ + [ HH.text "Index" ] + , HH.td + [ HP.colSpan (S.size inputDirs) ] + [ HH.text "Inputs" ] + , HH.td + [ HP.colSpan (S.size outputDirs) ] + [ HH.text "Expected" ] + , HH.td + [ HP.colSpan (S.size outputDirs) ] + [ HH.text "Reveived" ] + , HH.td_ + [ HH.text "Status" ] + ] + , HH.tr_ + [ HH.td_ [ ] -- index + , HH.td_ [ HH.text "L"] + , HH.td_ [ HH.text "R"] + , HH.td_ [ HH.text "R"] + ] + ] + + renderRows :: Array (ComponentHTML Action s m) + renderRows = flip mapWithIndex relevantTestCases \i testCase -> renderRow 99 testCase + where + relevantTestCases = A.slice start end (A.fromFoldable state.testCases) + n = min maxRows (length state.testCases) + start = max 0 (end - n) + end = max n (Z.currentIndex state.testCases) + + renderRow :: Int -> TestCase -> ComponentHTML Action s m + renderRow testIndex testCase = + HH.tr_ $ join + [ [ HH.td_ [ HH.text (show testIndex) ] ] + , renderInputs + , renderExpected + , renderReceived + ] + where + rep dir = SignalRepresentation state.base (maybe EightBit portCapacity (M.lookup dir state.ports)) + + renderSignals signals = A.fromFoldable $ + flip mapWithIndex signals \dir signal -> + HH.td_ + [ HH.text (printSignal (rep dir) signal) ] + + renderInputs = renderSignals testCase.inputs + renderExpected = renderSignals testCase.expected + renderReceived = case testCase.status of + Pending -> replicate n (HH.td_ []) + Completed -> renderSignals testCase.expected + Failed -> maybe (replicate (M.size testCase.expected) (HH.td_ [HH.text "X"])) renderSignals testCase.received + where + n = M.size testCase.expected + + + diff --git a/src/Component/TestRunner/Types.purs b/src/Component/TestRunner/Types.purs new file mode 100644 index 0000000..0f15eca --- /dev/null +++ b/src/Component/TestRunner/Types.purs @@ -0,0 +1,68 @@ +module Component.TestRunner.Types where + +import Prelude + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NE +import Data.LimitQueue (LimitQueue) +import Data.List (List) +import Data.Map (Map) +import Data.Maybe (Maybe(..)) +import Data.Time.Duration (Milliseconds(..)) +import Data.Zipper (Zipper) +import Game.Direction (CardinalDirection) +import Game.Level.Completion (TestCaseOutcome) +import Game.Piece (Piece(..), eval) +import Game.Port (Port(..)) +import Game.Signal (Base, Signal) +import Type.Proxy (Proxy(..)) + +maxRows = 5 +delayBetweenTests = Milliseconds 1000.0 + +data TestCaseStatus = Pending | Completed | Failed + +type TestCase = + { status :: TestCaseStatus + , inputs :: Map CardinalDirection Signal + , expected :: Map CardinalDirection Signal + , received :: Maybe (Map CardinalDirection Signal) + } + +type Input = + { ports :: Map CardinalDirection Port + , base :: Base + , inputs :: NonEmptyArray (Map CardinalDirection Signal) + , model :: Piece + } + +type State = + { ports :: Map CardinalDirection Port + , base :: Base + , testCases :: Zipper TestCase + , model :: Piece + } + +data Query a + +data Action + = StartTesting + | RunSingleTest + | CurrentTestCaseCompleted TestCaseOutcome + +data Output + = SingleTestSucceeded { testIndex :: Int } + | AllTestsSucceed + +initialState :: Input -> State +initialState { ports, base, inputs, model } = + { ports, base, model, testCases } + where + testCases = NE.toUnfoldable1 $ flip map inputs \i -> + { inputs: i + , expected: eval model i + , received: Nothing + , status: Pending + } + +slot = Proxy :: Proxy "testRunner" \ No newline at end of file diff --git a/src/Data/LimitQueue.purs b/src/Data/LimitQueue.purs index b82a0e0..f2139da 100755 --- a/src/Data/LimitQueue.purs +++ b/src/Data/LimitQueue.purs @@ -6,16 +6,22 @@ module Data.LimitQueue where import Prelude import Data.Array as A -import Data.Traversable (class Traversable) +import Data.Traversable (class Foldable, class Traversable, foldMap, foldl, foldr, sequence, traverse, traverse_) newtype LimitQueue a = LimitQueue { limit :: Int, queue :: Array a } derive instance Functor LimitQueue +instance Foldable LimitQueue where + foldr f z (LimitQueue {limit, queue}) = foldr f z queue + foldl f z (LimitQueue {limit, queue}) = foldl f z queue + foldMap f (LimitQueue {limit, queue}) = foldMap f queue + +instance Traversable LimitQueue where + traverse f (LimitQueue {limit, queue}) = LimitQueue <<< { limit, queue: _} <$> traverse f queue + sequence (LimitQueue {limit, queue}) = LimitQueue <<< {limit, queue: _ } <$> sequence queue empty :: forall a. Int -> LimitQueue a empty n = limitQueue n [] - limitQueue :: forall a. Int -> Array a -> LimitQueue a limitQueue n array = LimitQueue { limit: n, queue: A.drop (A.length array - n) array } - enqueue :: forall a. a -> LimitQueue a -> LimitQueue a enqueue a (LimitQueue { limit, queue }) = limitQueue limit (A.cons a queue) diff --git a/src/Data/Zipper.purs b/src/Data/Zipper.purs index 6962ef7..261f772 100755 --- a/src/Data/Zipper.purs +++ b/src/Data/Zipper.purs @@ -18,16 +18,12 @@ import Data.Unfoldable (class Unfoldable1, unfoldr, unfoldr1) data Zipper a = Zipper (List a) a (List a) derive instance Eq a => Eq (Zipper a) ---instance Eq1 Zipper where --- eq1 = eq1 `on` asList --- where asList (Zipper ls v rs) = L.reverse ls <> Cons v rs --- ---instance Eq a => Eq (Zipper a) where --- eq = eq1 - instance Show a => Show (Zipper a) where show (Zipper ls v rs) = "Z " <> show (L.reverse ls) <> " " <> show v <> " " <> show rs +instance Semigroup (Zipper a) where + append (Zipper ls1 v1 r1) z1 = Zipper ls1 v1 (r1 <> L.fromFoldable z1) + instance Functor Zipper where map f (Zipper ls v rs) = Zipper (map f ls) (f v) (map f rs) @@ -40,6 +36,10 @@ instance Traversable Zipper where traverse f (Zipper ls v rs) = Zipper <$> (L.reverse <$> traverse f (L.reverse ls)) <*> f v <*> traverse f rs sequence (Zipper ls v rs) = Zipper <$> (L.reverse <$> sequence (L.reverse ls)) <*> v <*> sequence rs +instance Unfoldable1 Zipper where + unfoldr1 f b = case f b of + Tuple a Nothing -> Zipper Nil a Nil + Tuple a (Just b') -> Zipper Nil a (unfoldr1 f b') instance Extend Zipper where extend f zipper = Zipper (map f lefts) (f zipper) (map f rights) @@ -81,5 +81,8 @@ append v' (Zipper ls v rs) = Zipper (Cons v ls) v' Nil singleton :: forall a. a -> Zipper a singleton v = Zipper Nil v Nil +currentIndex :: forall a. Zipper a -> Int +currentIndex (Zipper ls v rs) = L.length ls + undo = moveLeft redo = moveRight \ No newline at end of file diff --git a/src/Game/Level/Completion.purs b/src/Game/Level/Completion.purs index 6455052..f6f532b 100755 --- a/src/Game/Level/Completion.purs +++ b/src/Game/Level/Completion.purs @@ -21,12 +21,10 @@ import Game.Signal (Signal(..)) data CompletionStatus = NotStarted + | PortMismatch PortMismatch | FailedRestriction FailedRestriction | NotEvaluable BoardError - | PortMismatch PortMismatch | ReadyForTesting - | RunningTestCase RunningTestCase - | TestCaseOutcome TestCaseOutcome | Completed derive instance Eq CompletionStatus @@ -61,7 +59,7 @@ type TestCaseOutcome = { testIndex :: Int , inputs :: Map CardinalDirection Signal , expected :: Map CardinalDirection Signal - , recieved :: Map CardinalDirection Signal + , received :: Map CardinalDirection Signal } type FailedRestriction = @@ -107,5 +105,5 @@ runSingleTest :: forall m. Monad m => Piece -> Int -> Map CardinalDirection Signal -> (Map CardinalDirection Signal -> m (Map CardinalDirection Signal)) -> m TestCaseOutcome runSingleTest piece testIndex inputs testEval = do let expected = eval piece inputs - recieved <- testEval inputs - pure { testIndex, inputs, expected, recieved } \ No newline at end of file + received <- testEval inputs + pure { testIndex, inputs, expected, received } \ No newline at end of file diff --git a/src/Game/Level/Problem.purs b/src/Game/Level/Problem.purs index d2c990c..86d16e9 100755 --- a/src/Game/Level/Problem.purs +++ b/src/Game/Level/Problem.purs @@ -5,6 +5,8 @@ import Prelude import Control.Alt (alt) import Control.Monad.Except (class MonadError, ExceptT, lift, throwError) import Control.Plus (empty) +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NE import Data.Either (Either(..), blush) import Data.Enum (enumFromTo) import Data.Foldable (fold, foldMap, foldl, for_, length) @@ -28,22 +30,22 @@ import Game.Signal (Signal(..)) import Type.Proxy (Proxy(..)) import Web.DOM.ParentNode (QuerySelector(..)) +type Restriction = + { name :: String + , restriction :: Board -> Boolean + , description :: String + } + type Problem = { goal :: Piece , title :: String , description :: String , testCases :: Array (Map CardinalDirection Signal) , requiresAutomaticTesting :: Boolean - , availablePieces :: Array Piece - , otherRestrictions :: Array - { name :: String - , restriction :: Board -> Boolean - , description :: String - } + , availablePieces :: NonEmptyArray Piece + , otherRestrictions :: Array Restriction } - - defaultProblem :: Problem defaultProblem = { goal: idPiece @@ -51,16 +53,6 @@ defaultProblem = , description: "default description" , testCases: [] , requiresAutomaticTesting: false - , availablePieces: [] + , availablePieces: NE.singleton idPiece , otherRestrictions: [] - } - - -showMismatch :: forall r a. Show a => { received :: a, expected :: a | r } -> String -showMismatch r = "received: " <> show r.received <> ", expected: " <> show r.expected - ---countPiecesOfType :: Board -> Piece -> Int ---countPiecesOfType (Board board) (Piece piece) = length $ M.filter (\p -> piece == p.piece) board.pieces - - - + } \ No newline at end of file diff --git a/src/Resources/LevelSuites/IntermediateSuite.purs b/src/Resources/LevelSuites/IntermediateSuite.purs index 26e9d40..377956c 100755 --- a/src/Resources/LevelSuites/IntermediateSuite.purs +++ b/src/Resources/LevelSuites/IntermediateSuite.purs @@ -3,6 +3,7 @@ module Resources.LevelSuites.IntermediateSuite where import Prelude import Component.DataAttribute as DataAttr +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) import Data.Set as S import Foreign.Object (fromHomogeneous) import Game.Direction as Direction @@ -20,7 +21,7 @@ intermediateSuite = fromHomogeneous , description: "Propogate the signal on the left to the right, and the top to the bottom" , testCases: binaryTestInputs [ Direction.Left, Direction.Up ] , requiresAutomaticTesting: false - , availablePieces: [idPiece, superPiece, leftPiece, rightPiece, xorPiece] + , availablePieces: NonEmptyArray [idPiece, superPiece, leftPiece, rightPiece, xorPiece] , otherRestrictions: [] } --, boardDeltaRulesEngine = [] @@ -53,7 +54,7 @@ intermediateSuite = fromHomogeneous , title ="From Or, birthed And" , description = "Create an and-piece using only or-piece and not-piece" , testCases = binaryTestInputs [ Direction.Left, Direction.Up ] - , availablePieces = [ orPiece, notPiece ] + , availablePieces = NonEmptyArray[ orPiece, notPiece ] } } , "Exclusive Or: Pick One": defaultLevel @@ -63,7 +64,7 @@ intermediateSuite = fromHomogeneous , description: "Output true when EXACTLY one input is true. If both inputs are true, output false" , testCases: binaryTestInputs [ Direction.Left, Direction.Up ] , requiresAutomaticTesting: false - , availablePieces: [ idPiece, notPiece, orPiece, andPiece, crossPiece ] + , availablePieces: NonEmptyArray[ idPiece, notPiece, orPiece, andPiece, crossPiece ] , otherRestrictions: [] } } diff --git a/src/Resources/LevelSuites/ShiftingSuite.purs b/src/Resources/LevelSuites/ShiftingSuite.purs index fefebe4..29f1004 100755 --- a/src/Resources/LevelSuites/ShiftingSuite.purs +++ b/src/Resources/LevelSuites/ShiftingSuite.purs @@ -3,6 +3,7 @@ module Resources.LevelSuites.ShiftingSuite where import Prelude import Component.DataAttribute as DataAttr +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) import Data.Map as M import Data.Set as S import Foreign.Object (fromHomogeneous) @@ -22,7 +23,7 @@ shiftingSuite = fromHomogeneous , description: "For each of the 4 bits in the input, shift them up towards the left by one place\n bluefdsajafdskl" , testCases: M.singleton Direction.Left <$> (map mkSignal [ 0, 1, 2, 3, 8, 9, 15] ) , requiresAutomaticTesting: false - , availablePieces: [ severPiece, fusePiece, idPiece, leftPiece, rightPiece ] + , availablePieces: NonEmptyArray [ severPiece, fusePiece, idPiece, leftPiece, rightPiece ] , otherRestrictions: [] } } diff --git a/src/Resources/LevelSuites/TutorialSuite/Suite.purs b/src/Resources/LevelSuites/TutorialSuite/Suite.purs index 6059beb..a6cc2c3 100755 --- a/src/Resources/LevelSuites/TutorialSuite/Suite.purs +++ b/src/Resources/LevelSuites/TutorialSuite/Suite.purs @@ -6,6 +6,7 @@ import Component.DataAttribute as DA import Component.Marginalia.Types (description, marginalia) import Control.Monad.Reader (ask, lift) import Control.Plus ((<|>)) +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) import Data.FunctorWithIndex (mapWithIndex) import Data.HeytingAlgebra (ff, tt) import Data.Lens ((.~)) @@ -40,7 +41,7 @@ tutorialSuite = fromHomogeneous , title = "From A to B" , description = "Propagate the signal inputed on the Left to the Right" , testCases = binaryTestInputs [ Direction.Left ] - , availablePieces = [ idPiece ] + , availablePieces = NonEmptyArray [ idPiece ] } , marginalia = [ marginalia (tt) (description "wow this is great marginalia!!" ff) ] --, conversation = do @@ -86,7 +87,7 @@ tutorialSuite = fromHomogeneous , description: "Negate the signal inputed on the Left and output it on the Right" , testCases: binaryTestInputs [Direction.Left] , requiresAutomaticTesting: false - , availablePieces: [ idPiece, notPiece ] + , availablePieces: NonEmptyArray [ idPiece, notPiece ] , otherRestrictions: [] } --, conversation = do @@ -104,7 +105,7 @@ tutorialSuite = fromHomogeneous , title = "Two enter, one leaves" , description = "" , testCases = binaryTestInputs [ Direction.Left, Direction.Up ] - , availablePieces = [ idPiece, orPiece ] + , availablePieces = NonEmptyArray [ idPiece, orPiece ] } } , "Take a Left": defaultLevel @@ -113,7 +114,7 @@ tutorialSuite = fromHomogeneous , title = "Take a Left" , description = "" , testCases = binaryTestInputs [Direction.Left] - , availablePieces = [ idPiece, orPiece ] + , availablePieces = NonEmptyArray [ idPiece, orPiece ] } } } diff --git a/src/Resources/LevelSuites/TwoBitSuite.purs b/src/Resources/LevelSuites/TwoBitSuite.purs index eecef70..2f02269 100755 --- a/src/Resources/LevelSuites/TwoBitSuite.purs +++ b/src/Resources/LevelSuites/TwoBitSuite.purs @@ -5,6 +5,7 @@ import Prelude import Component.DataAttribute (selector) import Component.DataAttribute as DataAttr +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) import Data.Map as M import Data.Set as S import Foreign.Object (fromHomogeneous) @@ -22,7 +23,7 @@ twoBitSuite = fromHomogeneous { goal = mkWirePiece { capacity: TwoBit, outputs: S.singleton Direction.Right } , title = "From 2A to 2B" , description = "This looks familiar, but the input and output ports have a capacity of 2 bits! Build a path between the left and the right, then use the '2' key to increase the capacity of the path. The capacity of each port is colour coded, only ports with the same capacity can connect!" - , availablePieces = [ idPiece ] + , availablePieces = NonEmptyArray [ idPiece ] , testCases = [ M.singleton Direction.Left (mkSignal 0) , M.singleton Direction.Left (mkSignal 1) @@ -36,7 +37,7 @@ twoBitSuite = fromHomogeneous { goal = fusePiece , title = "Lovers Lake" , description = "Use a fuse-piece to combine the inputs from the top and left, output the result to the right" - , availablePieces = [fusePiece, idPiece] + , availablePieces = NonEmptyArray [fusePiece, idPiece] , testCases = [ M.singleton Direction.Left (mkSignal 0) , M.singleton Direction.Left (mkSignal 1) @@ -50,7 +51,7 @@ twoBitSuite = fromHomogeneous { goal = twoBitCrossOver , title = "Two bit criss cross" , description = "Sever the input on the left with a sever-piece, cross over the signals, fuse them back together" - , availablePieces = [severPiece, fusePiece, idPiece] + , availablePieces = NonEmptyArray [severPiece, fusePiece, idPiece] , testCases = [ M.singleton Direction.Left (mkSignal 0) , M.singleton Direction.Left (mkSignal 1) @@ -64,7 +65,7 @@ twoBitSuite = fromHomogeneous { goal = succPiece , title = "Increment" , description = "Add one to the two bit input signal. if the input is 3 (which has no successor), output signal 0" - , availablePieces = [xorPiece, notPiece, fusePiece, severPiece] + , availablePieces = NonEmptyArray [xorPiece, notPiece, fusePiece, severPiece] , testCases = [ M.singleton Direction.Left (mkSignal 0) , M.singleton Direction.Left (mkSignal 1)