{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}

-- | An inefficient backtracking parser based on list of successes.
module SucParser (
  SucParser, sucSatisfy, runSucParser, toFunction, fromFunction
  ) where

import Data.Maybe (listToMaybe)
import qualified Control.Monad as M
import qualified Control.Applicative as A
import qualified Control.Monad.State as S
import StateInstances ()
import ParserClass

-- | An inefficient parser based on a list of successes.
newtype SucParser s a = SucParser (S.StateT [s] [] a)
  deriving (Functor, A.Applicative, A.Alternative, M.Monad, M.MonadPlus, S.MonadState [s])

instance Parser (SucParser s) where
  type Input (SucParser s) = s
  type ParseResult (SucParser s) = Maybe
  satisfy   = sucSatisfy
  runParser = runSucParser

-- | Runs a parser on the given input, yielding a result on success.
runSucParser :: SucParser s a -> [s] -> Maybe a
runSucParser (SucParser p) input =
  listToMaybe [ x | (x, []) <- S.runStateT p input ]

-- | Recognise a symbol matching a predicate.
sucSatisfy :: (s -> Bool) -> SucParser s s
sucSatisfy pred = do
  x:xs <- S.get
  if pred x
    then do S.put xs; return x
    else fail "parse error"

-- | Converts the parser to its internal function type.
toFunction :: SucParser s a -> [s] -> [(a, [s])]
toFunction (SucParser p) = S.runStateT p

-- | Builds a parser from a low-level function type.
fromFunction :: ([s] -> [(a, [s])]) -> SucParser s a
fromFunction = SucParser . S.StateT