{-# LANGUAGE CPP               #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE FlexibleInstances #-}


-- ------------------------------------------------------------

{- |
   Copyright  : Copyright (C) 2014 - Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt <uwe@fh-wedel.de>
   Stability  : stable
   Portability: portable

   W3C XML Schema Regular Expression Matcher

   Grammar can be found under <http://www.w3.org/TR/xmlschema11-2/#regexs>

-}

-- ------------------------------------------------------------

module Text.Regex.XMLSchema.Generic.Regex
    ( GenRegex

    , mkZero
    , mkZero'
    , mkUnit
    , mkSym
    , mkSym1
    , mkSymRng
    , mkWord
    , mkDot
    , mkStar
    , mkAll
    , mkAlt
    , mkElse
    , mkSeq
    , mkSeqs
    , mkRep
    , mkRng
    , mkOpt
    , mkDiff
    , mkIsect
    , mkExor
    , mkInterleave
    , mkCompl
    , mkBr
    , mkBr'

    , isZero
    , errRegex

    , nullable
    , nullable'

    , delta1
    , delta

    , firstChars

    , matchWithRegex
    , matchWithRegex'
    , splitWithRegex
    , splitWithRegex'
    , splitWithRegexCS
    , splitWithRegexCS'
    )
where

import Data.List        (intercalate)
import Data.Set.CharSet
import Data.String      (IsString(..))

#if MIN_VERSION_base(4,13,0)
#else
import           Data.Monoid         ((<>))
#endif


import Text.Regex.XMLSchema.Generic.StringLike

{-
import Debug.Trace      (traceShow)

trc :: Show a => String -> a -> a
trc msg x = traceShow (msg, x) x

-- -}
-- ------------------------------------------------------------

data GenRegex s
  = Zero s
  | Unit
  | Sym  CharSet
  | Dot
  | Star (GenRegex s)
  | Alt  (GenRegex s)        (GenRegex s)
  | Else (GenRegex s)        (GenRegex s)
  | Seq  (GenRegex s)        (GenRegex s)
  | Rep  Int                 (GenRegex s)           -- 1 or more repetitions
  | Rng  Int Int             (GenRegex s)           -- n..m repetitions
  | Diff (GenRegex s)        (GenRegex s)           -- r1 - r2
  | Isec (GenRegex s)        (GenRegex s)           -- r1 n r2
  | Exor (GenRegex s)        (GenRegex s)           -- r1 xor r2
  | Intl (GenRegex s)        (GenRegex s)           -- r1 interleavedWith r2
  | Br   (Label    s)        (GenRegex s)           -- (...) not yet parsed
  | Obr  (Label    s) s !Int (GenRegex s)           -- currently parsed (...)
  | Cbr [(Label s, s)]       (GenRegex s)           -- already completely parsed (...)
  deriving (GenRegex s -> GenRegex s -> Bool
(GenRegex s -> GenRegex s -> Bool)
-> (GenRegex s -> GenRegex s -> Bool) -> Eq (GenRegex s)
forall s. Eq s => GenRegex s -> GenRegex s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => GenRegex s -> GenRegex s -> Bool
== :: GenRegex s -> GenRegex s -> Bool
$c/= :: forall s. Eq s => GenRegex s -> GenRegex s -> Bool
/= :: GenRegex s -> GenRegex s -> Bool
Eq, Eq (GenRegex s)
Eq (GenRegex s) =>
(GenRegex s -> GenRegex s -> Ordering)
-> (GenRegex s -> GenRegex s -> Bool)
-> (GenRegex s -> GenRegex s -> Bool)
-> (GenRegex s -> GenRegex s -> Bool)
-> (GenRegex s -> GenRegex s -> Bool)
-> (GenRegex s -> GenRegex s -> GenRegex s)
-> (GenRegex s -> GenRegex s -> GenRegex s)
-> Ord (GenRegex s)
GenRegex s -> GenRegex s -> Bool
GenRegex s -> GenRegex s -> Ordering
GenRegex s -> GenRegex s -> GenRegex s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. Ord s => Eq (GenRegex s)
forall s. Ord s => GenRegex s -> GenRegex s -> Bool
forall s. Ord s => GenRegex s -> GenRegex s -> Ordering
forall s. Ord s => GenRegex s -> GenRegex s -> GenRegex s
$ccompare :: forall s. Ord s => GenRegex s -> GenRegex s -> Ordering
compare :: GenRegex s -> GenRegex s -> Ordering
$c< :: forall s. Ord s => GenRegex s -> GenRegex s -> Bool
< :: GenRegex s -> GenRegex s -> Bool
$c<= :: forall s. Ord s => GenRegex s -> GenRegex s -> Bool
<= :: GenRegex s -> GenRegex s -> Bool
$c> :: forall s. Ord s => GenRegex s -> GenRegex s -> Bool
> :: GenRegex s -> GenRegex s -> Bool
$c>= :: forall s. Ord s => GenRegex s -> GenRegex s -> Bool
>= :: GenRegex s -> GenRegex s -> Bool
$cmax :: forall s. Ord s => GenRegex s -> GenRegex s -> GenRegex s
max :: GenRegex s -> GenRegex s -> GenRegex s
$cmin :: forall s. Ord s => GenRegex s -> GenRegex s -> GenRegex s
min :: GenRegex s -> GenRegex s -> GenRegex s
Ord {-, Show -})

type Label s
  = Maybe s                           -- we need one special label for the whole expression
                                      -- see splitWithRegex
type SubexResults s
  = [(Label s, s)]

type Nullable s
  = (Bool, SubexResults s)

-- ------------------------------------------------------------

{- just for documentation

class Inv a where
    inv         :: a -> Bool

instance Inv (GenRegex s) where
    inv (Zero _)        = True
    inv Unit            = True
    inv (Sym p)         = not (nulCS p) && not (fullCS p)
    inv Dot             = True
    inv (Star e)        = inv e
    inv (Alt e1 e2)     = inv e1 &&
                          inv e2
    inv (Seq e1 e2)     = inv e1 &&
                          inv e2
    inv (Rep i e)       = i > 0 && inv e
    inv (Rng i j e)     = (i < j || (i == j && i > 1)) &&
                          inv e
    inv (Diff e1 e2)    = inv e1 &&
                          inv e2
    inv (Isec e1 e2)    = inv e1 &&
                          inv e2
    inv (Exor e1 e2)    = inv e1 &&
                          inv e2
-}

-- ------------------------------------------------------------
--
-- smart constructors

-- | construct the r.e. for the empty set.
-- An (error-) message may be attached

mkZero                                  :: s -> GenRegex s
mkZero :: forall s. s -> GenRegex s
mkZero                                  = s -> GenRegex s
forall s. s -> GenRegex s
Zero
{-# INLINE mkZero #-}

mkZero'                                 :: (StringLike s) =>
                                           String -> GenRegex s
mkZero' :: forall s. StringLike s => String -> GenRegex s
mkZero'                                 = s -> GenRegex s
forall s. s -> GenRegex s
Zero (s -> GenRegex s) -> (String -> s) -> String -> GenRegex s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString
{-# INLINE mkZero' #-}

-- | construct the r.e. for the set containing the empty word

mkUnit                                  :: GenRegex s
mkUnit :: forall s. GenRegex s
mkUnit                                  = GenRegex s
forall s. GenRegex s
Unit
{-# INLINE mkUnit #-}

-- | construct the r.e. for a set of chars

mkSym                                   :: (StringLike s) =>
                                           CharSet -> GenRegex s
mkSym :: forall s. StringLike s => CharSet -> GenRegex s
mkSym CharSet
s
    | CharSet -> Bool
nullCS CharSet
s                          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty char range"
    | CharSet -> Bool
fullCS CharSet
s                          = GenRegex s
forall s. GenRegex s
mkDot
    | Bool
otherwise                         = CharSet -> GenRegex s
forall s. CharSet -> GenRegex s
Sym CharSet
s
{-# INLINE mkSym #-}

-- | construct an r.e. for a single char set
mkSym1                                  :: (StringLike s) =>
                                           Char -> GenRegex s
mkSym1 :: forall s. StringLike s => Char -> GenRegex s
mkSym1                                  = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> (Char -> CharSet) -> Char -> GenRegex s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharSet
singleCS
{-# INLINE mkSym1 #-}

-- | construct an r.e. for an intervall of chars
mkSymRng                                :: (StringLike s) =>
                                           Char -> Char -> GenRegex s
mkSymRng :: forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng Char
c1 Char
c2                          = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharSet
rangeCS Char
c1 Char
c2
{-# INLINE mkSymRng #-}

-- | mkSym generaized for strings
mkWord                                  :: (StringLike s) =>
                                           [Char] -> GenRegex s
mkWord :: forall s. StringLike s => String -> GenRegex s
mkWord                                  = [GenRegex s] -> GenRegex s
forall s. [GenRegex s] -> GenRegex s
mkSeqs ([GenRegex s] -> GenRegex s)
-> (String -> [GenRegex s]) -> String -> GenRegex s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> GenRegex s) -> String -> [GenRegex s]
forall a b. (a -> b) -> [a] -> [b]
map Char -> GenRegex s
forall s. StringLike s => Char -> GenRegex s
mkSym1

-- | construct an r.e. for the set of all Unicode chars
mkDot                                   :: GenRegex s
mkDot :: forall s. GenRegex s
mkDot                                   = GenRegex s
forall s. GenRegex s
Dot
{-# INLINE mkDot #-}

-- | construct an r.e. for the set of all Unicode words

mkAll                                   :: (StringLike s) =>
                                           GenRegex s
mkAll :: forall s. StringLike s => GenRegex s
mkAll                                   = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
forall s. GenRegex s
mkDot
{-# INLINE mkAll #-}


-- | construct r.e. for r*
mkStar                                  :: (StringLike s) =>
                                           GenRegex s -> GenRegex s
mkStar :: forall s. StringLike s => GenRegex s -> GenRegex s
mkStar (Zero s
_)                         = GenRegex s
forall s. GenRegex s
mkUnit                -- {}* == ()
mkStar e :: GenRegex s
e@GenRegex s
Unit                           = GenRegex s
e                     -- ()* == ()
mkStar e :: GenRegex s
e@(Star GenRegex s
_e1)                     = GenRegex s
e                     -- (r*)* == r*
mkStar (Rep Int
1 GenRegex s
e1)                       = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e1             -- (r+)* == r*
mkStar (Rep Int
i GenRegex s
e1)
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      Bool -> Bool -> Bool
||
      GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e1                       = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e1             -- (r{i,})* == r*    when i == 1 or nullable r
mkStar e :: GenRegex s
e@(Rng Int
_ Int
_ GenRegex s
e1)
    | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e                        = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e1             -- (r{i,j})* == r*   when i == 0 or nullable r
mkStar e :: GenRegex s
e@(Alt GenRegex s
_ GenRegex s
_)                      = GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s
Star (GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e)       -- (a*|b)* == (a|b)*

                                                                {- this is wrong, not generally applicable
mkStar (Br l r s)                       = mkBr0 l (mkStar r) s  -- ({l}r)* == ({l}r*) because we want the longest match as result for the subexpression
                                                                -}
mkStar GenRegex s
e                                = GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s
Star GenRegex s
e

rmStar                                  :: (StringLike s) =>
                                           GenRegex s -> GenRegex s
rmStar :: forall s. StringLike s => GenRegex s -> GenRegex s
rmStar (Alt GenRegex s
e1 GenRegex s
e2)                      = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e1) (GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e2)
rmStar (Star GenRegex s
e1)                        = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e1
rmStar (Rep Int
1 GenRegex s
e1)                       = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e1
rmStar GenRegex s
e1                               = GenRegex s
e1

-- | construct the r.e for r1|r2

mkAlt                                   :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkAlt :: forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt GenRegex s
e1            (Zero s
_)            = GenRegex s
e1                            -- e1 u {} = e1
mkAlt (Zero s
_)      GenRegex s
e2                  = GenRegex s
e2                            -- {} u e2 = e2
mkAlt (Sym CharSet
p1)      (Sym CharSet
p2)            = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet
p1 CharSet -> CharSet -> CharSet
`unionCS` CharSet
p2       -- melting of predicates
mkAlt GenRegex s
e1            e2 :: GenRegex s
e2@(Sym CharSet
_)          = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt GenRegex s
e2 GenRegex s
e1                   -- symmetry: predicates always first
mkAlt e1 :: GenRegex s
e1@(Sym CharSet
_)    (Alt e2 :: GenRegex s
e2@(Sym CharSet
_) GenRegex s
e3) = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt GenRegex s
e1 GenRegex s
e2) GenRegex s
e3        -- prepare melting of predicates
mkAlt (Sym CharSet
_)       e2 :: GenRegex s
e2@GenRegex s
Dot              = GenRegex s
e2                            -- c|.     = .    for a c's
mkAlt e1 :: GenRegex s
e1@(Star GenRegex s
Dot) GenRegex s
_e2                 = GenRegex s
e1                            -- A* u e1 = A*
mkAlt GenRegex s
_e1           e2 :: GenRegex s
e2@(Star GenRegex s
Dot)       = GenRegex s
e2                            -- e1 u A* = A*
mkAlt (Alt GenRegex s
e1 GenRegex s
e2)   GenRegex s
e3                  = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt GenRegex s
e1 (GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt GenRegex s
e2 GenRegex s
e3)        -- associativity
mkAlt GenRegex s
e1 GenRegex s
e2
    | GenRegex s
e1 GenRegex s -> GenRegex s -> Bool
forall a. Eq a => a -> a -> Bool
== GenRegex s
e2                          = GenRegex s
e1
    | Bool
otherwise                         = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Alt GenRegex s
e1 GenRegex s
e2

-- | construct the r.e. for r1{|}r2 (r1 orElse r2).
--
-- This represents the same r.e. as r1|r2, but when
-- collecting the results of subexpressions in (...) and r1 succeeds, the
-- subexpressions of r2 are discarded, so r1 matches are prioritized
--
-- example
--
-- > splitSubex "({1}x)|({2}.)"   "x" = ([("1","x"),("2","x")], "")
-- >
-- > splitSubex "({1}x){|}({2}.)" "x" = ([("1","x")], "")

mkElse                                  :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkElse :: forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse GenRegex s
e1            (Zero s
_)           = GenRegex s
e1                            -- e1 u {} = e1
mkElse (Zero s
_)      GenRegex s
e2                 = GenRegex s
e2                            -- {} u e2 = e2
mkElse (Sym CharSet
p1)      (Sym CharSet
p2)           = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet
p1 CharSet -> CharSet -> CharSet
`unionCS` CharSet
p2       -- melting of predicates
                                                                        -- no symmetry allowed
mkElse e1 :: GenRegex s
e1@(Sym CharSet
_)  (Else e2 :: GenRegex s
e2@(Sym CharSet
_) GenRegex s
e3) = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse (GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse GenRegex s
e1 GenRegex s
e2) GenRegex s
e3      -- prepare melting of predicates
mkElse (Sym CharSet
_)      e2 :: GenRegex s
e2@GenRegex s
Dot              = GenRegex s
e2                            -- c|.     = .    for a c's
mkElse e1 :: GenRegex s
e1@(Star GenRegex s
Dot) GenRegex s
_e2                = GenRegex s
e1                            -- A* u e1 = A*
mkElse GenRegex s
_e1           e2 :: GenRegex s
e2@(Star GenRegex s
Dot)      = GenRegex s
e2                            -- e1 u A* = A*
mkElse (Else GenRegex s
e1 GenRegex s
e2)   GenRegex s
e3                = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse GenRegex s
e1 (GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse GenRegex s
e2 GenRegex s
e3)      -- associativity
mkElse GenRegex s
e1 GenRegex s
e2
    | GenRegex s
e1 GenRegex s -> GenRegex s -> Bool
forall a. Eq a => a -> a -> Bool
== GenRegex s
e2                          = GenRegex s
e1
    | Bool
otherwise                         = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Else GenRegex s
e1 GenRegex s
e2

-- | Construct the sequence r.e. r1.r2

mkSeq                                   :: GenRegex s -> GenRegex s -> GenRegex s
mkSeq :: forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq e1 :: GenRegex s
e1@(Zero s
_) GenRegex s
_e2                   = GenRegex s
e1
mkSeq GenRegex s
_e1         e2 :: GenRegex s
e2@(Zero s
_)           = GenRegex s
e2
mkSeq GenRegex s
Unit        GenRegex s
e2                    = GenRegex s
e2
mkSeq (Cbr [(Label s, s)]
ss1 GenRegex s
e1) GenRegex s
e2                   = [(Label s, s)] -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr [(Label s, s)]
ss1 (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq GenRegex s
e1 GenRegex s
e2)               -- move finished submatches upwards
mkSeq GenRegex s
e1          GenRegex s
Unit                  = GenRegex s
e1
mkSeq (Seq GenRegex s
e1 GenRegex s
e2) GenRegex s
e3                    = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq GenRegex s
e1 (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq GenRegex s
e2 GenRegex s
e3)
mkSeq GenRegex s
e1 GenRegex s
e2                             = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Seq GenRegex s
e1 GenRegex s
e2

-- | mkSeq extened to lists
mkSeqs                                  :: [GenRegex s] -> GenRegex s
mkSeqs :: forall s. [GenRegex s] -> GenRegex s
mkSeqs                                  = (GenRegex s -> GenRegex s -> GenRegex s)
-> GenRegex s -> [GenRegex s] -> GenRegex s
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq GenRegex s
forall s. GenRegex s
mkUnit

-- | Construct repetition r{i,}
mkRep                                   :: (StringLike s) =>
                                           Int -> GenRegex s -> GenRegex s
mkRep :: forall s. StringLike s => Int -> GenRegex s -> GenRegex s
mkRep Int
0 GenRegex s
e                               = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e
mkRep Int
_ e :: GenRegex s
e@(Zero s
_)                      = GenRegex s
e
mkRep Int
_ GenRegex s
e
    | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e                        = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e
mkRep Int
i (Rep Int
j GenRegex s
e)                       = Int -> GenRegex s -> GenRegex s
forall s. StringLike s => Int -> GenRegex s -> GenRegex s
mkRep (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j) GenRegex s
e
mkRep Int
i GenRegex s
e                               = Int -> GenRegex s -> GenRegex s
forall s. Int -> GenRegex s -> GenRegex s
Rep Int
i GenRegex s
e

-- | Construct range r{i,j}
mkRng                                   :: (StringLike s) =>
                                           Int -> Int -> GenRegex s -> GenRegex s
mkRng :: forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng Int
0  Int
0  GenRegex s
_e                          = GenRegex s
forall s. GenRegex s
mkUnit
mkRng Int
1  Int
1  GenRegex s
e                           = GenRegex s
e
mkRng Int
lb Int
ub GenRegex s
_e
    | Int
lb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ub                           = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' (String -> GenRegex s) -> String -> GenRegex s
forall a b. (a -> b) -> a -> b
$
                                          String
"illegal range " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          Int -> String
forall a. Show a => a -> String
show Int
lb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ub
mkRng Int
_l Int
_u e :: GenRegex s
e@(Zero s
_)                  = GenRegex s
e
mkRng Int
_l Int
_u e :: GenRegex s
e@GenRegex s
Unit                      = GenRegex s
e
mkRng Int
lb Int
ub GenRegex s
e                           = Int -> Int -> GenRegex s -> GenRegex s
forall s. Int -> Int -> GenRegex s -> GenRegex s
Rng Int
lb Int
ub GenRegex s
e

-- | Construct option r?
mkOpt                                   :: (StringLike s) =>
                                           GenRegex s -> GenRegex s
mkOpt :: forall s. StringLike s => GenRegex s -> GenRegex s
mkOpt                                   = Int -> Int -> GenRegex s -> GenRegex s
forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng Int
0 Int
1
{-# INLINE mkOpt #-}

-- | Construct difference r.e.: r1 {\\} r2
--
-- example
--
-- > match "[a-z]+{\\}bush" "obama"     = True
-- > match "[a-z]+{\\}bush" "clinton"   = True
-- > match "[a-z]+{\\}bush" "bush"      = False     -- not important any more

mkDiff                                  :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkDiff :: forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff e1 :: GenRegex s
e1@(Zero s
_) GenRegex s
_e2                  = GenRegex s
e1                                    -- {} - r2 = {}
mkDiff GenRegex s
e1          (Zero s
_)             = GenRegex s
e1                                    -- r1 - {} = r1
mkDiff GenRegex s
_e1         (Star GenRegex s
Dot)           = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in difference expr" -- r1 - .* = {}
mkDiff GenRegex s
Dot         (Sym CharSet
p)              = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet -> CharSet
compCS CharSet
p                      -- . - s  = ~s
mkDiff (Sym CharSet
_)     GenRegex s
Dot                  = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in difference expr" -- x - .  = {}
mkDiff (Sym CharSet
p1)    (Sym CharSet
p2)             = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet
p1 CharSet -> CharSet -> CharSet
`diffCS` CharSet
p2                -- set diff
mkDiff GenRegex s
e1          GenRegex s
e2
    | GenRegex s
e1 GenRegex s -> GenRegex s -> Bool
forall a. Eq a => a -> a -> Bool
== GenRegex s
e2                          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in difference expr" -- r1 - r1 = {}
    | Bool
otherwise                         = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Diff GenRegex s
e1 GenRegex s
e2

-- | Construct the Complement of an r.e.: whole set of words - r

mkCompl                                 :: (StringLike s) =>
                                           GenRegex s -> GenRegex s
mkCompl :: forall s. StringLike s => GenRegex s -> GenRegex s
mkCompl (Zero s
_)                        = GenRegex s
forall s. StringLike s => GenRegex s
mkAll
mkCompl (Star GenRegex s
Dot)                      = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in compl expr"
mkCompl GenRegex s
e                               = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff (GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
forall s. GenRegex s
mkDot) GenRegex s
e

-- | Construct r.e. for intersection: r1 {&} r2
--
-- example
--
-- > match ".*a.*{&}.*b.*" "-a-b-"  = True
-- > match ".*a.*{&}.*b.*" "-b-a-"  = True
-- > match ".*a.*{&}.*b.*" "-a-a-"  = False
-- > match ".*a.*{&}.*b.*" "---b-"  = False

mkIsect                                 :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkIsect :: forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkIsect e1 :: GenRegex s
e1@(Zero s
_) GenRegex s
_e2                 = GenRegex s
e1                                    -- {} n r2 = {}
mkIsect GenRegex s
_e1         e2 :: GenRegex s
e2@(Zero s
_)         = GenRegex s
e2                                    -- r1 n {} = {}
mkIsect e1 :: GenRegex s
e1@(GenRegex s
Unit)   GenRegex s
e2                                                  -- () n r2 = () if nullable r2
    | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e2                       = GenRegex s
e1                                    -- () n r2 = {} if not nullable r2
    | Bool
otherwise                         = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"intersection empty"
mkIsect GenRegex s
e1          e2 :: GenRegex s
e2@(GenRegex s
Unit)           = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkIsect GenRegex s
e2 GenRegex s
e1                         -- symmetric version of las 2 laws

mkIsect (Sym CharSet
p1)    (Sym CharSet
p2)            = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet
p1 CharSet -> CharSet -> CharSet
`intersectCS` CharSet
p2           -- intersect sets
mkIsect e1 :: GenRegex s
e1@(Sym CharSet
_)  GenRegex s
Dot                 = GenRegex s
e1                                    -- x n . = x
mkIsect GenRegex s
Dot         e2 :: GenRegex s
e2@(Sym CharSet
_)          = GenRegex s
e2                                    -- . n x = x

mkIsect (Star GenRegex s
Dot)  GenRegex s
e2                  = GenRegex s
e2                                    -- .* n r2 = r2
mkIsect GenRegex s
e1          (Star GenRegex s
Dot)          = GenRegex s
e1                                    -- r1 n .* = r1
mkIsect GenRegex s
e1          GenRegex s
e2
    | GenRegex s
e1 GenRegex s -> GenRegex s -> Bool
forall a. Eq a => a -> a -> Bool
== GenRegex s
e2                          = GenRegex s
e1                                    -- r1 n r1 = r1
    | Bool
otherwise                         = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Isec GenRegex s
e1 GenRegex s
e2

-- | Construct r.e. for exclusive or: r1 {^} r2
--
-- example
--
-- > match "[a-c]+{^}[c-d]+" "abc"  = True
-- > match "[a-c]+{^}[c-d]+" "acdc" = False
-- > match "[a-c]+{^}[c-d]+" "ccc"  = False
-- > match "[a-c]+{^}[c-d]+" "cdc"  = True

mkExor                                  :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkExor :: forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkExor (Zero s
_)     GenRegex s
e2                  = GenRegex s
e2
mkExor GenRegex s
e1           (Zero s
_)            = GenRegex s
e1
mkExor (Star GenRegex s
Dot)   GenRegex s
_e2                 = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in exor expr"
mkExor GenRegex s
_e1          (Star GenRegex s
Dot)          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in exor expr"
mkExor (Sym CharSet
p1)     (Sym CharSet
p2)            = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet
p1 CharSet -> CharSet -> CharSet
`exorCS` CharSet
p2
mkExor (Sym CharSet
p1)     GenRegex s
Dot                 = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet -> CharSet
compCS CharSet
p1
mkExor GenRegex s
Dot          (Sym CharSet
p2)            = CharSet -> GenRegex s
forall s. StringLike s => CharSet -> GenRegex s
mkSym (CharSet -> GenRegex s) -> CharSet -> GenRegex s
forall a b. (a -> b) -> a -> b
$ CharSet -> CharSet
compCS CharSet
p2
mkExor GenRegex s
e1           GenRegex s
e2
    | GenRegex s
e1 GenRegex s -> GenRegex s -> Bool
forall a. Eq a => a -> a -> Bool
== GenRegex s
e2                          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' String
"empty set in exor expr"       -- r1 xor r1 = {}
    | Bool
otherwise                         = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Exor GenRegex s
e1 GenRegex s
e2

mkInterleave                            :: GenRegex s -> GenRegex s -> GenRegex s
mkInterleave :: forall s. GenRegex s -> GenRegex s -> GenRegex s
mkInterleave e1 :: GenRegex s
e1@(Zero s
_) GenRegex s
_              = GenRegex s
e1
mkInterleave GenRegex s
_           e2 :: GenRegex s
e2@(Zero s
_)    = GenRegex s
e2
mkInterleave (GenRegex s
Unit)      GenRegex s
e2             = GenRegex s
e2
mkInterleave GenRegex s
e1          (GenRegex s
Unit)         = GenRegex s
e1
mkInterleave GenRegex s
e1          GenRegex s
e2             = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
Intl GenRegex s
e1 GenRegex s
e2

-- | Construct a labeled subexpression: ({label}r)

mkBr                                    :: s -> GenRegex s -> GenRegex s
mkBr :: forall s. s -> GenRegex s -> GenRegex s
mkBr s
l GenRegex s
e                                = Label s -> GenRegex s -> GenRegex s
forall s. Label s -> GenRegex s -> GenRegex s
Br (s -> Label s
forall a. a -> Maybe a
Just s
l) GenRegex s
e

mkBr'                                   :: StringLike s =>
                                           String -> GenRegex s -> GenRegex s
mkBr' :: forall s. StringLike s => String -> GenRegex s -> GenRegex s
mkBr' String
l GenRegex s
e                               = Label s -> GenRegex s -> GenRegex s
forall s. Label s -> GenRegex s -> GenRegex s
Br (s -> Label s
forall a. a -> Maybe a
Just (s -> Label s) -> s -> Label s
forall a b. (a -> b) -> a -> b
$ String -> s
forall a. IsString a => String -> a
fromString String
l) GenRegex s
e

mkBrN                                   :: GenRegex s -> GenRegex s
mkBrN :: forall s. GenRegex s -> GenRegex s
mkBrN GenRegex s
e                                 = Label s -> GenRegex s -> GenRegex s
forall s. Label s -> GenRegex s -> GenRegex s
Br Label s
forall a. Maybe a
Nothing GenRegex s
e

mkObr                                   :: StringLike s =>
                                           Label s -> s -> Int -> GenRegex s -> GenRegex s
mkObr :: forall s.
StringLike s =>
Label s -> s -> Int -> GenRegex s -> GenRegex s
mkObr Label s
_ s
_ Int
_ e :: GenRegex s
e@(Zero s
_)                  = GenRegex s
e
mkObr Label s
l s
s Int
n GenRegex s
Unit                        = SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr [(Label s
l, Int -> s -> s
forall a. StringLike a => Int -> a -> a
takeS Int
n s
s)] GenRegex s
forall s. GenRegex s
mkUnit
mkObr Label s
l s
s Int
n GenRegex s
e                           = Label s -> s -> Int -> GenRegex s -> GenRegex s
forall s. Label s -> s -> Int -> GenRegex s -> GenRegex s
Obr Label s
l s
s Int
n GenRegex s
e

mkCbr                                   :: SubexResults s -> GenRegex s -> GenRegex s
mkCbr :: forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr  SubexResults s
_  e :: GenRegex s
e@(Zero s
_)                    = GenRegex s
e                             -- dead end, throw away subexpr matches
mkCbr SubexResults s
ss (Cbr SubexResults s
ss1 GenRegex s
e)                    = SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr (SubexResults s
ss SubexResults s -> SubexResults s -> SubexResults s
forall a. Semigroup a => a -> a -> a
<> SubexResults s
ss1) GenRegex s
e           -- join inner and this subexpr match
mkCbr SubexResults s
ss  GenRegex s
e                             = SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
Cbr SubexResults s
ss GenRegex s
e

-- ------------------------------------------------------------

instance (StringLike s) => Show (GenRegex s) where
    show :: GenRegex s -> String
show (Zero s
e)               = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. StringLike a => a -> String
toString s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
    show GenRegex s
Unit                   = String
"()"
    show (Sym CharSet
p)
        | CharSet
p CharSet -> CharSet -> Bool
forall a. Eq a => a -> a -> Bool
== CharSet -> CharSet
compCS (String -> CharSet
stringCS String
"\n\r")
                                = String
"."
        | CharSet -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CharSet -> CharSet
forall a. HasCallStack => [a] -> [a]
tail CharSet
cs) Bool -> Bool -> Bool
&&
          (Char, Char) -> Bool
forall {a}. Eq a => (a, a) -> Bool
rng1 (CharSet -> (Char, Char)
forall a. HasCallStack => [a] -> a
head CharSet
cs)
                                = (Char, Char) -> String
escRng ((Char, Char) -> String)
-> (CharSet -> (Char, Char)) -> CharSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharSet -> (Char, Char)
forall a. HasCallStack => [a] -> a
head (CharSet -> String) -> CharSet -> String
forall a b. (a -> b) -> a -> b
$ CharSet
cs
        | Bool
otherwise             = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
cs' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
                                  where
                                  rng1 :: (a, a) -> Bool
rng1 (a
x,a
y)    = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
                                  cs :: CharSet
cs            = CharSet
p -- charRngs . chars $ p
                                  cs' :: [String]
cs'           = ((Char, Char) -> String) -> CharSet -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> String
escRng CharSet
p
                                  escRng :: (Char, Char) -> String
escRng (Char
x, Char
y)
                                      | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y  = Char -> String
esc Char
x
                                      | Char -> Char
forall a. Enum a => a -> a
succ Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y
                                                = Char -> String
esc Char
x        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
esc Char
y
                                      | Bool
otherwise
                                                = Char -> String
esc Char
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
esc Char
y
                                  esc :: Char -> String
esc Char
x
                                      | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\\-[]{}()*+?.^"
                                                = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
""
                                      | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' ' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'~'
                                                = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
""
                                      | Bool
otherwise
                                                = String
"&#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    show GenRegex s
Dot                    = String
"\\a"
    show (Star GenRegex s
Dot)             = String
"\\A"
    show (Star GenRegex s
e)               = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*)"
    show (Alt GenRegex s
e1 GenRegex s
e2)            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Else GenRegex s
e1 GenRegex s
e2)           = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{|}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Seq GenRegex s
e1 GenRegex s
e2)            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Rep Int
1 GenRegex s
e)              = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+)"
    show (Rep Int
i GenRegex s
e)              = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",})"
    show (Rng Int
0 Int
1 GenRegex s
e)            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?)"
    show (Rng Int
i Int
j GenRegex s
e)            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"})"
    show (Diff GenRegex s
e1 GenRegex s
e2)           = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{\\}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Isec GenRegex s
e1 GenRegex s
e2)           = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{&}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Exor GenRegex s
e1 GenRegex s
e2)           = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{^}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Intl GenRegex s
e1 GenRegex s
e2)           = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{:}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Br  Label s
l     GenRegex s
e)          = String
"({" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Label s -> String
forall s. Show s => Label s -> String
showL Label s
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Obr Label s
l s
s Int
n GenRegex s
e)          = String
"({" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Label s -> String
forall s. Show s => Label s -> String
showL Label s
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. StringLike a => a -> String
toString (Int -> s -> s
forall a. StringLike a => Int -> a -> a
takeS Int
n s
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    show (Cbr [(Label s, s)]
ss GenRegex s
e)             = String
"([" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((Label s, s) -> String) -> [(Label s, s)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Label s
l, s
s) -> Label s -> String
forall s. Show s => Label s -> String
showL Label s
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. StringLike a => a -> String
toString s
s)) [(Label s, s)]
ss) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenRegex s -> String
forall a. Show a => a -> String
show GenRegex s
e String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  String
")"

