{- CSci 556: Multiparadigm Programming, Spring 2017
   Parser Combinators for Language Recogniation, Version 1
   H. Conrad Cunningham, Professor
   Computer and Information Science
   University of Mississippi, USA

1234567890123456789012345678901234567890123456789012345678901234567890

2017-07-11:  Combinators based on prototype recursive descent parsing
             functions (ParserS02)

-}

module ParserComb
    (Parser, parseAlt, parseSeq, parseStar, parseOpt,
     parseAltList, parseSeqList, parseFail, parseSucceed)
where

type Parser a b = a -> (b,a)

parseAlt :: Parser a Bool -> Parser a Bool -> Parser a Bool
parseAlt p1 p2 =
    \xs ->
        case p1 xs of 
            (True,  ys) -> (True, ys)
            (False, _ ) ->
                case p2 xs of
                    (True,  ys) -> (True,  ys)
                    (False, _ ) -> (False, xs)

parseSeq :: Parser a Bool -> Parser a Bool -> Parser a Bool
parseSeq p1 p2 =
    \xs ->
        case p1 xs of
            (True,  ys) ->
                case p2 ys of
                    t@(True, zs) -> t
                    (False,  _ ) -> (False, xs)
            (False, _ ) -> (False,  xs)

parseStar :: Parser a Bool -> Parser a Bool
parseStar p1 =
    \xs ->
        case p1 xs of     
            (True,  ys) -> parseStar p1 ys
            (False, _ ) -> (True, xs)

parseOpt :: Parser a Bool -> Parser a Bool
parseOpt p1 =
    \xs ->
        case p1 xs of 
            (True,  ys) -> (True, ys)
            (False, _ ) -> (True, xs)

parseAltList :: [Parser a Bool] -> Parser a Bool
parseAltList ps =
    \xs ->
        case ps of
            []     -> (False, xs)
            (q:qs) ->
                case q xs of
                    (True,  ys) -> (True, ys)
                    (False, _ ) -> 
                        case parseAltList qs xs of
                            (True,  zs) -> (True,  zs)
                            (False, _ ) -> (False, xs)

parseSeqList :: [Parser a Bool] -> Parser a Bool
parseSeqList ps =
    \xs ->
        case ps of
            []     -> (True, xs)
            (q:qs) ->
                case q xs of
                    (True,  ys) ->
                        case parseSeqList qs ys of
                            (True, zs) -> (True,  zs)
                            (False,_ ) -> (False, xs)
                    (False, _ ) -> (False, xs)

parseFail, parseSucceed :: Parser a Bool
parseFail    = \xs -> (False,xs) 
parseSucceed = \xs -> (True, xs) 

{-
parseItem b =
    \xs ->
        case xs of
            (y:ys) | b y -> (True, ys)
            _            -> (False,xs)

parseList ts =
    \xs -> parseSeqList (map (\t -> parseItem (==t) ts) xs

-}