    --------------------------------------------------------------------
    -- |
    -- 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 { forall s a. P s a -> [s] -> [(a, [s])]
    unP :: [s] -> [(a, [s])] }

    instance Monad (P s) where
        return :: forall a. a -> P s a
    return a
    x = ([s] -> [(a, [s])]) -> P s a
    forall s a. ([s] -> [(a, [s])]) -> P s a
    P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
    forall a b. (a -> b) -> a -> b
    $ \[s]
    s -> [(a
    x, [s]
    s)]
        (P [s] -> [(a, [s])]
    a) >>= :: forall a b. P s a -> (a -> P s b) -> P s b
    >>= a -> P s b
    k = ([s] -> [(b, [s])]) -> P s b
    forall s a. ([s] -> [(a, [s])]) -> P s a
    P (([s] -> [(b, [s])]) -> P s b) -> ([s] -> [(b, [s])]) -> P s b
    forall a b. (a -> b) -> a -> b
    $ \[s]
    s ->
            [s] -> [(a, [s])]
    a [s]
    s [(a, [s])] -> ((a, [s]) -> [(b, [s])]) -> [(b, [s])]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(a
    x,[s]
    s) -> P s b -> [s] -> [(b, [s])]
    forall s a. P s a -> [s] -> [(a, [s])]
    unP (a -> P s b
    k a
    x) [s]
    s

    instance Functor (P s) where
        fmap :: forall a b. (a -> b) -> P s a -> P s b
    fmap = (a -> b) -> P s a -> P s b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative (P s) where
        <*> :: forall a b. P s (a -> b) -> P s a -> P s b
    (<*>) = P s (a -> b) -> P s a -> P s b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
        pure :: forall a. a -> P s a
    pure = a -> P s a
    forall a. a -> P s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    instance Alternative (P s) where
        empty :: forall a. P s a
    empty = ([s] -> [(a, [s])]) -> P s a
    forall s a. ([s] -> [(a, [s])]) -> P s a
    P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
    forall a b. (a -> b) -> a -> b
    $ [(a, [s])] -> [s] -> [(a, [s])]
    forall a b. a -> b -> a
    const []
        P [s] -> [(a, [s])]
    a1 <|> :: forall a. P s a -> P s a -> P s a
    <|> P [s] -> [(a, [s])]
    a2 = ([s] -> [(a, [s])]) -> P s a
    forall s a. ([s] -> [(a, [s])]) -> P s a
    P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
    forall a b. (a -> b) -> a -> b
    $ \[s]
    s ->
            [s] -> [(a, [s])]
    a1 [s]
    s [(a, [s])] -> [(a, [s])] -> [(a, [s])]
    forall a. [a] -> [a] -> [a]
    ++ [s] -> [(a, [s])]
    a2 [s]
    s

    getChar :: P s s
    getChar :: forall s. P s s
    getChar = ([s] -> [(s, [s])]) -> P s s
    forall s a. ([s] -> [(a, [s])]) -> P s a
    P (([s] -> [(s, [s])]) -> P s s) -> ([s] -> [(s, [s])]) -> P s s
    forall a b. (a -> b) -> a -> b
    $ \[s]
    s ->
        case [s]
    s of
            [] -> []
            s
    c:[s]
    cs -> [(s
    c,[s]
    cs)]

    re2monad :: RE s a -> P s a
    re2monad :: forall s a. RE s a -> P s a
    re2monad RE s a
    r =
        case RE s a
    r of
            RE s a
    Eps -> a -> P s a
    forall a. a -> P s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> P s a) -> a -> P s a
    forall a b. (a -> b) -> a -> b
    $ [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "eps"
            Symbol ThreadId
    _ s -> Maybe a
    p -> do
                c <- P s s
    forall s. P s s
    getChar
                case p c of
                  Just a
    r -> a -> P s a
    forall a. a -> P s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r
                  Maybe a
    Nothing -> P s a
    forall a. P s a
    forall (f :: * -> *) a. Alternative f => f a
    empty
            Alt RE s a
    a1 RE s a
    a2 -> RE s a -> P s a
    forall s a. RE s a -> P s a
    re2monad RE s a
    a1 P s a -> P s a -> P s a
    forall a. P s a -> P s a -> P s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> RE s a -> P s a
    forall s a. RE s a -> P s a
    re2monad RE s a
    a2
            App RE s (a1 -> a)
    a1 RE s a1
    a2 -> RE s (a1 -> a) -> P s (a1 -> a)
    forall s a. RE s a -> P s a
    re2monad RE s (a1 -> a)
    a1 P s (a1 -> a) -> P s a1 -> P s a
    forall a b. P s (a -> b) -> P s a -> P s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> RE s a1 -> P s a1
    forall s a. RE s a -> P s a
    re2monad RE s a1
    a2
            Fmap a1 -> a
    f RE s a1
    a -> (a1 -> a) -> P s a1 -> P s a
    forall a b. (a -> b) -> P s a -> P s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a1 -> a
    f (P s a1 -> P s a) -> P s a1 -> P s a
    forall a b. (a -> b) -> a -> b
    $ RE s a1 -> P s a1
    forall s a. RE s a -> P s a
    re2monad RE s a1
    a
            CatMaybes RE s (Maybe a)
    a -> P s a -> (a -> P s a) -> Maybe a -> P s a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe P s a
    forall a. P s a
    forall (f :: * -> *) a. Alternative f => f a
    empty a -> P s a
    forall a. a -> P s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe a -> P s a) -> P s (Maybe a) -> P s a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< RE s (Maybe a) -> P s (Maybe a)
    forall s a. RE s a -> P s a
    re2monad RE s (Maybe a)
    a
            Rep Greediness
    g a -> a1 -> a
    f a
    b RE s a1
    a -> a -> P s a
    rep a
    b
                where
                am :: P s a1
    am = RE s a1 -> P s a1
    forall s a. RE s a -> P s a
    re2monad RE s a1
    a
                rep :: a -> P s a
    rep a
    b = P s a -> P s a -> P s a
    combine (do a <- P s a1
    am; rep $ f b a) (a -> P s a
    forall a. a -> P s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    b)
                combine :: P s a -> P s a -> P s a
    combine P s a
    a P s a
    b = case Greediness
    g of Greediness
    Greedy -> P s a
    a P s a -> P s a -> P s a
    forall a. P s a -> P s a -> P s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P s a
    b; Greediness
    NonGreedy -> P s a
    b P s a -> P s a -> P s a
    forall a. P s a -> P s a -> P s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P s a
    a
            Void RE s a1
    a -> RE s a1 -> P s a1
    forall s a. RE s a -> P s a
    re2monad RE s a1
    a P s a1 -> P s a -> P s a
    forall a b. P s a -> P s b -> P s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> P s a
    forall a. a -> P s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            RE s a
    Fail -> P s a
    forall a. P s a
    forall (f :: * -> *) a. Alternative f => f a
    empty

    runP :: P s a -> [s] -> Maybe a
    runP :: forall s a. P s a -> [s] -> Maybe a
    runP P s a
    m [s]
    s = case ((a, [s]) -> Bool) -> [(a, [s])] -> [(a, [s])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([s] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([s] -> Bool) -> ((a, [s]) -> [s]) -> (a, [s]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, [s]) -> [s]
    forall a b. (a, b) -> b
    snd) ([(a, [s])] -> [(a, [s])]) -> [(a, [s])] -> [(a, [s])]
    forall a b. (a -> b) -> a -> b
    $ P s a -> [s] -> [(a, [s])]
    forall s a. P s a -> [s] -> [(a, [s])]
    unP P s a
    m [s]
    s of
        (a
    r, [s]
    _) : [(a, [s])]
    _ -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    r
        [(a, [s])]
    _ -> Maybe a
    forall a. Maybe a
    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 :: forall s a. RE s a -> [s] -> Maybe a
    reference RE s a
    r [s]
    s = P s a -> [s] -> Maybe a
    forall s a. P s a -> [s] -> Maybe a
    runP (RE s a -> P s a
    forall s a. RE s a -> P s a
    re2monad RE s a
    r) [s]
    s