showL                           :: Show s => Label s -> String
showL :: forall s. Show s => Label s -> String
showL                           = String -> String
rmq (String -> String) -> (Label s -> String) -> Label s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (s -> String) -> Label s -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" s -> String
forall a. Show a => a -> String
show
                                  where
                                  rmq :: String -> String
rmq (Char
'\"':String
xs) = String -> String
forall a. HasCallStack => [a] -> [a]
init String
xs
                                  rmq String
xs          = String
xs

-- ------------------------------------------------------------

isZero                          :: GenRegex s -> Bool
isZero :: forall s. GenRegex s -> Bool
isZero (Zero s
_)                 = Bool
True
isZero GenRegex s
_                        = Bool
False
{-# INLINE isZero #-}

errRegex                        :: (StringLike s) =>
                                   GenRegex s -> s
errRegex :: forall s. StringLike s => GenRegex s -> s
errRegex (Zero s
e)               = s
e
errRegex GenRegex s
_                      = s
forall a. StringLike a => a
emptyS

-- ------------------------------------------------------------

nullable                        :: (StringLike s) =>
                                   GenRegex s -> Bool
nullable :: forall s. StringLike s => GenRegex s -> Bool
nullable                        = (Bool, SubexResults s) -> Bool
forall a b. (a, b) -> a
fst ((Bool, SubexResults s) -> Bool)
-> (GenRegex s -> (Bool, SubexResults s)) -> GenRegex s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable'
{-# INLINE nullable #-}

nullable'                       :: (StringLike s) =>
                                   GenRegex s -> Nullable s

nullable' :: forall s. StringLike s => GenRegex s -> Nullable s
nullable' (Zero s
_)              = (Bool
False, [])
nullable' GenRegex s
Unit                  = (Bool
True,  [])
nullable' GenRegex s
Dot                   = (Bool
False, [])
nullable' (Sym CharSet
_x)              = (Bool
False, [])

