feat[compressed]: ability to uncompress

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

@@ -96,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/Spec.hs

@@ -11,6 +11,7 @@ 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
@@ -24,6 +25,10 @@ prop_rejectInvalidTexts = Either.isLeft . Brainfuck.parse . InValidBrainfuckText
 prop_renderParseInverse :: Vector Instruction -> Bool
 prop_renderParseInverse source = Right source == (Brainfuck.parse . Brainfuck.render $ source)
 
+-- | Compressing and Uncompressing should be inverse
+prop_CompressUncompressInverse :: Vector Instruction -> Bool
+prop_CompressUncompressInverse source = source == CompressedInstruction.uncompress . CompressedInstruction.compress
+
 return [] -- template haskell guard
 runQuickCheck :: IO Bool
 runQuickCheck = $quickCheckAll