{-# 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
/= :: GenRegex s -> GenRegex s -> Bool
$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
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
min :: GenRegex s -> GenRegex s -> GenRegex s
$cmin :: forall s. Ord s => GenRegex s -> GenRegex s -> GenRegex s
max :: GenRegex s -> GenRegex s -> GenRegex s
$cmax :: forall s. Ord s => GenRegex s -> GenRegex s -> GenRegex s
>= :: 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
$c< :: forall s. Ord s => GenRegex s -> GenRegex s -> Bool
compare :: GenRegex s -> GenRegex s -> Ordering
$ccompare :: forall s. Ord s => GenRegex s -> GenRegex s -> Ordering
$cp1Ord :: forall s. Ord s => Eq (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 :: s -> GenRegex s
mkZero                                  = s -> GenRegex s
forall s. s -> GenRegex s
Zero
{-# INLINE mkZero #-}

mkZero'                                 :: (StringLike s) =>
                                           String -> GenRegex s
mkZero' :: 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 :: 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 :: CharSet -> GenRegex s
mkSym s :: CharSet
s
    | CharSet -> Bool
nullCS CharSet
s                          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "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 :: 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 :: Char -> Char -> GenRegex s
mkSymRng c1 :: Char
c1 c2 :: 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 :: 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 :: 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 :: 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 :: GenRegex s -> GenRegex s
mkStar (Zero _)                         = GenRegex s
forall s. GenRegex s
mkUnit                -- {}* == ()
mkStar e :: GenRegex s
e@GenRegex s
Unit                           = GenRegex s
e                     -- ()* == ()
mkStar e :: GenRegex s
e@(Star _e1 :: GenRegex s
_e1)                     = GenRegex s
e                     -- (r*)* == r*
mkStar (Rep 1 e1 :: GenRegex s
e1)                       = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e1             -- (r+)* == r*
mkStar (Rep i :: Int
i e1 :: GenRegex s
e1)
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 _ _ e1 :: 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
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 e :: 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 :: GenRegex s -> GenRegex s
rmStar (Alt e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1)                        = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e1
rmStar (Rep 1 e1 :: GenRegex s
e1)                       = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
rmStar GenRegex s
e1
rmStar e1 :: GenRegex s
e1                               = GenRegex s
e1

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

mkAlt                                   :: (StringLike s) =>
                                           GenRegex s -> GenRegex s -> GenRegex s
mkAlt :: GenRegex s -> GenRegex s -> GenRegex s
mkAlt e1 :: GenRegex s
e1            (Zero _)            = GenRegex s
e1                            -- e1 u {} = e1
mkAlt (Zero _)      e2 :: GenRegex s
e2                  = GenRegex s
e2                            -- {} u e2 = e2
mkAlt (Sym p1 :: CharSet
p1)      (Sym p2 :: 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 e1 :: GenRegex s
e1            e2 :: GenRegex s
e2@(Sym _)          = 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 _)    (Alt e2 :: GenRegex s
e2@(Sym _) e3 :: 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 _)       e2 :: GenRegex s
e2@GenRegex s
Dot              = GenRegex s
e2                            -- c|.     = .    for a c's
mkAlt e1 :: GenRegex s
e1@(Star Dot) _e2 :: GenRegex s
_e2                 = GenRegex s
e1                            -- A* u e1 = A*
mkAlt _e1 :: GenRegex s
_e1           e2 :: GenRegex s
e2@(Star Dot)       = GenRegex s
e2                            -- e1 u A* = A*
mkAlt (Alt e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)   e3 :: 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 e1 :: GenRegex s
e1 e2 :: 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 :: GenRegex s -> GenRegex s -> GenRegex s
mkElse e1 :: GenRegex s
e1            (Zero _)           = GenRegex s
e1                            -- e1 u {} = e1
mkElse (Zero _)      e2 :: GenRegex s
e2                 = GenRegex s
e2                            -- {} u e2 = e2
mkElse (Sym p1 :: CharSet
p1)      (Sym p2 :: 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 _)  (Else e2 :: GenRegex s
e2@(Sym _) e3 :: 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 _)      e2 :: GenRegex s
e2@GenRegex s
Dot              = GenRegex s
e2                            -- c|.     = .    for a c's
mkElse e1 :: GenRegex s
e1@(Star Dot) _e2 :: GenRegex s
_e2                = GenRegex s
e1                            -- A* u e1 = A*
mkElse _e1 :: GenRegex s
_e1           e2 :: GenRegex s
e2@(Star Dot)      = GenRegex s
e2                            -- e1 u A* = A*
mkElse (Else e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)   e3 :: 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 e1 :: GenRegex s
e1 e2 :: 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 :: GenRegex s -> GenRegex s -> GenRegex s
mkSeq e1 :: GenRegex s
e1@(Zero _) _e2 :: GenRegex s
_e2                   = GenRegex s
e1
mkSeq _e1 :: GenRegex s
_e1         e2 :: GenRegex s
e2@(Zero _)           = GenRegex s
e2
mkSeq Unit        e2 :: GenRegex s
e2                    = GenRegex s
e2
mkSeq (Cbr ss1 :: [(Label s, s)]
ss1 e1 :: GenRegex s
e1) e2 :: 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 e1 :: GenRegex s
e1          Unit                  = GenRegex s
e1
mkSeq (Seq e1 :: GenRegex s
e1 e2 :: GenRegex s
e2) e3 :: 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 e1 :: GenRegex s
e1 e2 :: 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 :: [GenRegex s] -> GenRegex s
mkSeqs                                  = (GenRegex s -> GenRegex s -> GenRegex s)
-> GenRegex s -> [GenRegex s] -> GenRegex s
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 :: Int -> GenRegex s -> GenRegex s
mkRep 0 e :: GenRegex s
e                               = GenRegex s -> GenRegex s
forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
e
mkRep _ e :: GenRegex s
e@(Zero _)                      = GenRegex s
e
mkRep _ e :: 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 i :: Int
i (Rep j :: Int
j e :: 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 i :: Int
i e :: 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 :: Int -> Int -> GenRegex s -> GenRegex s
mkRng 0  0  _e :: GenRegex s
_e                          = GenRegex s
forall s. GenRegex s
mkUnit
mkRng 1  1  e :: GenRegex s
e                           = GenRegex s
e
mkRng lb :: Int
lb ub :: Int
ub _e :: 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
$
                                          "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
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ub
mkRng _l :: Int
_l _u :: Int
_u e :: GenRegex s
e@(Zero _)                  = GenRegex s
e
mkRng _l :: Int
_l _u :: Int
_u e :: GenRegex s
e@GenRegex s
Unit                      = GenRegex s
e
mkRng lb :: Int
lb ub :: Int
ub e :: 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 :: GenRegex s -> GenRegex s
mkOpt                                   = Int -> Int -> GenRegex s -> GenRegex s
forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng 0 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 :: GenRegex s -> GenRegex s -> GenRegex s
mkDiff e1 :: GenRegex s
e1@(Zero _) _e2 :: GenRegex s
_e2                  = GenRegex s
e1                                    -- {} - r2 = {}
mkDiff e1 :: GenRegex s
e1          (Zero _)             = GenRegex s
e1                                    -- r1 - {} = r1
mkDiff _e1 :: GenRegex s
_e1         (Star Dot)           = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "empty set in difference expr" -- r1 - .* = {}
mkDiff Dot         (Sym p :: 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 _)     Dot                  = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "empty set in difference expr" -- x - .  = {}
mkDiff (Sym p1 :: CharSet
p1)    (Sym p2 :: 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 e1 :: GenRegex s
e1          e2 :: 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' "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 :: GenRegex s -> GenRegex s
mkCompl (Zero _)                        = GenRegex s
forall s. StringLike s => GenRegex s
mkAll
mkCompl (Star Dot)                      = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "empty set in compl expr"
mkCompl e :: 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 :: GenRegex s -> GenRegex s -> GenRegex s
mkIsect e1 :: GenRegex s
e1@(Zero _) _e2 :: GenRegex s
_e2                 = GenRegex s
e1                                    -- {} n r2 = {}
mkIsect _e1 :: GenRegex s
_e1         e2 :: GenRegex s
e2@(Zero _)         = GenRegex s
e2                                    -- r1 n {} = {}
mkIsect e1 :: GenRegex s
e1@(GenRegex s
Unit)   e2 :: 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' "intersection empty"
mkIsect e1 :: 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 p1 :: CharSet
p1)    (Sym p2 :: 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 _)  Dot                 = GenRegex s
e1                                    -- x n . = x
mkIsect Dot         e2 :: GenRegex s
e2@(Sym _)          = GenRegex s
e2                                    -- . n x = x

mkIsect (Star Dot)  e2 :: GenRegex s
e2                  = GenRegex s
e2                                    -- .* n r2 = r2
mkIsect e1 :: GenRegex s
e1          (Star Dot)          = GenRegex s
e1                                    -- r1 n .* = r1
mkIsect e1 :: GenRegex s
e1          e2 :: 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 :: GenRegex s -> GenRegex s -> GenRegex s
mkExor (Zero _)     e2 :: GenRegex s
e2                  = GenRegex s
e2
mkExor e1 :: GenRegex s
e1           (Zero _)            = GenRegex s
e1
mkExor (Star Dot)   _e2 :: GenRegex s
_e2                 = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "empty set in exor expr"
mkExor _e1 :: GenRegex s
_e1          (Star Dot)          = String -> GenRegex s
forall s. StringLike s => String -> GenRegex s
mkZero' "empty set in exor expr"
mkExor (Sym p1 :: CharSet
p1)     (Sym p2 :: 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 p1 :: CharSet
p1)     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 Dot          (Sym p2 :: 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 e1 :: GenRegex s
e1           e2 :: 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' "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 :: GenRegex s -> GenRegex s -> GenRegex s
mkInterleave e1 :: GenRegex s
e1@(Zero _) _              = GenRegex s
e1
mkInterleave _           e2 :: GenRegex s
e2@(Zero _)    = GenRegex s
e2
mkInterleave (GenRegex s
Unit)      e2 :: GenRegex s
e2             = GenRegex s
e2
mkInterleave e1 :: GenRegex s
e1          (GenRegex s
Unit)         = GenRegex s
e1
mkInterleave e1 :: GenRegex s
e1          e2 :: 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 :: s -> GenRegex s -> GenRegex s
mkBr l :: s
l e :: 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' :: String -> GenRegex s -> GenRegex s
mkBr' l :: String
l e :: 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 :: GenRegex s -> GenRegex s
mkBrN e :: 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 :: Label s -> s -> Int -> GenRegex s -> GenRegex s
mkObr _ _ _ e :: GenRegex s
e@(Zero _)                  = GenRegex s
e
mkObr l :: Label s
l s :: s
s n :: Int
n 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 l :: Label s
l s :: s
s n :: Int
n e :: 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 :: SubexResults s -> GenRegex s -> GenRegex s
mkCbr  _  e :: GenRegex s
e@(Zero _)                    = GenRegex s
e                             -- dead end, throw away subexpr matches
mkCbr ss :: SubexResults s
ss (Cbr ss1 :: SubexResults s
ss1 e :: 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 ss :: SubexResults s
ss  e :: 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 e :: s
e)               = "{" 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]
++ "}"
    show Unit                   = "()"
    show (Sym p :: CharSet
p)
        | CharSet
p CharSet -> CharSet -> Bool
forall a. Eq a => a -> a -> Bool
== CharSet -> CharSet
compCS (String -> CharSet
stringCS "\n\r")
                                = "."
        | CharSet -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CharSet -> CharSet
forall a. [a] -> [a]
tail CharSet
cs) Bool -> Bool -> Bool
&&
          (Char, Char) -> Bool
forall a. Eq a => (a, a) -> Bool
rng1 (CharSet -> (Char, Char)
forall a. [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. [a] -> a
head (CharSet -> String) -> CharSet -> String
forall a b. (a -> b) -> a -> b
$ CharSet
cs
        | Bool
otherwise             = "[" 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]
++ "]"
                                  where
                                  rng1 :: (a, a) -> Bool
rng1 (x :: a
x,y :: 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 (x :: Char
x, y :: 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
forall a. [a] -> [a] -> [a]
++ Char -> String
esc Char
y
                                  esc :: Char -> String
esc x :: Char
x
                                      | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "\\-[]{}()*+?.^"
                                                = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:""
                                      | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= ' ' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '~'
                                                = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:""
                                      | Bool
otherwise
                                                = "&#" 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]
++ ";"
    show Dot                    = "\\a"
    show (Star Dot)             = "\\A"
    show (Star e :: GenRegex s
e)               = "(" 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]
++ "*)"
    show (Alt e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)            = "(" 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
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]
++ ")"
    show (Else e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)           = "(" 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
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]
++ ")"
    show (Seq e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)            = "(" 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]
++ ")"
    show (Rep 1 e :: GenRegex s
e)              = "(" 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]
++ "+)"
    show (Rep i :: Int
i e :: GenRegex s
e)              = "(" 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
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ ",})"
    show (Rng 0 1 e :: GenRegex s
e)            = "(" 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]
++ "?)"
    show (Rng i :: Int
i j :: Int
j e :: GenRegex s
e)            = "(" 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
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
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ "})"
    show (Diff e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)           = "(" 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
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]
++ ")"
    show (Isec e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)           = "(" 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
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]
++ ")"
    show (Exor e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)           = "(" 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
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]
++ ")"
    show (Intl e1 :: GenRegex s
e1 e2 :: GenRegex s
e2)           = "(" 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
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]
++ ")"
    show (Br  l :: Label s
l     e :: GenRegex s
e)          = "({" 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
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]
++ ")"
    show (Obr l :: Label s
l s :: s
s n :: Int
n e :: GenRegex s
e)          = "({" 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
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
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]
++ ")"
    show (Cbr ss :: [(Label s, s)]
ss e :: GenRegex s
e)             = "([" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," (((Label s, s) -> String) -> [(Label s, s)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (l :: Label s
l, s :: 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
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
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]
++
                                  ")"