nullable' (Star GenRegex s
_e)             = (Bool
True,  [])
nullable' (Rep Int
_i GenRegex s
e)            = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e
nullable' (Rng Int
i Int
_ GenRegex s
e)           = (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, []) Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`unionN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e
nullable' (Seq GenRegex s
e1 GenRegex s
e2)           = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2

nullable' (Alt   GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`unionN`  GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2
nullable' (Else  GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`orElseN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2
nullable' (Isec  GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN`  GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2
nullable' (Diff  GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`diffN`   GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2
nullable' (Exor  GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`exorN`   GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2
nullable' (Intl  GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1 Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN`  GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e2

nullable' (Br  Label s
l GenRegex s
e)             = (Bool
True, [(Label s
l, s
forall a. StringLike a => a
emptyS   )]) Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e
nullable' (Obr Label s
l s
s Int
n GenRegex s
e)         = (Bool
True, [(Label s
l, Int -> s -> s
forall a. StringLike a => Int -> a -> a
takeS Int
n s
s)]) Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e
nullable' (Cbr [(Label s, s)]
ss GenRegex s
e)            = (Bool
True, [(Label s, s)]
ss)               Nullable s -> Nullable s -> Nullable s
forall s. Nullable s -> Nullable s -> Nullable s
`isectN` GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e

isectN                          :: Nullable s -> Nullable s -> Nullable s
isectN :: forall s. Nullable s -> Nullable s -> Nullable s
isectN (Bool
True, SubexResults s
ws1) (Bool
True, SubexResults s
ws2)  = (Bool
True, SubexResults s
ws1 SubexResults s -> SubexResults s -> SubexResults s
forall a. [a] -> [a] -> [a]
++ SubexResults s
ws2)
isectN (Bool, SubexResults s)
_           (Bool, SubexResults s)
_            = (Bool
False, [])

