feat: QuickCheck testing

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

package.yaml

@@ -59,3 +59,4 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - bf-optimize
+    - QuickCheck

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]
+

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 = "<-"}
+

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