feat: tests for the rendering/parsing

src/Language/Brainfuck.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DerivingStrategies #-}
-module Language.Brainfuck (parse, ParseFailure) where
+{-# LANGUAGE LambdaCase #-}
+module Language.Brainfuck (parse, ParseFailure, render) where
 
 import Control.Monad ((<$!>))
 import Control.Monad.ST (runST, ST)
@@ -14,11 +15,12 @@ import Data.Vector qualified as Vector
 import Data.Vector.Mutable qualified as MutableVector
 
 import Language.Brainfuck.Instruction ( Instruction(..) )
+import qualified Data.List as List
 
 data ParseFailure
   = UnexpectedClosingBracket Int -- closing bracket position
   | UnmatchedOpenBracket Int -- opening bracket position
-  deriving stock (Show)
+  deriving stock (Show, Eq)
 
 -- | Convert a Text to a list of instructions, discard all comments.
 --
@@ -83,3 +85,21 @@ parse text = runST $ do
 
 -- >>> parse $ Text.pack "[]]"
 -- Left (UnexpectedClosingBracket 2)
+
+render :: Vector Instruction -> Text
+render = Text.concat . List.map renderSingle . Vector.toList
+  where
+    renderSingle = \case
+      Increment -> Text.singleton '+'
+      Decrement -> Text.singleton '-'
+      MoveLeft  -> Text.singleton '<'
+      MoveRight -> Text.singleton '>'
+      ReadByte  -> Text.singleton ','
+      PutByte   -> Text.singleton '.'
+      Loop body -> Text.concat [Text.singleton '[', render body, Text.singleton ']']
+
+-- >>> import Test.QuickCheck.Instances.Vector ()
+-- >>> import Test.QuickCheck.Arbitrary (arbitrary)
+-- >>> render <$> Gen.generate arbitrary
+-- "<,<>,<,."
+

src/Language/Brainfuck/Instruction.hs

@@ -1,7 +1,13 @@
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE InstanceSigs #-}
 module Language.Brainfuck.Instruction (Instruction(..)) where
 
 import Data.Vector ( Vector )
+import Test.QuickCheck.Gen (Gen)
+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
+import Test.QuickCheck.Instances.Vector ()
+
+import qualified Test.QuickCheck.Gen as Gen
 
 data Instruction
   = Increment
@@ -12,3 +18,20 @@ data Instruction
   | PutByte
   | Loop (Vector Instruction)
   deriving stock (Show, Eq)
+
+instance Arbitrary Instruction where
+  arbitrary :: Gen Instruction
+  arbitrary = Gen.oneof $
+    [ pure Increment
+    , pure Decrement
+    , pure MoveLeft
+    , pure MoveRight
+    , pure ReadByte
+    , pure PutByte
+    , Loop <$> reduceSize 8 arbitrary
+    ]
+    where
+      reduceSize d g = Gen.sized $ \ s -> Gen.resize (s `div` d) g
+
+-- >>> Gen.generate (Gen.resize 30 arbitrary) :: IO [Instruction]
+-- [MoveLeft,Decrement,PutByte,Decrement,Decrement,Increment,ReadByte,MoveLeft,Increment,Loop [],MoveRight,Increment,Increment,Loop [],MoveLeft,Loop [],MoveRight,ReadByte,ReadByte,MoveLeft,Decrement,MoveRight,MoveLeft,Loop [PutByte,Increment,Loop []],Decrement]