unionN                          :: Nullable s -> Nullable s -> Nullable s
unionN :: forall s. Nullable s -> Nullable s -> Nullable s
unionN (Bool
False, SubexResults s
_) (Bool
False, SubexResults s
_)    = (Bool
False, [])
unionN (Bool
_, SubexResults s
ws1)   (Bool
_, SubexResults s
ws2)      = (Bool
True, SubexResults s
ws1 SubexResults s -> SubexResults s -> SubexResults s
forall a. [a] -> [a] -> [a]
++ SubexResults s
ws2)

orElseN                         :: Nullable s -> Nullable s -> Nullable s
orElseN :: forall s. Nullable s -> Nullable s -> Nullable s
orElseN e1 :: Nullable s
e1@(Bool
True, SubexResults s
_ws1) Nullable s
_       = Nullable s
e1
orElseN Nullable s
_            Nullable s
e2         = Nullable s
e2

diffN                           :: Nullable s -> Nullable s -> Nullable s
diffN :: forall s. Nullable s -> Nullable s -> Nullable s
diffN Nullable s
n1          (Bool
False, SubexResults s
_)    = Nullable s
n1
diffN Nullable s
_           Nullable s
_             = (Bool
False, [])

exorN                           :: Nullable s -> Nullable s -> Nullable s
exorN :: forall s. Nullable s -> Nullable s -> Nullable s
exorN n1 :: Nullable s
n1@(Bool
True, SubexResults s
_)  (Bool
False, SubexResults s
_)  = Nullable s
n1
exorN (Bool
False, SubexResults s
_)  n2 :: Nullable s
n2@(Bool
True, SubexResults s
_)  = Nullable s
n2
exorN Nullable s
_           Nullable s
_             = (Bool
False, [])

