pad.hs

{-# LANGUAGE Rank2Types, OverloadedStrings, FlexibleInstances #-}

import Control.Applicative
import Control.Monad
import Data.String

newtype Parser t a = Par {cont :: forall m. MonadPlus m => m t -> m a}

instance Functor (Parser t) where
    fmap ab (Par pa) = Par $ \tok -> fmap ab $ pa tok
    a <$ (Par pb) = Par $ \tok -> a <$ pb tok

instance Applicative (Parser t) where
    pure a = Par $ \tok -> pure a
    (Par pab) <*> (Par pa) = Par $ \tok -> pab tok <*> pa tok
    (Par pa) *> (Par pb) = Par $ \tok -> pa tok *> pb tok
    (Par pa) <* (Par pb) = Par $ \tok -> pa tok <* pb tok

instance Alternative (Parser t) where
    empty = Par $ \tok -> empty
    (Par a1) <|> (Par a2) = Par $ \tok -> a1 tok <|> a2 tok
    some (Par a) = Par $ \tok -> some $ a tok
    many (Par a) = Par $ \tok -> many $ a tok

instance Monad (Parser t) where
    return a = Par $ \tok -> return a
    (Par pa) >>= apb = Par $ \tok -> pa tok >>= (flip cont tok . apb)
    (Par pa) >> (Par pb) = Par $ \tok -> pa tok >> pb tok
    fail s = Par $ \tok -> fail s

instance MonadPlus (Parser t) where
    mzero = Par $ \tok -> mzero
    mplus (Par a1) (Par a2) = Par $ \tok -> mplus (a1 tok) (a2 tok)

instance IsString (Parser Char ()) where
    fromString s = Par $ \tok -> mapM_ (\c -> mfilter (==c) tok) s

instance IsString (Parser Char String) where
    fromString s = s <$ (fromString s :: Parser Char ())