diff --git a/bf-optimize.cabal b/bf-optimize.cabal index 5bae42a..ca802e7 100644 --- a/bf-optimize.cabal +++ b/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.ValidBrainfuckProgram + Arbitrary.InvalidBrainfuckText + 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 diff --git a/package.yaml b/package.yaml index 257b77d..3b9462d 100644 --- a/package.yaml +++ b/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 diff --git a/src/Language/Brainfuck.hs b/src/Language/Brainfuck.hs index 0d0e320..c348315 100644 --- a/src/Language/Brainfuck.hs +++ b/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 +-- "<,<>,<,." + diff --git a/src/Language/Brainfuck/Instruction.hs b/src/Language/Brainfuck/Instruction.hs index a1a6a70..80a52aa 100644 --- a/src/Language/Brainfuck/Instruction.hs +++ b/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] diff --git a/test/Arbitrary/InvalidBrainfuckProgram.hs b/test/Arbitrary/InvalidBrainfuckProgram.hs deleted file mode 100644 index f51c591..0000000 --- a/test/Arbitrary/InvalidBrainfuckProgram.hs +++ /dev/null @@ -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] - diff --git a/test/Arbitrary/InvalidBrainfuckText.hs b/test/Arbitrary/InvalidBrainfuckText.hs new file mode 100644 index 0000000..42b97f1 --- /dev/null +++ b/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] + diff --git a/test/Arbitrary/ValidBrainfuckProgram.hs b/test/Arbitrary/ValidBrainfuckText.hs similarity index 74% rename from test/Arbitrary/ValidBrainfuckProgram.hs rename to test/Arbitrary/ValidBrainfuckText.hs index a8d350e..c5a0505 100644 --- a/test/Arbitrary/ValidBrainfuckProgram.hs +++ b/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 - arbitrary :: Gen ValidBrainfuckProgram +instance Arbitrary ValidBrainfuckText where + 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) --- ValidBrainfuckProgram {get = "<-"} +-- >>> generate $ (arbitrary :: Gen ValidBrainfuckText) +-- ValidBrainfuckText {get = "<[><]>[>],>+,[.-K.]+.>[<],z[p[[<]]+<],<[+]+[P[+][[e]]+,]+,.[-][[<],>>++]+"} + diff --git a/test/Spec.hs b/test/Spec.hs index 51237ef..238a797 100644 --- a/test/Spec.hs +++ b/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.InvalidBrainfuckProgram as InValidBrainfuckProgram +import qualified Arbitrary.ValidBrainfuckText as ValidBrainfuckText +import qualified Arbitrary.InvalidBrainfuckText as InValidBrainfuckText -prop_acceptValidPrograms :: ValidBrainfuckProgram.ValidBrainfuckProgram -> Bool -prop_acceptValidPrograms = Either.isRight . Brainfuck.parse . ValidBrainfuckProgram.get +prop_acceptValidTexts :: ValidBrainfuckText.ValidBrainfuckText -> Bool +prop_acceptValidTexts = Either.isRight . Brainfuck.parse . ValidBrainfuckText.get -prop_rejectInvalidPrograms :: InValidBrainfuckProgram.InvalidBrainfuckProgram -> Bool -prop_rejectInvalidPrograms = Either.isLeft . Brainfuck.parse . InValidBrainfuckProgram.get +prop_rejectInvalidTexts :: InValidBrainfuckText.InvalidBrainfuckText -> Bool +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