-- ------------------------------------------------------------

-- | FIRST for regular expressions
--
-- this is only an approximation, the real set of char may be smaller,
-- when the expression contains intersection, set difference or exor operators

firstChars                      :: (StringLike s) =>
                                   GenRegex s -> CharSet

firstChars :: forall s. StringLike s => GenRegex s -> CharSet
firstChars (Zero s
_)             = CharSet
emptyCS
firstChars GenRegex s
Unit                 = CharSet
emptyCS
firstChars (Sym CharSet
p)              = CharSet
p
firstChars GenRegex s
Dot                  = CharSet
allCS

firstChars (Star GenRegex s
e1)            = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1
firstChars (Alt GenRegex s
e1 GenRegex s
e2)          = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`unionCS` GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2
firstChars (Else GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`unionCS` GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2
firstChars (Seq GenRegex s
e1 GenRegex s
e2)
    | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e1               = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`unionCS` GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2
    | Bool
otherwise                 = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1
firstChars (Rep Int
_i GenRegex s
e)           = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Rng Int
_i Int
_j GenRegex s
e)        = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Diff GenRegex s
e1 GenRegex s
_e2)        = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1                                 -- this is an approximation
firstChars (Isec GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`intersectCS` GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2     -- this is an approximation
firstChars (Exor GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`unionCS`     GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2     -- this is an approximation
firstChars (Intl GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1 CharSet -> CharSet -> CharSet
`unionCS`     GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e2
firstChars (Br Label s
_l GenRegex s
e)            = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Obr Label s
_l s
_s Int
_n GenRegex s
e)     = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Cbr [(Label s, s)]
_ss GenRegex s
e)          = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e

-- ------------------------------------------------------------

delta1 :: (StringLike s) => Char -> s -> GenRegex s -> GenRegex s
delta1 :: forall s. StringLike s => Char -> s -> GenRegex s -> GenRegex s
delta1 Char
c s
inp GenRegex s
e0
  = GenRegex s -> GenRegex s
d' GenRegex s
e0
  where
    d' :: GenRegex s -> GenRegex s
d' e :: GenRegex s
e@(Zero s
_)           = GenRegex s
e
    d' GenRegex s
Unit                 = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' (String -> GenRegex s) -> String -> GenRegex s
forall a b. (a -> b) -> a -> b
$
                              String
"unexpected char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
    d' (Sym CharSet
p)
      | Char
