fix[test]: missing argument to function

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,6 +67,8 @@ test-suite bf-optimize-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Arbitrary.InvalidBrainfuckText
+      Arbitrary.ValidBrainfuckText
       Paths_bf_optimize
   autogen-modules:
       Paths_bf_optimize
@@ -69,8 +76,10 @@ 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
+    , 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

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]

src/Language/Brainfuck/Instruction/Compressed.hs

@@ -1,13 +1,19 @@
 {-# LANGUAGE ImportQualifiedPost #-}
-module Language.Brainfuck.Instruction.Compressed ( CompressedInstruction(..), compress ) where
+{-# LANGUAGE InstanceSigs #-}
+module Language.Brainfuck.Instruction.Compressed ( CompressedInstruction(..), compress, uncompress ) where
 
 import Data.Bifunctor ( Bifunctor(first) )
 import Data.Vector ( Vector )
 import Data.Word ( Word8 )
 import Numeric.Natural ( Natural )
+import Test.QuickCheck.Gen (Gen)
+import Test.QuickCheck.Arbitrary (Arbitrary(arbitrary))
+import Test.QuickCheck.Instances.Natural ()
 
 import Data.Vector qualified as Vector
 
+import Test.QuickCheck.Gen qualified as Gen
+
 import Language.Brainfuck.Instruction ( Instruction )
 import Language.Brainfuck.Instruction qualified as Instruction 
 
@@ -21,6 +27,20 @@ data CompressedInstruction
   | Loop (Vector CompressedInstruction)
   deriving (Show, Eq)
 
+instance Arbitrary CompressedInstruction where
+  arbitrary :: Gen CompressedInstruction
+  arbitrary = Gen.oneof
+    [ Add <$> arbitrary
+    , Subtract <$> arbitrary
+    , MoveRight <$> arbitrary
+    , MoveLeft <$> arbitrary
+    , pure ReadByte
+    , pure PutByte
+    , Loop <$> resize (`div` 8) arbitrary
+    ]
+    where
+      resize f x = Gen.sized $ \ s -> Gen.resize (f s) x
+
 compress :: Vector Instruction -> Vector CompressedInstruction
 compress instructions = Vector.fromList (go instructions)
   where
@@ -51,3 +71,18 @@ compress instructions = Vector.fromList (go instructions)
 -- >>> compress . Vector.fromList $ replicate 300 Instruction.MoveRight
 -- [MoveRight 300]
 
+uncompress :: Vector CompressedInstruction -> Vector Instruction
+uncompress = Vector.concatMap uncompressSingle
+  where
+    uncompressSingle instruction = let
+      repeated x times = Vector.replicate (fromIntegral times) x
+
+      in case instruction of
+        Add times       -> repeated Instruction.Increment times
+        Subtract times  -> repeated Instruction.Decrement times
+        MoveRight times -> repeated Instruction.MoveRight times
+        MoveLeft  times -> repeated Instruction.MoveLeft  times
+        PutByte         -> Vector.singleton Instruction.PutByte
+        ReadByte        -> Vector.singleton Instruction.ReadByte
+        Loop      body  -> Vector.singleton $ Instruction.Loop (uncompress body)
+

src/Language/Brainfuck/Instruction/Extended.hs

@@ -1,12 +1,16 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StrictData #-}
 module Language.Brainfuck.Instruction.Extended (Operation(..), Interaction(..), ExtendedInstruction(Modify, Move, Interact, Jump), pattern IfNonZero, pattern WithOffset, mkIfNonZero, mkWithOffset, translationSize, parse) where
+
 import Data.Word (Word8)
-import Language.Brainfuck.Instruction.Compressed (CompressedInstruction)
 import Data.Vector (Vector)
+import Numeric.Natural (Natural)
+
+import Language.Brainfuck.Instruction.Compressed (CompressedInstruction)
+
 import qualified Data.Vector as Vector
 import qualified Language.Brainfuck.Instruction.Compressed as CompressedInstruction
-import Numeric.Natural (Natural)
 
 data Operation
   = Add
@@ -18,7 +22,7 @@ data Interaction
   | Write
   deriving (Show)
 
-pattern WithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
+pattern WithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction
 pattern WithOffset offset embedded <- AtOffset offset embedded
   where
     WithOffset offset embedded = mkWithOffset offset embedded
@@ -29,7 +33,7 @@ pattern IfNonZero instruction <- WhenNonZero instruction
     IfNonZero instruction = mkIfNonZero instruction
 
 data ExtendedInstruction
-  = AtOffset Int ExtendedInstruction -- invariant, WithOffset may not nest itself
+  = AtOffset Integer ExtendedInstruction -- invariant, WithOffset may not nest itself
   | WhenNonZero ExtendedInstruction -- invariant, IfNonZero may not nest itself
   | Modify Operation Word8
   | Move Integer
@@ -42,7 +46,7 @@ mkIfNonZero = \case
   WhenNonZero i -> WhenNonZero i
   instruction -> WhenNonZero instruction
 
-mkWithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
+mkWithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction
 mkWithOffset offset = \case
   AtOffset offset' i -> AtOffset (offset + offset') i
   instruction -> AtOffset offset instruction
@@ -92,4 +96,3 @@ translationSize = Vector.sum . Vector.map instructionTranslationSize
 --
 -- >>> parse [CompressedInstruction.Add 5, CompressedInstruction.Loop [CompressedInstruction.Loop [CompressedInstruction.ReadByte], CompressedInstruction.PutByte]]
 -- [Modify Add 5,Jump 4,Jump 1,Interact Read,WhenNonZero (Jump (-2)),Interact Write,WhenNonZero (Jump (-5))]
-

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

@@ -0,0 +1,48 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Arbitrary.ValidBrainfuckText (ValidBrainfuckText(..)) 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 ValidBrainfuckText = ValidBrainfuckText { get :: Text }
+  deriving stock Show
+
+instance Arbitrary ValidBrainfuckText where
+  arbitrary :: Gen ValidBrainfuckText
+  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 ValidBrainfuckText)
+-- ValidBrainfuckText {get = "<[><]>[>],>+,[.-K.]+.>[<],z[p[[<]]+<],<[+]+[P[+][[e]]+,]+,.[-][[<],>>++]+"}
+
+

