I already did a lot of things

src/Language/Brainfuck.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Language.Brainfuck (parse, ParseFailure) where
+
+import Control.Monad ((<$!>))
+import Control.Monad.ST (runST, ST)
+
+import Data.Text ( Text )
+import Data.Vector (MVector, Vector)
+
+import Data.Text qualified as Text
+import Data.Vector qualified as Vector
+import Data.Vector.Mutable qualified as MutableVector
+
+import Language.Brainfuck.Instruction ( Instruction(..) )
+
+data ParseFailure
+  = UnexpectedClosingBracket Int -- closing bracket position
+  | UnmatchedOpenBracket Int -- opening bracket position
+  deriving stock (Show)
+
+-- | Convert a Text to a list of instructions, discard all comments.
+--
+-- Recognized instructions are in the string "+-<>,.[]", they are represented as a Enum Type.
+
+parse :: Text -> Either ParseFailure (Vector Instruction)
+parse text = runST $ do
+  collectorVector <- MutableVector.new (Text.length text)
+
+  result <- go text collectorVector 0
+
+  pure $ case result of
+
+    Right (instructions, rest) -> case rest of
+      Text.Empty -> Right instructions
+      _ -> Left (UnexpectedClosingBracket $ Text.length text - Text.length rest)
+
+    Left failure -> Left failure
+
+  where
+
+    go :: Text -> MVector s Instruction -> Int -> ST s (Either ParseFailure (Vector Instruction, Text))
+    go (Text.Empty  ) instructions index = do
+      let populatedSlice = MutableVector.take index instructions
+      frozen <- Vector.force <$!> Vector.freeze populatedSlice
+      pure . Right $ (frozen, Text.empty)
+    go t@(c Text.:< cs) instructions index = let
+      
+      recognizeInstruction i cont = do
+        MutableVector.write instructions index i
+        go cont instructions (succ index)
+
+      in case c of
+        '+' -> recognizeInstruction Increment cs
+        '-' -> recognizeInstruction Decrement cs
+        '>' -> recognizeInstruction MoveRight cs
+        '<' -> recognizeInstruction MoveLeft  cs
+        ',' -> recognizeInstruction ReadByte  cs
+        '.' -> recognizeInstruction PutByte   cs
+        ']' -> do
+          let populatedSlice = MutableVector.take index instructions
+          frozen <- Vector.force <$!> Vector.freeze populatedSlice
+          pure $ Right (frozen, t)
+        '[' -> do
+          innerVector <- MutableVector.new (Text.length cs)
+          innerResult <- go cs innerVector 0
+          case innerResult of
+            Right (body, ']' Text.:< rest) -> recognizeInstruction (Loop body) rest
+            Right _ -> pure $ Left (UnmatchedOpenBracket $ Text.length text - Text.length t)
+            _ -> pure innerResult
+        _   -> go cs instructions index
+
+
+-- >>> parse $ Text.pack "<<>>,,..<,.>"
+-- Right [MoveLeft,MoveLeft,MoveRight,MoveRight,ReadByte,ReadByte,PutByte,PutByte,MoveLeft,ReadByte,PutByte,MoveRight]
+
+-- >>> parse $ Text.pack "[-]++<<<[>-[+-+-+]]>+"
+-- Right [Loop [Decrement],Increment,Increment,MoveLeft,MoveLeft,MoveLeft,Loop [MoveRight,Decrement,Loop [Increment,Decrement,Increment,Decrement,Increment]],MoveRight,Increment]
+
+-- >>> parse $ Text.pack "["
+-- Left (UnmatchedOpenBracket 0)
+
+-- >>> parse $ Text.pack "[]]"
+-- Left (UnexpectedClosingBracket 2)