1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
--------------------------------------------------------------------
-- |
-- 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
|
