never executed always true always false
    1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser
    2   ( parseAsVector
    3   , parseAsVectorSafe
    4   ) where
    5 
    6 import           HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction    as Tree
    7 
    8 import           HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
    9 
   10 import           HelVM.HelMA.Automaton.API.IOTypes
   11 import           HelVM.HelMA.Automaton.ReadPExtra
   12 
   13 import           HelVM.HelIO.Control.Safe
   14 import           HelVM.HelIO.Extra                                       hiding ( runParser )
   15 
   16 import qualified Data.Text                                               as Text
   17 import qualified Data.Vector                                             as Vector
   18 
   19 import           Text.ParserCombinators.ReadP                            hiding ( many )
   20 
   21 parseAsVectorSafe ∷ Source → Safe TreeInstructionVector
   22 parseAsVectorSafe = parseAsVector
   23 
   24 parseAsVector ∷ MonadSafe m ⇒ Source → m TreeInstructionVector
   25 parseAsVector = runParser treeInstructionsParser . filterComments
   26 
   27 treeInstructionsParser ∷ ReadP TreeInstructionVector
   28 treeInstructionsParser = Vector.fromList <$> many treeInstructionParser
   29 
   30 treeInstructionParser ∷ ReadP TreeInstruction
   31 treeInstructionParser = simpleParser <|> whileParser
   32 
   33 whileParser ∷ ReadP TreeInstruction
   34 whileParser = Tree.While <$> (char '[' *> treeInstructionsParser <* char ']')
   35 
   36 simpleParser ∷ ReadP TreeInstruction
   37 simpleParser =  Simple . fromJustWithText "imposible" . charToSimpleInstruction <$> oneOf simpleInstructionChars
   38 
   39 filterComments ∷ Source → Source
   40 filterComments = Text.filter isNotComment
   41 
   42 isNotComment ∷ Char → Bool
   43 isNotComment c = c `elem` allInstructionChars
   44 
   45 allInstructionChars ∷ String
   46 allInstructionChars = "[]" <> simpleInstructionChars
   47 
   48 simpleInstructionChars ∷ String
   49 simpleInstructionChars = show =<< simpleInstructions