content: --------------------------------------------------------------------
  -- |
  -- Module    : Text.Regex.Applicative.Reference
  -- Copyright : (c) Roman Cheplyaka
  -- License   : MIT
  --
  -- Maintainer: Roman Cheplyaka <roma@ro-che.info>
  -- Stability : experimental
  --
  -- Reference implementation (using backtracking).
  --
  -- This is exposed for testing purposes only!
  --------------------------------------------------------------------
  
  {-# LANGUAGE GADTs #-}
  module Text.Regex.Applicative.Reference (reference) where
  import Prelude hiding (getChar)
  import Text.Regex.Applicative.Types
  import Control.Applicative
  import Control.Monad
  
  
  -- A simple parsing monad
  newtype P s a = P { unP :: [s] -> [(a, [s])] }
  
  instance Monad (P s) where
      return x = P $ \s -> [(x, s)]
      (P a) >>= k = P $ \s ->
          a s >>= \(x,s) -> unP (k x) s
  
  instance Functor (P s) where
      fmap = liftM
  
  instance Applicative (P s) where
      (<*>) = ap
      pure = return
  
  instance Alternative (P s) where
      empty = P $ const []
      P a1 <|> P a2 = P $ \s ->
          a1 s ++ a2 s
  
  getChar :: P s s
  getChar = P $ \s ->
      case s of
          [] -> []
          c:cs -> [(c,cs)]
  
  re2monad :: RE s a -> P s a
  re2monad r =
      case r of
          Eps -> return $ error "eps"
          Symbol _ p -> do
              c <- getChar
              case p c of
                Just r -> return r
                Nothing -> empty
          Alt a1 a2 -> re2monad a1 <|> re2monad a2
          App a1 a2 -> re2monad a1 <*> re2monad a2
          Fmap f a -> fmap f $ re2monad a
          CatMaybes a -> maybe empty pure =<< re2monad a
          Rep g f b a -> rep b
              where
              am = re2monad a
              rep b = combine (do a <- am; rep $ f b a) (return b)
              combine a b = case g of Greedy -> a <|> b; NonGreedy -> b <|> a
          Void a -> re2monad a >> return ()
          Fail -> empty
  
  runP :: P s a -> [s] -> Maybe a
  runP m s = case filter (null . snd) $ unP m s of
      (r, _) : _ -> Just r
      _ -> Nothing
  
  -- | 'reference' @r@ @s@ should give the same results as @s@ '=~' @r@.
  --
  -- However, this is not very efficient implementation and is supposed to be
  -- used for testing only.
  reference :: RE s a -> [s] -> Maybe a
  reference r s = runP (re2monad r) s
  