showL                           :: Show s => Label s -> String
showL :: 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 "" s -> String
forall a. Show a => a -> String
show
                                  where
                                  rmq :: String -> String
rmq ('\"':xs :: String
xs) = String -> String
forall a. [a] -> [a]
init String
xs
                                  rmq xs :: String
xs          = String
xs

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

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

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

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

nullable                        :: (StringLike s) =>
                                   GenRegex s -> Bool
nullable :: 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' :: GenRegex s -> Nullable s
nullable' (Zero _)              = (Bool
False, [])
nullable' Unit                  = (Bool
True,  [])
nullable' Dot                   = (Bool
False, [])
nullable' (Sym _x :: CharSet
_x)              = (Bool
False, [])

nullable' (Star _e :: GenRegex s
_e)             = (Bool
True,  [])
nullable' (Rep _i :: Int
_i e :: GenRegex s
e)            = GenRegex s -> Nullable s
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e
nullable' (Rng i :: Int
i _ e :: GenRegex s
e)           = (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 e1 :: GenRegex s
e1 e2 :: 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   e1 :: GenRegex s
e1 e2 :: 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  e1 :: GenRegex s
e1 e2 :: 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  e1 :: GenRegex s
e1 e2 :: 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  e1 :: GenRegex s
e1 e2 :: 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  e1 :: GenRegex s
e1 e2 :: 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  e1 :: GenRegex s
e1 e2 :: 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  l :: Label s
l e :: 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 l :: Label s
l s :: s
s n :: Int
n e :: 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 ss :: [(Label s, s)]
ss e :: 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 :: Nullable s -> Nullable s -> Nullable s
isectN (True, ws1 :: SubexResults s
ws1) (True, ws2 :: SubexResults s
ws2)  = (Bool
True, SubexResults s
ws1 SubexResults s -> SubexResults s -> SubexResults s
forall a. [a] -> [a] -> [a]
++ SubexResults s
ws2)
isectN _           _            = (Bool
False, [])

unionN                          :: Nullable s -> Nullable s -> Nullable s
unionN :: Nullable s -> Nullable s -> Nullable s
unionN (False, _) (False, _)    = (Bool
False, [])
unionN (_, ws1 :: SubexResults s
ws1)   (_, ws2 :: 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 :: Nullable s -> Nullable s -> Nullable s
orElseN e1 :: Nullable s
e1@(True, _ws1 :: SubexResults s
_ws1) _       = Nullable s
e1
orElseN _            e2 :: Nullable s
e2         = Nullable s
e2

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

exorN                           :: Nullable s -> Nullable s -> Nullable s
exorN :: Nullable s -> Nullable s -> Nullable s
exorN n1 :: Nullable s
n1@(True, _)  (False, _)  = Nullable s
n1
exorN (False, _)  n2 :: Nullable s
n2@(True, _)  = Nullable s
n2
exorN _           _             = (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 :: GenRegex s -> CharSet
firstChars (Zero _)             = CharSet
emptyCS
firstChars Unit                 = CharSet
emptyCS
firstChars (Sym p :: CharSet
p)              = CharSet
p
firstChars Dot                  = CharSet
allCS

firstChars (Star e1 :: GenRegex s
e1)            = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1
firstChars (Alt e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 _i :: Int
_i e :: GenRegex s
e)           = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Rng _i :: Int
_i _j :: Int
_j e :: GenRegex s
e)        = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Diff e1 :: GenRegex s
e1 _e2 :: GenRegex s
_e2)        = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e1                                 -- this is an approximation
firstChars (Isec e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 _l :: Label s
_l e :: GenRegex s
e)            = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Obr _l :: Label s
_l _s :: s
_s _n :: Int
_n e :: GenRegex s
e)     = GenRegex s -> CharSet
forall s. StringLike s => GenRegex s -> CharSet
firstChars GenRegex s
e
firstChars (Cbr _ss :: [(Label s, s)]
_ss e :: 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 :: Char -> s -> GenRegex s -> GenRegex s
delta1 c :: Char
c inp :: s
inp e0 :: GenRegex s
e0
  = GenRegex s -> GenRegex s
d' GenRegex s
e0
  where
    d' :: GenRegex s -> GenRegex s
d' e :: GenRegex s
e@(Zero _)           = GenRegex s
e
    d' 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
$
                              "unexpected char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
    d' (Sym p :: 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
$
                              "unexpected char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
    d' Dot                  = GenRegex s
forall s. GenRegex s
mkUnit
    d' e :: GenRegex s
e@(Star Dot)         = GenRegex s
e
    d' e :: GenRegex s
e@(Star e1 :: 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 e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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  l :: Label s
l     e1' :: GenRegex s
e1') e2 :: 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 l :: Label s
l s :: s
s n :: Int
n e1' :: GenRegex s
e1') e2 :: 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
                                (nu :: Bool
nu, ws :: SubexResults s
ws) = GenRegex s -> (Bool, SubexResults s)
forall s. StringLike s => GenRegex s -> Nullable s
nullable' GenRegex s
e1'
    d' (Seq e1 :: GenRegex s
e1 e2 :: 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 i :: Int
i e :: 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
-1) GenRegex s
e)
    d' (Rng i :: Int
