module Text.Syntax.Parser.Naive where
import Prelude ()
import Control.Category ()
import Control.Isomorphism.Partial (IsoFunctor, (<$>), apply)
import Control.Monad (Monad, return, fail, (>>=))
import Data.Char (String)
import Data.List ((++))
import Data.Maybe (Maybe (Just))
import Text.Syntax.Classes (ProductFunctor, Alternative, Syntax, (<*>), (<|>), empty, pure, token)
newtype Parser alpha
= Parser (String -> [(alpha, String)])
parse :: Parser alpha -> String -> [alpha]
parse (Parser p) s = [ x | (x, "") <- p s ]
parseM :: Monad m => Parser alpha -> String -> m alpha
parseM p s
= case parse p s of
[] -> fail "parse error"
[result] -> return result
_ -> fail "ambiguous input"
instance IsoFunctor Parser where
iso <$> Parser p
= Parser (\s -> [ (y, s')
| (x, s') <- p s
, Just y <- [apply iso x] ])
instance ProductFunctor Parser where
Parser p <*> Parser q
= Parser (\s -> [ ((x, y), s'')
| (x, s') <- p s
, (y, s'') <- q s' ])
instance Alternative Parser where
Parser p <|> Parser q
= Parser (\s -> p s ++ q s)
empty = Parser (\s -> [])
instance Syntax Parser where
pure x = Parser (\s -> [(x, s)])
token = Parser f where
f [] = []
f (t:ts) = [(t, ts)]