module Text.XML.HXT.Arrow.XmlRegex
( XmlRegex
, mkZero
, mkUnit
, mkPrim
, mkPrim'
, mkPrimA
, mkDot
, mkStar
, mkAlt
, mkAlts
, mkSeq
, mkSeqs
, mkRep
, mkRng
, mkOpt
, mkPerm
, mkPerms
, mkMerge
, nullable
, delta
, matchXmlRegex
, splitXmlRegex
, scanXmlRegex
, matchRegexA
, splitRegexA
, scanRegexA
)
where
import Control.Arrow.ListArrows
import Data.Maybe
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.DOM.ShowXml (xshow)
matchRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree XmlTrees
matchRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree XmlTrees
matchRegexA XmlRegex
re LA XmlTree XmlTree
ts = LA XmlTree XmlTree
ts forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (\ XmlTrees
s -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [XmlTrees
s] (forall a b. a -> b -> a
const []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlRegex -> XmlTrees -> Maybe String
matchXmlRegex XmlRegex
re forall a b. (a -> b) -> a -> b
$ XmlTrees
s)
splitRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree (XmlTrees, XmlTrees)
splitRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree (XmlTrees, XmlTrees)
splitRegexA XmlRegex
re LA XmlTree XmlTree
ts = LA XmlTree XmlTree
ts forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlRegex -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex XmlRegex
re)
scanRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree XmlTrees
scanRegexA :: XmlRegex -> LA XmlTree XmlTree -> LA XmlTree XmlTrees
scanRegexA XmlRegex
re LA XmlTree XmlTree
ts = LA XmlTree XmlTree
ts forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlRegex -> XmlTrees -> Maybe [XmlTrees]
scanXmlRegex XmlRegex
re)
data XmlRegex = Zero String
| Unit
| Sym (XmlTree -> Bool) String
| Dot
| Star XmlRegex
| Alt XmlRegex XmlRegex
| Seq XmlRegex XmlRegex
| Rep Int XmlRegex
| Rng Int Int XmlRegex
| Perm XmlRegex XmlRegex
| Merge XmlRegex XmlRegex
mkZero :: String -> XmlRegex
mkZero :: String -> XmlRegex
mkZero = String -> XmlRegex
Zero
mkUnit :: XmlRegex
mkUnit :: XmlRegex
mkUnit = XmlRegex
Unit
mkPrim :: (XmlTree -> Bool) -> XmlRegex
mkPrim :: (XmlTree -> Bool) -> XmlRegex
mkPrim XmlTree -> Bool
p = (XmlTree -> Bool) -> String -> XmlRegex
Sym XmlTree -> Bool
p String
""
mkPrim' :: (XmlTree -> Bool) -> String -> XmlRegex
mkPrim' :: (XmlTree -> Bool) -> String -> XmlRegex
mkPrim' = (XmlTree -> Bool) -> String -> XmlRegex
Sym
mkPrimA :: LA XmlTree XmlTree -> XmlRegex
mkPrimA :: LA XmlTree XmlTree -> XmlRegex
mkPrimA LA XmlTree XmlTree
a = (XmlTree -> Bool) -> XmlRegex
mkPrim (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
a)
mkDot :: XmlRegex
mkDot :: XmlRegex
mkDot = XmlRegex
Dot
mkStar :: XmlRegex -> XmlRegex
mkStar :: XmlRegex -> XmlRegex
mkStar (Zero String
_) = XmlRegex
mkUnit
mkStar e :: XmlRegex
e@XmlRegex
Unit = XmlRegex
e
mkStar e :: XmlRegex
e@(Star XmlRegex
_e1) = XmlRegex
e
mkStar (Rep Int
1 XmlRegex
e1) = XmlRegex -> XmlRegex
mkStar XmlRegex
e1
mkStar e :: XmlRegex
e@(Alt XmlRegex
_ XmlRegex
_) = XmlRegex -> XmlRegex
Star (XmlRegex -> XmlRegex
rmStar XmlRegex
e)
mkStar XmlRegex
e = XmlRegex -> XmlRegex
Star XmlRegex
e
rmStar :: XmlRegex -> XmlRegex
rmStar :: XmlRegex -> XmlRegex
rmStar (Alt XmlRegex
e1 XmlRegex
e2) = XmlRegex -> XmlRegex -> XmlRegex
mkAlt (XmlRegex -> XmlRegex
rmStar XmlRegex
e1) (XmlRegex -> XmlRegex
rmStar XmlRegex
e2)
rmStar (Star XmlRegex
e1) = XmlRegex -> XmlRegex
rmStar XmlRegex
e1
rmStar (Rep Int
1 XmlRegex
e1) = XmlRegex -> XmlRegex
rmStar XmlRegex
e1
rmStar XmlRegex
e1 = XmlRegex
e1
mkAlt :: XmlRegex -> XmlRegex -> XmlRegex
mkAlt :: XmlRegex -> XmlRegex -> XmlRegex
mkAlt XmlRegex
e1 (Zero String
_) = XmlRegex
e1
mkAlt (Zero String
_) XmlRegex
e2 = XmlRegex
e2
mkAlt e1 :: XmlRegex
e1@(Star XmlRegex
Dot) XmlRegex
_e2 = XmlRegex
e1
mkAlt XmlRegex
_e1 e2 :: XmlRegex
e2@(Star XmlRegex
Dot) = XmlRegex
e2
mkAlt (Sym XmlTree -> Bool
p1 String
e1) (Sym XmlTree -> Bool
p2 String
e2) = (XmlTree -> Bool) -> String -> XmlRegex
mkPrim' (\ XmlTree
x -> XmlTree -> Bool
p1 XmlTree
x Bool -> Bool -> Bool
|| XmlTree -> Bool
p2 XmlTree
x) (String -> String -> String
e String
e1 String
e2)
where
e :: String -> String -> String
e String
"" String
x2 = String
x2
e String
x1 String
"" = String
x1
e String
x1 String
x2 = String
x1 forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
x2
mkAlt XmlRegex
e1 e2 :: XmlRegex
e2@(Sym XmlTree -> Bool
_ String
_) = XmlRegex -> XmlRegex -> XmlRegex
mkAlt XmlRegex
e2 XmlRegex
e1
mkAlt e1 :: XmlRegex
e1@(Sym XmlTree -> Bool
_ String
_) (Alt e2 :: XmlRegex
e2@(Sym XmlTree -> Bool
_ String
_) XmlRegex
e3)
= XmlRegex -> XmlRegex -> XmlRegex
mkAlt (XmlRegex -> XmlRegex -> XmlRegex
mkAlt XmlRegex
e1 XmlRegex
e2) XmlRegex
e3
mkAlt (Alt XmlRegex
e1 XmlRegex
e2) XmlRegex
e3 = XmlRegex -> XmlRegex -> XmlRegex
mkAlt XmlRegex
e1 (XmlRegex -> XmlRegex -> XmlRegex
mkAlt XmlRegex
e2 XmlRegex
e3)
mkAlt XmlRegex
e1 XmlRegex
e2 = XmlRegex -> XmlRegex -> XmlRegex
Alt XmlRegex
e1 XmlRegex
e2
mkAlts :: [XmlRegex] -> XmlRegex
mkAlts :: [XmlRegex] -> XmlRegex
mkAlts = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XmlRegex -> XmlRegex -> XmlRegex
mkAlt (String -> XmlRegex
mkZero String
"")
mkSeq :: XmlRegex -> XmlRegex -> XmlRegex
mkSeq :: XmlRegex -> XmlRegex -> XmlRegex
mkSeq e1 :: XmlRegex
e1@(Zero String
_) XmlRegex
_e2 = XmlRegex
e1
mkSeq XmlRegex
_e1 e2 :: XmlRegex
e2@(Zero String
_) = XmlRegex
e2
mkSeq XmlRegex
Unit XmlRegex
e2 = XmlRegex
e2
mkSeq XmlRegex
e1 XmlRegex
Unit = XmlRegex
e1
mkSeq (Seq XmlRegex
e1 XmlRegex
e2) XmlRegex
e3 = XmlRegex -> XmlRegex -> XmlRegex
mkSeq XmlRegex
e1 (XmlRegex -> XmlRegex -> XmlRegex
mkSeq XmlRegex
e2 XmlRegex
e3)
mkSeq XmlRegex
e1 XmlRegex
e2 = XmlRegex -> XmlRegex -> XmlRegex
Seq XmlRegex
e1 XmlRegex
e2
mkSeqs :: [XmlRegex] -> XmlRegex
mkSeqs :: [XmlRegex] -> XmlRegex
mkSeqs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XmlRegex -> XmlRegex -> XmlRegex
mkSeq XmlRegex
mkUnit
mkRep :: Int -> XmlRegex -> XmlRegex
mkRep :: Int -> XmlRegex -> XmlRegex
mkRep Int
0 XmlRegex
e = XmlRegex -> XmlRegex
mkStar XmlRegex
e
mkRep Int
_ e :: XmlRegex
e@(Zero String
_) = XmlRegex
e
mkRep Int
_ e :: XmlRegex
e@XmlRegex
Unit = XmlRegex
e
mkRep Int
i XmlRegex
e = Int -> XmlRegex -> XmlRegex
Rep Int
i XmlRegex
e
mkRng :: Int -> Int -> XmlRegex -> XmlRegex
mkRng :: Int -> Int -> XmlRegex -> XmlRegex
mkRng Int
0 Int
0 XmlRegex
_e = XmlRegex
mkUnit
mkRng Int
1 Int
1 XmlRegex
e = XmlRegex
e
mkRng Int
lb Int
ub XmlRegex
_e
| Int
lb forall a. Ord a => a -> a -> Bool
> Int
ub = String -> XmlRegex
Zero forall a b. (a -> b) -> a -> b
$
String
"illegal range " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
lb forall a. [a] -> [a] -> [a]
++ String
".." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ub
mkRng Int
_l Int
_u e :: XmlRegex
e@(Zero String
_) = XmlRegex
e
mkRng Int
_l Int
_u e :: XmlRegex
e@XmlRegex
Unit = XmlRegex
e
mkRng Int
lb Int
ub XmlRegex
e = Int -> Int -> XmlRegex -> XmlRegex
Rng Int
lb Int
ub XmlRegex
e
mkOpt :: XmlRegex -> XmlRegex
mkOpt :: XmlRegex -> XmlRegex
mkOpt = Int -> Int -> XmlRegex -> XmlRegex
mkRng Int
0 Int
1
mkPerm :: XmlRegex -> XmlRegex -> XmlRegex
mkPerm :: XmlRegex -> XmlRegex -> XmlRegex
mkPerm e1 :: XmlRegex
e1@(Zero String
_) XmlRegex
_ = XmlRegex
e1
mkPerm XmlRegex
_ e2 :: XmlRegex
e2@(Zero String
_) = XmlRegex
e2
mkPerm XmlRegex
Unit XmlRegex
e2 = XmlRegex
e2
mkPerm XmlRegex
e1 XmlRegex
Unit = XmlRegex
e1
mkPerm XmlRegex
e1 XmlRegex
e2 = XmlRegex -> XmlRegex -> XmlRegex
Perm XmlRegex
e1 XmlRegex
e2
mkPerms :: [XmlRegex] -> XmlRegex
mkPerms :: [XmlRegex] -> XmlRegex
mkPerms = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XmlRegex -> XmlRegex -> XmlRegex
mkPerm XmlRegex
mkUnit
mkMerge :: XmlRegex -> XmlRegex -> XmlRegex
mkMerge :: XmlRegex -> XmlRegex -> XmlRegex
mkMerge e1 :: XmlRegex
e1@(Zero String
_) XmlRegex
_ = XmlRegex
e1
mkMerge XmlRegex
_ e2 :: XmlRegex
e2@(Zero String
_) = XmlRegex
e2
mkMerge XmlRegex
Unit XmlRegex
e2 = XmlRegex
e2
mkMerge XmlRegex
e1 XmlRegex
Unit = XmlRegex
e1
mkMerge XmlRegex
e1 XmlRegex
e2 = XmlRegex -> XmlRegex -> XmlRegex
Merge XmlRegex
e1 XmlRegex
e2
instance Show XmlRegex where
show :: XmlRegex -> String
show (Zero String
s) = String
"{err:" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"}"
show XmlRegex
Unit = String
"()"
show (Sym XmlTree -> Bool
_p String
"") = String
"<pred>"
show (Sym XmlTree -> Bool
_p String
r ) = String
r
show XmlRegex
Dot = String
"."
show (Star XmlRegex
e) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e forall a. [a] -> [a] -> [a]
++ String
")*"
show (Alt XmlRegex
e1 XmlRegex
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e1 forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e2 forall a. [a] -> [a] -> [a]
++ String
")"
show (Seq XmlRegex
e1 XmlRegex
e2) = forall a. Show a => a -> String
show XmlRegex
e1 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e2
show (Rep Int
1 XmlRegex
e) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e forall a. [a] -> [a] -> [a]
++ String
")+"
show (Rep Int
i XmlRegex
e) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e forall a. [a] -> [a] -> [a]
++ String
"){" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
",}"
show (Rng Int
0 Int
1 XmlRegex
e) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e forall a. [a] -> [a] -> [a]
++ String
")?"
show (Rng Int
i Int
j XmlRegex
e) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e forall a. [a] -> [a] -> [a]
++ String
"){" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
j forall a. [a] -> [a] -> [a]
++ String
"}"
show (Perm XmlRegex
e1 XmlRegex
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e1 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e2 forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e2 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e1 forall a. [a] -> [a] -> [a]
++ String
")"
show (Merge XmlRegex
e1 XmlRegex
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e1 forall a. [a] -> [a] -> [a]
++ String
"&" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e2 forall a. [a] -> [a] -> [a]
++ String
")"
unexpected :: XmlTree -> String -> String
unexpected :: XmlTree -> String -> String
unexpected XmlTree
t String
e = String -> String
emsg String
e forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
cut Int
80 forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> String
xshow) [XmlTree
t]
where
emsg :: String -> String
emsg String
"" = String
"unexpected: "
emsg String
s = String
"expected: " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
", but got: "
cut :: Int -> String -> String
cut Int
n String
s
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = String
s'
| Bool
otherwise = String
s' forall a. [a] -> [a] -> [a]
++ String
"..."
where
(String
s', String
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s
nullable :: XmlRegex -> Bool
nullable :: XmlRegex -> Bool
nullable (Zero String
_) = Bool
False
nullable XmlRegex
Unit = Bool
True
nullable (Sym XmlTree -> Bool
_p String
_) = Bool
False
nullable XmlRegex
Dot = Bool
False
nullable (Star XmlRegex
_) = Bool
True
nullable (Alt XmlRegex
e1 XmlRegex
e2) = XmlRegex -> Bool
nullable XmlRegex
e1 Bool -> Bool -> Bool
||
XmlRegex -> Bool
nullable XmlRegex
e2
nullable (Seq XmlRegex
e1 XmlRegex
e2) = XmlRegex -> Bool
nullable XmlRegex
e1 Bool -> Bool -> Bool
&&
XmlRegex -> Bool
nullable XmlRegex
e2
nullable (Rep Int
_i XmlRegex
e) = XmlRegex -> Bool
nullable XmlRegex
e
nullable (Rng Int
i Int
_ XmlRegex
e) = Int
i forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
||
XmlRegex -> Bool
nullable XmlRegex
e
nullable (Perm XmlRegex
e1 XmlRegex
e2) = XmlRegex -> Bool
nullable XmlRegex
e1 Bool -> Bool -> Bool
&&
XmlRegex -> Bool
nullable XmlRegex
e2
nullable (Merge XmlRegex
e1 XmlRegex
e2) = XmlRegex -> Bool
nullable XmlRegex
e1 Bool -> Bool -> Bool
&&
XmlRegex -> Bool
nullable XmlRegex
e2
delta :: XmlRegex -> XmlTree -> XmlRegex
delta :: XmlRegex -> XmlTree -> XmlRegex
delta e :: XmlRegex
e@(Zero String
_) XmlTree
_ = XmlRegex
e
delta XmlRegex
Unit XmlTree
c = String -> XmlRegex
mkZero forall a b. (a -> b) -> a -> b
$ XmlTree -> String -> String
unexpected XmlTree
c String
""
delta (Sym XmlTree -> Bool
p String
e) XmlTree
c
| XmlTree -> Bool
p XmlTree
c = XmlRegex
mkUnit
| Bool
otherwise = String -> XmlRegex
mkZero forall a b. (a -> b) -> a -> b
$ XmlTree -> String -> String
unexpected XmlTree
c String
e
delta XmlRegex
Dot XmlTree
_ = XmlRegex
mkUnit
delta e :: XmlRegex
e@(Star XmlRegex
e1) XmlTree
c = XmlRegex -> XmlRegex -> XmlRegex
mkSeq (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c) XmlRegex
e
delta (Alt XmlRegex
e1 XmlRegex
e2) XmlTree
c = XmlRegex -> XmlRegex -> XmlRegex
mkAlt (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c) (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e2 XmlTree
c)
delta (Seq XmlRegex
e1 XmlRegex
e2) XmlTree
c
| XmlRegex -> Bool
nullable XmlRegex
e1 = XmlRegex -> XmlRegex -> XmlRegex
mkAlt (XmlRegex -> XmlRegex -> XmlRegex
mkSeq (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c) XmlRegex
e2) (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e2 XmlTree
c)
| Bool
otherwise = XmlRegex -> XmlRegex -> XmlRegex
mkSeq (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c) XmlRegex
e2
delta (Rep Int
i XmlRegex
e) XmlTree
c = XmlRegex -> XmlRegex -> XmlRegex
mkSeq (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e XmlTree
c) (Int -> XmlRegex -> XmlRegex
mkRep (Int
iforall a. Num a => a -> a -> a
-Int
1) XmlRegex
e)
delta (Rng Int
i Int
j XmlRegex
e) XmlTree
c = XmlRegex -> XmlRegex -> XmlRegex
mkSeq (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e XmlTree
c) (Int -> Int -> XmlRegex -> XmlRegex
mkRng ((Int
iforall a. Num a => a -> a -> a
-Int
1) forall a. Ord a => a -> a -> a
`max` Int
0) (Int
jforall a. Num a => a -> a -> a
-Int
1) XmlRegex
e)
delta (Perm XmlRegex
e1 XmlRegex
e2) XmlTree
c = case XmlRegex
e1' of
(Zero String
_) -> XmlRegex -> XmlRegex -> XmlRegex
mkPerm XmlRegex
e1 (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e2 XmlTree
c)
XmlRegex
_ -> XmlRegex -> XmlRegex -> XmlRegex
mkPerm XmlRegex
e1' XmlRegex
e2
where
e1' :: XmlRegex
e1' = XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c
delta (Merge XmlRegex
e1 XmlRegex
e2) XmlTree
c = XmlRegex -> XmlRegex -> XmlRegex
mkAlt (XmlRegex -> XmlRegex -> XmlRegex
mkMerge (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e1 XmlTree
c) XmlRegex
e2)
(XmlRegex -> XmlRegex -> XmlRegex
mkMerge XmlRegex
e1 (XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
e2 XmlTree
c))
delta' :: XmlRegex -> XmlTrees -> XmlRegex
delta' :: XmlRegex -> XmlTrees -> XmlRegex
delta' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl XmlRegex -> XmlTree -> XmlRegex
delta
matchXmlRegex :: XmlRegex -> XmlTrees -> Maybe String
matchXmlRegex :: XmlRegex -> XmlTrees -> Maybe String
matchXmlRegex XmlRegex
e
= XmlRegex -> Maybe String
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlRegex -> XmlTrees -> XmlRegex
delta' XmlRegex
e
where
res :: XmlRegex -> Maybe String
res (Zero String
er) = forall a. a -> Maybe a
Just String
er
res XmlRegex
re
| XmlRegex -> Bool
nullable XmlRegex
re = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"input does not match " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show XmlRegex
e
splitXmlRegex :: XmlRegex -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex :: XmlRegex -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex XmlRegex
re = XmlRegex -> XmlTrees -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex' XmlRegex
re []
splitXmlRegex' :: XmlRegex -> XmlTrees -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex' :: XmlRegex -> XmlTrees -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex' XmlRegex
re XmlTrees
res []
| XmlRegex -> Bool
nullable XmlRegex
re = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse XmlTrees
res, [])
| Bool
otherwise = forall a. Maybe a
Nothing
splitXmlRegex' (Zero String
_) XmlTrees
_ XmlTrees
_
= forall a. Maybe a
Nothing
splitXmlRegex' XmlRegex
re XmlTrees
res xs :: XmlTrees
xs@(XmlTree
x:XmlTrees
xs')
| forall a. Maybe a -> Bool
isJust Maybe (XmlTrees, XmlTrees)
res' = Maybe (XmlTrees, XmlTrees)
res'
| XmlRegex -> Bool
nullable XmlRegex
re = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse XmlTrees
res, XmlTrees
xs)
| Bool
otherwise = forall a. Maybe a
Nothing
where
re' :: XmlRegex
re' = XmlRegex -> XmlTree -> XmlRegex
delta XmlRegex
re XmlTree
x
res' :: Maybe (XmlTrees, XmlTrees)
res' = XmlRegex -> XmlTrees -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex' XmlRegex
re' (XmlTree
xforall a. a -> [a] -> [a]
:XmlTrees
res) XmlTrees
xs'
scanXmlRegex :: XmlRegex -> XmlTrees -> Maybe [XmlTrees]
scanXmlRegex :: XmlRegex -> XmlTrees -> Maybe [XmlTrees]
scanXmlRegex XmlRegex
re XmlTrees
ts = XmlRegex -> Maybe (XmlTrees, XmlTrees) -> Maybe [XmlTrees]
scanXmlRegex' XmlRegex
re (XmlRegex -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex XmlRegex
re XmlTrees
ts)
scanXmlRegex' :: XmlRegex -> Maybe (XmlTrees, XmlTrees) -> Maybe [XmlTrees]
scanXmlRegex' :: XmlRegex -> Maybe (XmlTrees, XmlTrees) -> Maybe [XmlTrees]
scanXmlRegex' XmlRegex
_ Maybe (XmlTrees, XmlTrees)
Nothing = forall a. Maybe a
Nothing
scanXmlRegex' XmlRegex
_ (Just (XmlTrees
rs, [])) = forall a. a -> Maybe a
Just [XmlTrees
rs]
scanXmlRegex' XmlRegex
_ (Just ([], XmlTrees
_)) = forall a. Maybe a
Nothing
scanXmlRegex' XmlRegex
re (Just (XmlTrees
rs, XmlTrees
rest))
| forall a. Maybe a -> Bool
isNothing Maybe [XmlTrees]
res = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (XmlTrees
rs forall a. a -> [a] -> [a]
: forall a. HasCallStack => Maybe a -> a
fromJust Maybe [XmlTrees]
res)
where
res :: Maybe [XmlTrees]
res = XmlRegex -> Maybe (XmlTrees, XmlTrees) -> Maybe [XmlTrees]
scanXmlRegex' XmlRegex
re (XmlRegex -> XmlTrees -> Maybe (XmlTrees, XmlTrees)
splitXmlRegex XmlRegex
re XmlTrees
rest)