i j :: Int
j e :: 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
-1) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` 0) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) GenRegex s
e)
    d' (Diff e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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 e1 :: GenRegex s
e1 e2 :: 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  l :: Label s
l     e :: 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 0 GenRegex s
e)        -- a subex parse starts
    d' (Obr l :: Label s
l s :: s
s n :: Int
n e :: 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
+ 1) (GenRegex s -> GenRegex s
d' GenRegex s
e)    -- a subex parse cont.
    d' (Cbr ss :: SubexResults s
ss e :: 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 :: s -> GenRegex s -> GenRegex s
delta inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (c :: Char
c, inp' :: s
inp')) e0 :: GenRegex s
e0
  = GenRegex s -> GenRegex s
d' GenRegex s
e0
  where
    d' :: GenRegex s -> GenRegex s
d' e :: GenRegex s
e@(Zero _)   = GenRegex s
e   -- don't process whole input, parse has failed
    d' e :: GenRegex s
e@(Star Dot) = GenRegex s
e   -- don't process input, derivative does not change
    d' e :: 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 _empty :: s
_empty e :: GenRegex s
e
  = GenRegex s
e


matchWithRegex :: (StringLike s) =>
                  GenRegex s -> s -> Bool
matchWithRegex :: GenRegex s -> s -> Bool
matchWithRegex e :: GenRegex s
e s :: 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' :: GenRegex s -> s -> Maybe (SubexResults s)
matchWithRegex' e :: GenRegex s
e s :: s
s
  = (\ (r :: Bool
r, l :: 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 :: GenRegex s -> s -> Maybe (SubexResults s, s)
splitWithRegex re :: GenRegex s
re inp :: s
inp
  = do
    (re' :: GenRegex s
re', rest :: 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 (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 :: GenRegex s -> CharSet -> s -> Maybe (SubexResults s, s)
splitWithRegexCS re :: GenRegex s
re cs :: CharSet
cs inp :: s
inp
  = do
    (re' :: GenRegex s
re', rest :: 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 (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' :: GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex' re :: GenRegex s
re inp :: 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'' :: Maybe (GenRegex s, s) -> GenRegex s -> s -> Maybe (GenRegex s, s)
splitWithRegex'' lastRes :: Maybe (GenRegex s, s)
lastRes re :: GenRegex s
re inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (c :: Char
c, inp' :: 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'' lastRes :: Maybe (GenRegex s, s)
lastRes _re :: GenRegex s
_re _empty :: 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' :: GenRegex s -> CharSet -> s -> Maybe (GenRegex s, s)
splitWithRegexCS' re :: GenRegex s
re cs :: CharSet
cs inp :: s
inp@(s -> Maybe (Char, s)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (c :: Char
c, _inp' :: 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' re :: GenRegex s
re _cs :: CharSet
_cs inp :: 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

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