c Char -> CharSet -> Bool
`elemCS` CharSet
p        = GenRegex s
forall s. GenRegex s
mkUnit
      | Bool
otherwise           = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' (String -> GenRegex s) -> String -> GenRegex s
forall a b. (a -> b) -> a -> b
$
                              String
"unexpected char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
    d' GenRegex s
Dot                  = GenRegex s
forall s. GenRegex s
mkUnit
    d' e :: GenRegex s
e@(Star GenRegex s
Dot)         = GenRegex s
e
    d' e :: GenRegex s
e@(Star GenRegex s
e1)          = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq  (GenRegex s -> GenRegex s
d' GenRegex s
e1) GenRegex s
e
    d' (Alt GenRegex s
e1 GenRegex s
e2)          = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt  (GenRegex s -> GenRegex s
d' GenRegex s
e1) (GenRegex s -> GenRegex s
d' GenRegex s
e2)
    d' (Else GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse (GenRegex s -> GenRegex s
d' GenRegex s
e1) (GenRegex s -> GenRegex s
d' GenRegex s
e2)

    d' (Seq e1 :: GenRegex s
e1@(Br  Label s
l     GenRegex s
e1') GenRegex s
e2)
      | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e1'        = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e1) GenRegex s
e2)  -- longest submatch first
                                    (SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr [(Label s
l, s
forall a. StringLike a => a
emptyS)] (GenRegex s -> GenRegex s
d' GenRegex s
e2))

    d' (Seq e1 :: GenRegex s
