never executed always true always false
    1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser (
    2   parseAsVectorSafe,
    3   parseAsVector,
    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