From 95f86c86606b0c41f810a0a18bc5e5d2512a2e3b Mon Sep 17 00:00:00 2001
From: VegOwOtenks <vegowotenks@jossco.de>
Date: Thu, 19 Jun 2025 21:51:34 +0200
Subject: [PATCH] feat: QuickCheck testing

---
 bf-optimize.cabal                         |  5 ++-
 package.yaml                              |  1 +
 test/Arbitrary/InvalidBrainfuckProgram.hs | 26 +++++++++++++
 test/Arbitrary/ValidBrainfuckProgram.hs   | 47 +++++++++++++++++++++++
 test/Spec.hs                              | 24 +++++++++++-
 5 files changed, 101 insertions(+), 2 deletions(-)
 create mode 100644 test/Arbitrary/InvalidBrainfuckProgram.hs
 create mode 100644 test/Arbitrary/ValidBrainfuckProgram.hs

diff --git a/bf-optimize.cabal b/bf-optimize.cabal
index cd815da..5bae42a 100644
--- a/bf-optimize.cabal
+++ b/bf-optimize.cabal
@@ -62,6 +62,8 @@ test-suite bf-optimize-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Arbitrary.InvalidBrainfuckProgram
+      Arbitrary.ValidBrainfuckProgram
       Paths_bf_optimize
   autogen-modules:
       Paths_bf_optimize
@@ -69,7 +71,8 @@ test-suite bf-optimize-test
       test
   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
     , text
     , vector
diff --git a/package.yaml b/package.yaml
index 8aebee4..257b77d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -59,3 +59,4 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - bf-optimize
+    - QuickCheck
diff --git a/test/Arbitrary/InvalidBrainfuckProgram.hs b/test/Arbitrary/InvalidBrainfuckProgram.hs
new file mode 100644
index 0000000..f51c591
--- /dev/null
+++ b/test/Arbitrary/InvalidBrainfuckProgram.hs
@@ -0,0 +1,26 @@
+{-# 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]
+
diff --git a/test/Arbitrary/ValidBrainfuckProgram.hs b/test/Arbitrary/ValidBrainfuckProgram.hs
new file mode 100644
index 0000000..a8d350e
--- /dev/null
+++ b/test/Arbitrary/ValidBrainfuckProgram.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Arbitrary.ValidBrainfuckProgram (ValidBrainfuckProgram(..)) where
+import Data.Text (Text)
+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
+import Test.QuickCheck.Gen (Gen, sized, frequency, oneof, resize)
+import Data.Coerce (coerce)
+
+import qualified Data.Text as Text
+
+newtype ValidBrainfuckProgram = ValidBrainfuckProgram { get :: Text }
+  deriving stock Show
+
+instance Arbitrary ValidBrainfuckProgram where
+  arbitrary :: Gen ValidBrainfuckProgram
+  arbitrary = coerce . fmap Text.pack $ character []
+    where
+      character rest = do
+        body <- frequency
+          [ (1, comment)
+          , (9, operator)
+          ]
+
+        sized $ \ size -> frequency
+          [ (1   , pure body)
+          , (size, character body)
+          ]
+
+        where
+          operator = let
+
+            simpleOperator = oneof $ map (pure . (:rest)) "+-<>,."
+            loopOperator = fmap ('[':) . sized $ \ s -> resize (s `div` 8) (character (']':rest))
+
+            in frequency 
+              [ (3, simpleOperator)
+              , (1, loopOperator)
+              ]
+
+          comment = do
+            commentChar <- oneof $ map pure "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+            pure $ commentChar : rest
+
+-- >>> import Test.QuickCheck.Gen (generate)
+-- >>> generate $ (arbitrary :: Gen ValidBrainfuckProgram)
+-- ValidBrainfuckProgram {get = "<-"}
+
diff --git a/test/Spec.hs b/test/Spec.hs
index cd4753f..51237ef 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,2 +1,24 @@
+{-# LANGUAGE TemplateHaskell #-}
+import Test.QuickCheck.All (quickCheckAll)
+import System.Exit (exitFailure, exitSuccess)
+
+import qualified Data.Either as Either
+import qualified Language.Brainfuck as Brainfuck
+import qualified Arbitrary.ValidBrainfuckProgram as ValidBrainfuckProgram
+import qualified Arbitrary.InvalidBrainfuckProgram as InValidBrainfuckProgram
+
+prop_acceptValidPrograms   :: ValidBrainfuckProgram.ValidBrainfuckProgram -> Bool
+prop_acceptValidPrograms   = Either.isRight . Brainfuck.parse . ValidBrainfuckProgram.get
+
+prop_rejectInvalidPrograms :: InValidBrainfuckProgram.InvalidBrainfuckProgram -> Bool
+prop_rejectInvalidPrograms = Either.isLeft . Brainfuck.parse . InValidBrainfuckProgram.get
+
+return [] -- template haskell guard
+runQuickCheck :: IO Bool
+runQuickCheck = $quickCheckAll
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = do
+  quickCheckGood <- runQuickCheck
+
+  if quickCheckGood then exitSuccess else exitFailure