IntListParser.hs

import Data.Char (isDigit, isSpace)

newtype Parser a = Parser { runParser :: String -> [(a, String)]}

instance Functor Parser where
    fmap f p = Parser $ \str ->
        case runParser p str of
             []        -> []
             [(y, ys)] -> [(f y, ys)] 

instance Applicative Parser where
    pure a = Parser $ \str -> [(a, str)]
    p <*> q = Parser $ \str ->
        case runParser p str of
             []          -> []
             [(f, str')] ->
                case runParser q str' of
                    []         -> []
                    [(x, xs)]  -> [(f x, xs)]

instance Monad Parser where
    return x = Parser $ \s -> [(x, s)]
    p >>= f = Parser $ \str ->
        case runParser p str of
            [] -> []
            [(x, str')] -> runParser (f x) str'

(+++) :: Parser a -> Parser a -> Parser a
f +++ g = Parser $ \str ->
    case runParser f str of
        []              -> runParser g str
        [(x, xs)]       -> [(x, xs)]

failure :: Parser a
failure = Parser $ \_ -> []


----
item :: Parser Char
item = Parser $ \str ->
    case str of
        [] -> []
        (x:xs) -> [(x, xs)]
    
sat :: (Char -> Bool) -> Parser Char
sat p = do 
    x <- item
    if p x then return x else failure

----

digit :: Parser Char
digit = sat isDigit

char :: Char -> Parser Char
char x = sat (==x)


string :: String -> Parser String
string [] = return []
string (x:xs) = do
    x <- char x
    string xs
    return (x:xs)


many :: Parser a -> Parser [a]
many p = many' p +++ return []

many' :: Parser a -> Parser [a]
many' p = do
    x <- p
    xs <- many p
    return (x:xs)

nat :: Parser Int 
nat = do
    ds <- (many digit)
    return (read ds)

spc :: Parser ()
spc = do
    many (sat isSpace)
    return ()

token :: Parser a -> Parser a
token p = do
    spc
    x <- p
    spc
    return x

symbol :: String -> Parser String
symbol str = token (string str)

natList :: Parser [Int]
natList = do
    symbol "["
    n <- token nat
    ns <- many (do 
            symbol ","
            token nat)
    symbol "]"
    return (n:ns)

main :: IO ()
main = do
    let str = "[11,23,43]"
    let [(ds, _)] = runParser natList str
    print ds
    print $ foldl1 (+) ds