e1@(Obr Label s
l s
s Int
n GenRegex s
e1') GenRegex s
e2)
      | Bool
nu                  = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e1) GenRegex s
e2)
                                    (SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr ((Label s
l, Int -> s -> s
forall a. StringLike a => Int -> a -> a
takeS Int
n s
s) (Label s, s) -> SubexResults s -> SubexResults s
forall a. a -> [a] -> [a]
: SubexResults s
ws) (GenRegex s -> GenRegex s
d' GenRegex s
e2))
                              where
                                (Bool
nu, SubexResults s
ws) = GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1'
    d' (Seq GenRegex s
e1 GenRegex s
e2)
      | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
e1         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e1) GenRegex s
e2)
                                    (GenRegex s -> GenRegex s
d' GenRegex s
e2)
      | Bool
otherwise           = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e1) GenRegex s
e2
    d' (Rep Int
i GenRegex s
e)            = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e) (Int -> GenRegex s -> GenRegex s
forall s. StringLike s => Int -> GenRegex s -> GenRegex s
mkRep (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) GenRegex s
e)
    d' (Rng Int
i Int
j GenRegex s
e)          = GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkSeq (GenRegex s -> GenRegex s
d' GenRegex s
e) (Int -> Int -> GenRegex s -> GenRegex s
forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) GenRegex s
e)
    d' (Diff GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff  (GenRegex s -> GenRegex s
d' GenRegex s
e1) (GenRegex s -> GenRegex s
d' GenRegex s
e2)
    d' (Isec GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkIsect (GenRegex s -> GenRegex s
d' GenRegex s
e1) (GenRegex s -> GenRegex s
d' GenRegex s
e2)
    d' (Exor GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkExor  (GenRegex s -> GenRegex s
d' GenRegex s
e1) (GenRegex s -> GenRegex s
d' GenRegex s
e2)
    d' (Intl GenRegex s
e1 GenRegex s
e2)         = GenRegex s -> GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt   (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkInterleave (GenRegex s -> GenRegex s
d' GenRegex s
e1)     GenRegex s
e2 )
                                      (GenRegex s -> GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s -> GenRegex s
mkInterleave     GenRegex s
e1  (GenRegex s -> GenRegex s
d' GenRegex s
e2))

    d' (Br  Label s
l     GenRegex s
e)        = GenRegex s -> GenRegex s
d' (Label s -> s -> Int -> GenRegex s -> GenRegex s
forall s.
StringLike s =>
Label s -> s -> Int -> GenRegex s -> GenRegex s
mkObr Label s
l s
inp Int
0 GenRegex s
e)        -- a subex parse starts
    d' (Obr Label s
l s
s Int
n GenRegex s
e)        = Label s -> s -> Int -> GenRegex s -> GenRegex s
forall s.
StringLike s =>
Label s -> s -> Int -> GenRegex s -> GenRegex s
mkObr Label s
l s
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (GenRegex s -> GenRegex s
d' GenRegex s
e)    -- a subex parse cont.
    d' (Cbr SubexResults s
ss GenRegex s
e)           = SubexResults s -> GenRegex s -> GenRegex s
forall s. SubexResults s -> GenRegex s -> GenRegex s
mkCbr SubexResults s
ss (GenRegex s -> GenRegex s
d' GenRegex s
e)             -- the results of a subex parse

-- ------------------------------------------------------------

delta :: (StringLike s) => s -> GenRegex s -> GenRegex s
delta :: forall s. StringLike s => s -> GenRegex s -> GenRegex s
delta inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (Char
c, s
inp')) GenRegex s
e0
  = GenRegex s -> GenRegex s
d' GenRegex s
e0
  where
    d' :: GenRegex s -> GenRegex s
d' e :: GenRegex s
e@(Zero s
_)   = GenRegex s
e   -- don't process whole input, parse has failed
    d' e :: GenRegex s
e@(Star GenRegex s
Dot) = GenRegex s
e   -- don't process input, derivative does not change
    d' GenRegex s
e            = s -> GenRegex s -> GenRegex s
forall s. StringLike s => s -> GenRegex s -> GenRegex s
delta s
inp' ( -- trc ("delta(" ++ show c ++ ")=") $
                                   Char -> s -> GenRegex s -> GenRegex s
forall s. StringLike s => Char -> s -> GenRegex s -> GenRegex s
delta1 Char
c s
inp GenRegex s
e)

delta s
_empty GenRegex s
e
  = GenRegex s
e


matchWithRegex :: (StringLike s) =>
                  GenRegex s -> s -> Bool
matchWithRegex :: forall s. StringLike s => GenRegex s -> s -> Bool
matchWithRegex GenRegex s
e s
s
  = GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable (GenRegex s -> Bool) -> GenRegex s -> Bool
forall a b. (a -> b) -> a -> b
$ s -> GenRegex s -> GenRegex s
forall s. StringLike s => s -> GenRegex s -> GenRegex s
delta s
s GenRegex s
e

matchWithRegex' :: (StringLike s) =>
                   GenRegex s -> s -> Maybe (SubexResults s)
