feat: tests for the rendering/parsing

bf-optimize.cabal

@@ -29,6 +29,7 @@ library
       Language.Brainfuck.Instruction
       Language.Brainfuck.Instruction.Compressed
       Language.Brainfuck.Instruction.Extended
+      Language.Brainfuck.Interpreter
   other-modules:
       Paths_bf_optimize
   autogen-modules:
@@ -37,7 +38,9 @@ library
       src
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      QuickCheck
+    , base >=4.7 && <5
+    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010
@@ -52,8 +55,10 @@ executable bf-optimize-exe
       app
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      QuickCheck
+    , base >=4.7 && <5
     , bf-optimize
+    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010
@@ -62,8 +67,8 @@ test-suite bf-optimize-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Arbitrary.InvalidBrainfuckProgram
+      Arbitrary.InvalidBrainfuckText
-      Arbitrary.ValidBrainfuckProgram
+      Arbitrary.ValidBrainfuckText
       Paths_bf_optimize
   autogen-modules:
       Paths_bf_optimize
@@ -74,6 +79,7 @@ test-suite bf-optimize-test
       QuickCheck
     , base >=4.7 && <5
     , bf-optimize
+    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010

package.yaml

@@ -23,6 +23,8 @@ dependencies:
 - base >= 4.7 && < 5
 - text
 - vector
+- QuickCheck
+- quickcheck-instances
 
 ghc-options:
 - -Wall
@@ -59,4 +61,3 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - bf-optimize
-    - QuickCheck

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]

test/Arbitrary/InvalidBrainfuckProgram.hs

@@ -1,26 +0,0 @@
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE DerivingStrategies #-}
-module Arbitrary.InvalidBrainfuckProgram (InvalidBrainfuckProgram(..)) where
-
-import Data.Text (Text)
-import Test.QuickCheck.Gen (Gen)
-import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
-
-import qualified Data.Text as Text
-import qualified Test.QuickCheck.Gen as Gen
-import qualified Arbitrary.ValidBrainfuckProgram as ValidBrainfuckProgram
-
-newtype InvalidBrainfuckProgram = InvalidBrainfuckProgram { get :: Text }
-  deriving stock Show
-
-instance Arbitrary InvalidBrainfuckProgram where
-  arbitrary :: Gen InvalidBrainfuckProgram
-  arbitrary = do
-    validProgram <- ValidBrainfuckProgram.get <$> arbitrary
-
-    index <- Gen.choose (0, Text.length validProgram)
-    badBrace <- Gen.oneof $ map pure "[]"
-    let (prefix, suffix) = Text.splitAt index validProgram
-    
-    pure . InvalidBrainfuckProgram $ Text.concat [prefix, Text.singleton badBrace, suffix]
-

test/Arbitrary/InvalidBrainfuckText.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Arbitrary.InvalidBrainfuckText (InvalidBrainfuckText(..)) where
+
+import Data.Text (Text)
+import Test.QuickCheck.Gen (Gen)
+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
+
+import qualified Data.Text as Text
+import qualified Test.QuickCheck.Gen as Gen
+import qualified Arbitrary.ValidBrainfuckText as ValidBrainfuckText
+
+newtype InvalidBrainfuckText = InvalidBrainfuckText { get :: Text }
+  deriving stock Show
+
+instance Arbitrary InvalidBrainfuckText where
+  arbitrary :: Gen InvalidBrainfuckText
+  arbitrary = do
+    validText <- ValidBrainfuckText.get <$> arbitrary
+
+    index <- Gen.choose (0, Text.length validText)
+    badBrace <- Gen.oneof $ map pure "[]"
+    let (prefix, suffix) = Text.splitAt index validText
+    
+    pure . InvalidBrainfuckText $ Text.concat [prefix, Text.singleton badBrace, suffix]
+

test/Arbitrary/ValidBrainfuckText.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE DerivingStrategies #-}
-module Arbitrary.ValidBrainfuckProgram (ValidBrainfuckProgram(..)) where
+module Arbitrary.ValidBrainfuckText (ValidBrainfuckText(..)) where
 import Data.Text (Text)
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import Test.QuickCheck.Gen (Gen, sized, frequency, oneof, resize)
@@ -8,11 +8,11 @@ import Data.Coerce (coerce)
 
 import qualified Data.Text as Text
 
-newtype ValidBrainfuckProgram = ValidBrainfuckProgram { get :: Text }
+newtype ValidBrainfuckText = ValidBrainfuckText { get :: Text }
   deriving stock Show
 
-instance Arbitrary ValidBrainfuckProgram where
+instance Arbitrary ValidBrainfuckText where
-  arbitrary :: Gen ValidBrainfuckProgram
+  arbitrary :: Gen ValidBrainfuckText
   arbitrary = coerce . fmap Text.pack $ character []
     where
       character rest = do
@@ -42,6 +42,7 @@ instance Arbitrary ValidBrainfuckProgram where
             pure $ commentChar : rest
 
 -- >>> import Test.QuickCheck.Gen (generate)
--- >>> generate $ (arbitrary :: Gen ValidBrainfuckProgram)
+-- >>> generate $ (arbitrary :: Gen ValidBrainfuckText)
--- ValidBrainfuckProgram {get = "<-"}
+-- ValidBrainfuckText {get = "<[><]>[>],>+,[.-K.]+.>[<],z[p[[<]]+<],<[+]+[P[+][[e]]+,]+,.[-][[<],>>++]+"}
+
 

test/Spec.hs

@@ -1,17 +1,25 @@
 {-# LANGUAGE TemplateHaskell #-}
+
+import Data.Vector (Vector)
+
 import Test.QuickCheck.All (quickCheckAll)
 import System.Exit (exitFailure, exitSuccess)
 
+import Language.Brainfuck.Instruction (Instruction)
+
 import qualified Data.Either as Either
 import qualified Language.Brainfuck as Brainfuck
-import qualified Arbitrary.ValidBrainfuckProgram as ValidBrainfuckProgram
+import qualified Arbitrary.ValidBrainfuckText as ValidBrainfuckText
-import qualified Arbitrary.InvalidBrainfuckProgram as InValidBrainfuckProgram
+import qualified Arbitrary.InvalidBrainfuckText as InValidBrainfuckText
 
-prop_acceptValidPrograms   :: ValidBrainfuckProgram.ValidBrainfuckProgram -> Bool
+prop_acceptValidTexts   :: ValidBrainfuckText.ValidBrainfuckText -> Bool
-prop_acceptValidPrograms   = Either.isRight . Brainfuck.parse . ValidBrainfuckProgram.get
+prop_acceptValidTexts   = Either.isRight . Brainfuck.parse . ValidBrainfuckText.get
 
-prop_rejectInvalidPrograms :: InValidBrainfuckProgram.InvalidBrainfuckProgram -> Bool
+prop_rejectInvalidTexts :: InValidBrainfuckText.InvalidBrainfuckText -> Bool
-prop_rejectInvalidPrograms = Either.isLeft . Brainfuck.parse . InValidBrainfuckProgram.get
+prop_rejectInvalidTexts = Either.isLeft . Brainfuck.parse . InValidBrainfuckText.get
+
+prop_renderParseInverse :: Vector Instruction -> Bool
+prop_renderParseInverse source = Right source == (Brainfuck.parse . Brainfuck.render $ source)
 
 return [] -- template haskell guard
 runQuickCheck :: IO Bool