test/Spec.hs

@@ -1,2 +1,40 @@
+{-# 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.ValidBrainfuckText as ValidBrainfuckText
+import qualified Arbitrary.InvalidBrainfuckText as InValidBrainfuckText
+import qualified Language.Brainfuck.Instruction.Compressed as CompressedInstruction
+
+-- | ValidBrainfuckText will produce a text with comments, it must be parsed correctly
+prop_acceptValidTexts :: ValidBrainfuckText.ValidBrainfuckText -> Bool
+prop_acceptValidTexts = Either.isRight . Brainfuck.parse . ValidBrainfuckText.get
+
+-- | InvalidBrainfuckText will insert unbalanced brackets, they must be rejected
+prop_rejectInvalidTexts :: InValidBrainfuckText.InvalidBrainfuckText -> Bool
+prop_rejectInvalidTexts = Either.isLeft . Brainfuck.parse . InValidBrainfuckText.get
+
+-- | Does rendering and parsing a vector of instructions yield the exact same result?
+prop_renderParseInverse :: Vector Instruction -> Bool
+prop_renderParseInverse source = Right source == (Brainfuck.parse . Brainfuck.render $ source)
+
+-- | Compressing and Uncompressing should be inverse. The opposite must not be true, since `compress $ replicate 300 Increment` is `Add 44`
+prop_CompressUncompressInverse :: Vector Instruction -> Bool
+prop_CompressUncompressInverse source = source == (CompressedInstruction.uncompress . CompressedInstruction.compress) source
+
+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