matchWithRegex' :: forall s. StringLike s => GenRegex s -> s -> Maybe (SubexResults s)
matchWithRegex' GenRegex s
e s
s
  = (\ (Bool
r, SubexResults s
l) -> if Bool
r then SubexResults s -> Maybe (SubexResults s)
forall a. a -> Maybe a
Just SubexResults s
l else Maybe (SubexResults s)
forall a. Maybe a
Nothing) ((Bool, SubexResults s) -> Maybe (SubexResults s))
-> (GenRegex s -> (Bool, SubexResults s))
-> GenRegex s
-> Maybe (SubexResults s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable' (GenRegex s -> Maybe (SubexResults s))
-> GenRegex s -> Maybe (SubexResults s)
forall a b. (a -> b) -> a -> b
$ s -> GenRegex s -> GenRegex s
forall s. StringLike s => s -> GenRegex s -> GenRegex s
delta s
s GenRegex s
e

-- ------------------------------------------------------------

-- | This function wraps the whole regex in a subexpression before starting
-- the parse. This is done for getting access to
-- the whole parsed string. Therfore we need one special label, this label
-- is the Nothing value, all explicit labels are Just labels.

splitWithRegex :: (StringLike s) =>
                  GenRegex s -> s -> Maybe (SubexResults s, s)
splitWithRegex :: forall s.
StringLike s =>
GenRegex s -> s -> Maybe (SubexResults s, s)
splitWithRegex GenRegex s
re s
inp
  = do
    (GenRegex s
re', s
rest) <- GenRegex s -> s -> Maybe (GenRegex s, s)
forall s. StringLike s => GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex' (GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s
mkBrN GenRegex s
re) s
inp
    (SubexResults s, s) -> Maybe (SubexResults s, s)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Bool, SubexResults s) -> SubexResults s
forall a b. (a, b) -> b
snd ((Bool, SubexResults s) -> SubexResults s)
-> (GenRegex s -> (Bool, SubexResults s))
-> GenRegex s
-> SubexResults s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable' (GenRegex s -> SubexResults s) -> GenRegex s -> SubexResults s
forall a b. (a -> b) -> a -> b
$ GenRegex s
re', s
rest)

splitWithRegexCS :: (StringLike s) =>
                    GenRegex s -> CharSet -> s -> Maybe (SubexResults s, s)
splitWithRegexCS :: forall s.
StringLike s =>
GenRegex s -> CharSet -> s -> Maybe (SubexResults s, s)
splitWithRegexCS GenRegex s
re CharSet
cs s
inp
  = do
    (GenRegex s
re', s
rest) <- GenRegex s -> CharSet -> s -> Maybe (GenRegex s, s)
forall s.
StringLike s =>
GenRegex s -> CharSet -> s -> Maybe (GenRegex s, s)
splitWithRegexCS' (GenRegex s -> GenRegex s
forall s. GenRegex s -> GenRegex s
mkBrN GenRegex s
re) CharSet
cs s
inp
    (SubexResults s, s) -> Maybe (SubexResults s, s)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Bool, SubexResults s) -> SubexResults s
forall a b. (a, b) -> b
snd ((Bool, SubexResults s) -> SubexResults s)
-> (GenRegex s -> (Bool, SubexResults s))
-> GenRegex s
-> SubexResults s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable' (GenRegex s -> SubexResults s) -> GenRegex s -> SubexResults s
forall a b. (a -> b) -> a -> b
$ GenRegex s
re', s
rest)

-- ----------------------------------------
--
-- | The main scanner function

{- linear recursive function, can lead to stack overflow

splitWithRegex'                 :: Eq l => GenRegex s -> String -> Maybe (GenRegex s, String)
splitWithRegex' re ""
    | nullable re               = Just (re, "")
    | otherwise                 = Nothing

splitWithRegex' re inp@(c : inp')
    | isZero re                 = Nothing
    | otherwise                 = evalRes . splitWithRegex' (delta1 re c) $ inp'
    where
    evalRes Nothing
        | nullable re           = Just (re, inp)
        | otherwise             = Nothing
    evalRes res                 = res
-}

-- tail recursive version of above function

splitWithRegex' :: (StringLike s) =>
                   GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex' :: forall s. StringLike s => GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex' GenRegex s
re s
inp
  = Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
forall s.
StringLike s =>
Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex''
    ( if GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
re
      then (GenRegex s, s) -> Maybe (GenRegex s, s)
forall a. a -> Maybe a
Just (GenRegex s
re, s
inp)         -- first possible result: empty prefix
      else Maybe (GenRegex s, s)
forall a. Maybe a
Nothing                -- empty prefix not a result
    ) GenRegex s
re s
inp

splitWithRegex'' :: (StringLike s) =>
                    Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)

splitWithRegex'' :: forall s.
StringLike s =>
Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex'' Maybe (GenRegex s, s)
lastRes GenRegex s
re inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (Char
c, s
inp'))
  | GenRegex s -> Bool
forall s. GenRegex s -> Bool
isZero GenRegex s
re = Maybe (GenRegex s, s)
lastRes
  | Bool
otherwise = Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
forall s.
StringLike s =>
Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex'' Maybe (GenRegex s, s)
nextRes GenRegex s
re' (s -> Maybe (GenRegex s, s)) -> s -> Maybe (GenRegex s, s)
forall a b. (a -> b) -> a -> b
$ s
inp'
  where
    re' :: GenRegex s
re' = Char -> s -> GenRegex s -> GenRegex s
forall s. StringLike s => Char -> s -> GenRegex s -> GenRegex s
delta1 Char
c s
inp GenRegex s
re
    nextRes :: Maybe (GenRegex s, s)
nextRes
      | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
re' = (GenRegex s, s) -> Maybe (GenRegex s, s)
forall a. a -> Maybe a
Just (GenRegex s
re', s
inp')
      | Bool
otherwise    = Maybe (GenRegex s, s)
lastRes

splitWithRegex'' Maybe (GenRegex s, s)
lastRes GenRegex s
_re s
_empty
  = Maybe (GenRegex s, s)
lastRes

-- ----------------------------------------
--
-- | speedup version for splitWithRegex'
--
-- This function checks whether the input starts with a char from FIRST re.
-- If this is not the case, the split fails. The FIRST set can be computed once
-- for a whole tokenizer and reused by every call of split

splitWithRegexCS' :: (StringLike s) =>
                     GenRegex s -> CharSet -> s -> Maybe (GenRegex s, s)
splitWithRegexCS' :: forall s.
StringLike s =>
GenRegex s -> CharSet -> s -> Maybe (GenRegex s, s)
splitWithRegexCS' GenRegex s
re CharSet
cs inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (Char
c, s
_inp'))
  | Char
c Char -> CharSet -> Bool
`elemCS` CharSet
cs = GenRegex s -> s -> Maybe (GenRegex s, s)
forall s. StringLike s => GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex' GenRegex s
re s
inp

splitWithRegexCS' GenRegex s
re CharSet
_cs s
inp
  | GenRegex s -> Bool
forall s. StringLike s => GenRegex s -> Bool
nullable GenRegex s
re = (GenRegex s, s) -> Maybe (GenRegex s, s)
forall a. a -> Maybe a
Just (GenRegex s
re, s
inp)
  | Bool
otherwise = Maybe (GenRegex s, s)
forall a. Maybe a
Nothing

-- ------------------------------------------------------------