bf-optimize.cabal

@@ -29,7 +29,6 @@ library
       Language.Brainfuck.Instruction
       Language.Brainfuck.Instruction.Compressed
       Language.Brainfuck.Instruction.Extended
-      Language.Brainfuck.Interpreter
   other-modules:
       Paths_bf_optimize
   autogen-modules:
@@ -38,9 +37,7 @@ 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:
-      QuickCheck
+      base >=4.7 && <5
-    , base >=4.7 && <5
-    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010
@@ -55,10 +52,8 @@ 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:
-      QuickCheck
+      base >=4.7 && <5
-    , base >=4.7 && <5
     , bf-optimize
-    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010
@@ -67,8 +62,6 @@ 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
@@ -76,10 +69,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:
-      QuickCheck
+      base >=4.7 && <5
-    , base >=4.7 && <5
     , bf-optimize
-    , quickcheck-instances
     , text
     , vector
   default-language: Haskell2010

package.yaml

@@ -23,8 +23,6 @@ dependencies:
 - base >= 4.7 && < 5
 - text
 - vector
-- QuickCheck
-- quickcheck-instances
 
 ghc-options:
 - -Wall

src/Language/Brainfuck.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE LambdaCase #-}
+module Language.Brainfuck (parse, ParseFailure) where
-module Language.Brainfuck (parse, ParseFailure, render) where
 
 import Control.Monad ((<$!>))
 import Control.Monad.ST (runST, ST)
@@ -15,12 +14,11 @@ 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, Eq)
+  deriving stock (Show)
 
 -- | Convert a Text to a list of instructions, discard all comments.
 --
@@ -85,21 +83,3 @@ 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,13 +1,7 @@
 {-# 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
@@ -18,20 +12,3 @@ 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,19 +1,13 @@
 {-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE InstanceSigs #-}
+module Language.Brainfuck.Instruction.Compressed ( CompressedInstruction(..), compress ) where
-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 
 
@@ -27,20 +21,6 @@ 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
@@ -71,18 +51,3 @@ 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,16 +1,12 @@
 {-# 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 Data.Vector (Vector)
-import Numeric.Natural (Natural)
-
 import Language.Brainfuck.Instruction.Compressed (CompressedInstruction)
-
+import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import qualified Language.Brainfuck.Instruction.Compressed as CompressedInstruction
+import Numeric.Natural (Natural)
 
 data Operation
   = Add
@@ -22,7 +18,7 @@ data Interaction
   | Write
   deriving (Show)
 
-pattern WithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction
+pattern WithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
 pattern WithOffset offset embedded <- AtOffset offset embedded
   where
     WithOffset offset embedded = mkWithOffset offset embedded
@@ -33,7 +29,7 @@ pattern IfNonZero instruction <- WhenNonZero instruction
     IfNonZero instruction = mkIfNonZero instruction
 
 data ExtendedInstruction
-  = AtOffset Integer ExtendedInstruction -- invariant, WithOffset may not nest itself
+  = AtOffset Int ExtendedInstruction -- invariant, WithOffset may not nest itself
   | WhenNonZero ExtendedInstruction -- invariant, IfNonZero may not nest itself
   | Modify Operation Word8
   | Move Integer
@@ -46,7 +42,7 @@ mkIfNonZero = \case
   WhenNonZero i -> WhenNonZero i
   instruction -> WhenNonZero instruction
 
-mkWithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction
+mkWithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
 mkWithOffset offset = \case
   AtOffset offset' i -> AtOffset (offset + offset') i
   instruction -> AtOffset offset instruction
@@ -96,3 +92,4 @@ 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

@@ -1,26 +0,0 @@
-{-# 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,48 +0,0 @@
-{-# 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,40 +1,2 @@
-{-# 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 = do
+main = putStrLn "Test suite not yet implemented"
-  quickCheckGood <- runQuickCheck
-
-  if quickCheckGood then exitSuccess else exitFailure