Recursive descent parser for grammar S -> baSab ∣ baS ∣ b

gistfile1.hs

module Main where

import Control.Monad (when)
import Control.Applicative ((<|>))
import Data.List
import Data.Maybe
import Debug.Trace

pS :: String -> Maybe String

pS s
    | trace ("pS " ++ s) False = undefined
    | otherwise = pS1 s <|> pS2 s <|> pS3 s 

pS1 :: String -> Maybe String
pS1 s = let (h, r) = splitAt 2 s in
  if h == "ba"
    then do
      t <- pS r
      if "ba" `isPrefixOf` t 
        then return $ drop 2 t
        else fail "NOOOO!"
    else
      fail "NOOOOO!"

pS2 :: String -> Maybe String
pS2 s | trace ("pS2 " ++ s) False = undefined
pS2 s = if h == "ba" then pS t else Nothing
    where (h, t) = splitAt 2 s 

pS3 :: String -> Maybe String
pS3 s | trace ("pS3 " ++ s) False = undefined
pS3 s = if "b" `isPrefixOf` s then Just $ tail s else Nothing  

main::IO()
main = print $ pS "babab"