-- | This "Text.Regex.TDFA.Pattern" module provides the 'Pattern' data
-- type and its subtypes.  This 'Pattern' type is used to represent
-- the parsed form of a Regular Expression.  
module Text.Regex.TDFA.Pattern
    (Pattern(..)
    ,PatternSet(..)
    ,PatternSetCharacterClass(..)
    ,PatternSetCollatingElement(..)
    ,PatternSetEquivalenceClass(..)
    ,GroupIndex
    ,DoPa(..)
    ,showPattern
-- ** Internal use
    ,starTrans
-- ** Internal use, Operations to support debugging under ghci
    ,starTrans',simplify',dfsPattern
    ) where

{- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}

import Data.List(intersperse,partition)
import qualified Data.Set as Set(toAscList,toList)
import Data.Set(Set) -- XXX EnumSet
import Text.Regex.TDFA.Common(DoPa(..),GroupIndex,common_error)

err :: String -> a
err :: String -> a
err = String -> String -> a
forall a. String -> String -> a
common_error "Text.Regex.TDFA.Pattern"

-- | Pattern is the type returned by the regular expression parser.
-- This is consumed by the CorePattern module and the tender leaves
-- are nibbled by the TNFA module.
data Pattern = PEmpty
             | PGroup  (Maybe GroupIndex) Pattern -- Nothing to indicate non-matching PGroup (Nothing never used!)
             | POr     [Pattern]                  -- flattened by starTrans
             | PConcat [Pattern]                  -- flattened by starTrans
             | PQuest  Pattern                    -- eliminated by starTrans
             | PPlus   Pattern                    -- eliminated by starTrans
             | PStar   Bool Pattern               -- True means mayFirstBeNull is True
             | PBound  Int (Maybe Int) Pattern    -- eliminated by starTrans
             -- The rest of these need an index of where in the regex string it is from
             | PCarat  {Pattern -> DoPa
getDoPa::DoPa}
             | PDollar {getDoPa::DoPa}
             -- The following test and accept a single character
             | PDot    {getDoPa::DoPa}            -- Any character (newline?) at all
             | PAny    {getDoPa::DoPa,Pattern -> PatternSet
getPatternSet::PatternSet} -- Square bracketed things
             | PAnyNot {getDoPa::DoPa,getPatternSet::PatternSet} -- Inverted square bracketed things
             | PEscape {getDoPa::DoPa,Pattern -> Char
getPatternChar::Char}      -- Backslashed Character
             | PChar   {getDoPa::DoPa,getPatternChar::Char}      -- Specific Character
             -- The following are semantic tags created in starTrans, not the parser
             | PNonCapture Pattern               -- introduced by starTrans
             | PNonEmpty Pattern                 -- introduced by starTrans
               deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq,Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

-- | I have not been checking, but this should have the property that
-- parsing the resulting string should result in an identical Pattern.
-- This is not true if starTrans has created PNonCapture and PNonEmpty
-- values or a (PStar False).  The contents of a "[ ]" grouping are
-- always shown in a sorted canonical order.
showPattern :: Pattern -> String
showPattern :: Pattern -> String
showPattern pIn :: Pattern
pIn =
  case Pattern
pIn of
    PEmpty -> "()"
    PGroup _ p :: Pattern
p -> ShowS
paren (Pattern -> String
showPattern Pattern
p)
    POr ps :: [Pattern]
ps -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "|" ((Pattern -> String) -> [Pattern] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> String
showPattern [Pattern]
ps)
    PConcat ps :: [Pattern]
ps -> (Pattern -> String) -> [Pattern] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern -> String
showPattern [Pattern]
ps
    PQuest p :: Pattern
p -> (Pattern -> String
showPattern Pattern
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++"?"
    PPlus p :: Pattern
p -> (Pattern -> String
showPattern Pattern
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++"+"
    -- If PStar has mayFirstBeNull False then reparsing will forget this flag
    PStar _ p :: Pattern
p -> (Pattern -> String
showPattern Pattern
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++"*"
    PBound i :: Int
i (Just j :: Int
j) p :: Pattern
p | Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j -> Pattern -> String
showPattern Pattern
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ ('{'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
i)String -> ShowS
forall a. [a] -> [a] -> [a]
++"}"
    PBound i :: Int
i mj :: Maybe Int
mj p :: Pattern
p -> Pattern -> String
showPattern Pattern
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ ('{'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ",}" (\j :: Int
j -> ','Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
jString -> ShowS
forall a. [a] -> [a] -> [a]
++"}") Maybe Int
mj
    --
    PCarat _ -> "^"
    PDollar _ -> "$"
    PDot _ -> "."
    PAny _ ps :: PatternSet
ps -> ('['Char -> ShowS
forall a. a -> [a] -> [a]
:PatternSet -> String
forall a. Show a => a -> String
show PatternSet
ps)String -> ShowS
forall a. [a] -> [a] -> [a]
++"]"
    PAnyNot _ ps :: PatternSet
ps ->  ('['Char -> ShowS
forall a. a -> [a] -> [a]
:'^'Char -> ShowS
forall a. a -> [a] -> [a]
:PatternSet -> String
forall a. Show a => a -> String
show PatternSet
ps)String -> ShowS
forall a. [a] -> [a] -> [a]
++"]"
    PEscape _ c :: Char
c -> '\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:[]
    PChar _ c :: Char
c -> [Char
c]
    -- The following were not directly from the parser, and will not be parsed in properly
    PNonCapture p :: Pattern
p -> Pattern -> String
showPattern Pattern
p
    PNonEmpty p :: Pattern
p -> Pattern -> String
showPattern Pattern
p
  where {-
        groupRange x n (y:ys) = if (fromEnum y)-(fromEnum x) == n then groupRange x (succ n) ys
                                else (if n <=3 then take n [x..]
                                      else x:'-':(toEnum (pred n+fromEnum x)):[]) ++ groupRange y 1 ys
        groupRange x n [] = if n <=3 then take n [x..]
                            else x:'-':(toEnum (pred n+fromEnum x)):[]
-}
        paren :: ShowS
paren s :: String
s = ('('Char -> ShowS
forall a. a -> [a] -> [a]
:String
s)String -> ShowS
forall a. [a] -> [a] -> [a]
++")"
       
data PatternSet = PatternSet (Maybe (Set Char))
                             (Maybe (Set PatternSetCharacterClass))
                             (Maybe (Set PatternSetCollatingElement))
                             (Maybe (Set PatternSetEquivalenceClass))
                             deriving (PatternSet -> PatternSet -> Bool
(PatternSet -> PatternSet -> Bool)
-> (PatternSet -> PatternSet -> Bool) -> Eq PatternSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternSet -> PatternSet -> Bool
$c/= :: PatternSet -> PatternSet -> Bool
== :: PatternSet -> PatternSet -> Bool
$c== :: PatternSet -> PatternSet -> Bool
Eq)

instance Show PatternSet where
  showsPrec :: Int -> PatternSet -> ShowS
showsPrec i :: Int
i (PatternSet s :: Maybe (Set Char)
s scc :: Maybe (Set PatternSetCharacterClass)
scc sce :: Maybe (Set PatternSetCollatingElement)
sce sec :: Maybe (Set PatternSetEquivalenceClass)
sec) =
    let (special :: String
special,normal :: String
normal) = (String, String)
-> (Set Char -> (String, String))
-> Maybe (Set Char)
-> (String, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ("","") (((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "]-")) (String -> (String, String))
-> (Set Char -> String) -> Set Char -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Char -> String
forall a. Set a -> [a]
Set.toAscList) Maybe (Set Char)
s
        charSpec :: String
charSpec = (if ']' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
special then (']'Char -> ShowS
forall a. a -> [a] -> [a]
:) else ShowS
forall a. a -> a
id) (ShowS
byRange String
normal)
        scc' :: String
scc' = String
-> (Set PatternSetCharacterClass -> String)
-> Maybe (Set PatternSetCharacterClass)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (((PatternSetCharacterClass -> String)
-> [PatternSetCharacterClass] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatternSetCharacterClass -> String
forall a. Show a => a -> String
show) ([PatternSetCharacterClass] -> String)
-> (Set PatternSetCharacterClass -> [PatternSetCharacterClass])
-> Set PatternSetCharacterClass
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PatternSetCharacterClass -> [PatternSetCharacterClass]
forall a. Set a -> [a]
Set.toList) Maybe (Set PatternSetCharacterClass)
scc
        sce' :: String
sce' = String
-> (Set PatternSetCollatingElement -> String)
-> Maybe (Set PatternSetCollatingElement)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (((PatternSetCollatingElement -> String)
-> [PatternSetCollatingElement] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatternSetCollatingElement -> String
forall a. Show a => a -> String
show) ([PatternSetCollatingElement] -> String)
-> (Set PatternSetCollatingElement -> [PatternSetCollatingElement])
-> Set PatternSetCollatingElement
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PatternSetCollatingElement -> [PatternSetCollatingElement]
forall a. Set a -> [a]
Set.toList) Maybe (Set PatternSetCollatingElement)
sce
        sec' :: String
sec' = String
-> (Set PatternSetEquivalenceClass -> String)
-> Maybe (Set PatternSetEquivalenceClass)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (((PatternSetEquivalenceClass -> String)
-> [PatternSetEquivalenceClass] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatternSetEquivalenceClass -> String
forall a. Show a => a -> String
show) ([PatternSetEquivalenceClass] -> String)
-> (Set PatternSetEquivalenceClass -> [PatternSetEquivalenceClass])
-> Set PatternSetEquivalenceClass
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PatternSetEquivalenceClass -> [PatternSetEquivalenceClass]
forall a. Set a -> [a]
Set.toList) Maybe (Set PatternSetEquivalenceClass)
sec
    in String -> ShowS
forall a. Show a => a -> ShowS
shows String
charSpec
       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i String
scc' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i String
sce' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i String
sec'
       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if '-' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
special then Char -> ShowS
showChar '-' else ShowS
forall a. a -> a
id
    where byRange :: ShowS
byRange xAll :: String
xAll@(x :: Char
x:xs :: String
xs) | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xAll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=3 = String
xAll
                              | Bool
otherwise = Char -> Int -> ShowS
groupRange Char
x 1 String
xs
          byRange _ = String
forall a. HasCallStack => a
undefined
          groupRange :: Char -> Int -> ShowS
groupRange x :: Char
x n :: Int
n (y :: Char
y:ys :: String
ys) = if (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
y)Int -> Int -> Int
forall a. Num a => a -> a -> a
-(Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then Char -> Int -> ShowS
groupRange Char
x (Int -> Int
forall a. Enum a => a -> a
succ Int
n) String
ys
                                  else (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=3 then Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n [Char
x..]
                                        else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:'-'Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Int
forall a. Enum a => a -> a
pred Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x))Char -> ShowS
forall a. a -> [a] -> [a]
:[]) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> Int -> ShowS
groupRange Char
y 1 String
ys
          groupRange x :: Char
x n :: Int
n [] = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=3 then Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n [Char
x..]
                              else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:'-'Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Int
forall a. Enum a => a -> a
pred Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x))Char -> ShowS
forall a. a -> [a] -> [a]
:[]

newtype PatternSetCharacterClass   = PatternSetCharacterClass   {PatternSetCharacterClass -> String
unSCC::String}
  deriving (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
(PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> Eq PatternSetCharacterClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c/= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
== :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c== :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
Eq,Eq PatternSetCharacterClass
Eq PatternSetCharacterClass =>
(PatternSetCharacterClass -> PatternSetCharacterClass -> Ordering)
-> (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> (PatternSetCharacterClass -> PatternSetCharacterClass -> Bool)
-> (PatternSetCharacterClass
    -> PatternSetCharacterClass -> PatternSetCharacterClass)
-> (PatternSetCharacterClass
    -> PatternSetCharacterClass -> PatternSetCharacterClass)
-> Ord PatternSetCharacterClass
PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
PatternSetCharacterClass -> PatternSetCharacterClass -> Ordering
PatternSetCharacterClass
-> PatternSetCharacterClass -> PatternSetCharacterClass
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
min :: PatternSetCharacterClass
-> PatternSetCharacterClass -> PatternSetCharacterClass
$cmin :: PatternSetCharacterClass
-> PatternSetCharacterClass -> PatternSetCharacterClass
max :: PatternSetCharacterClass
-> PatternSetCharacterClass -> PatternSetCharacterClass
$cmax :: PatternSetCharacterClass
-> PatternSetCharacterClass -> PatternSetCharacterClass
>= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c>= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
> :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c> :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
<= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c<= :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
< :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
$c< :: PatternSetCharacterClass -> PatternSetCharacterClass -> Bool
compare :: PatternSetCharacterClass -> PatternSetCharacterClass -> Ordering
$ccompare :: PatternSetCharacterClass -> PatternSetCharacterClass -> Ordering
$cp1Ord :: Eq PatternSetCharacterClass
Ord)
newtype PatternSetCollatingElement = PatternSetCollatingElement {PatternSetCollatingElement -> String
unSCE::String}
  deriving (PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
(PatternSetCollatingElement -> PatternSetCollatingElement -> Bool)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> Bool)
-> Eq PatternSetCollatingElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c/= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
== :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c== :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
Eq,Eq PatternSetCollatingElement
Eq PatternSetCollatingElement =>
(PatternSetCollatingElement
 -> PatternSetCollatingElement -> Ordering)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> Bool)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> Bool)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> Bool)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> Bool)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> PatternSetCollatingElement)
-> (PatternSetCollatingElement
    -> PatternSetCollatingElement -> PatternSetCollatingElement)
-> Ord PatternSetCollatingElement
PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
PatternSetCollatingElement
-> PatternSetCollatingElement -> Ordering
PatternSetCollatingElement
-> PatternSetCollatingElement -> PatternSetCollatingElement
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
min :: PatternSetCollatingElement
-> PatternSetCollatingElement -> PatternSetCollatingElement
$cmin :: PatternSetCollatingElement
-> PatternSetCollatingElement -> PatternSetCollatingElement
max :: PatternSetCollatingElement
-> PatternSetCollatingElement -> PatternSetCollatingElement
$cmax :: PatternSetCollatingElement
-> PatternSetCollatingElement -> PatternSetCollatingElement
>= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c>= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
> :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c> :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
<= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c<= :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
< :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
$c< :: PatternSetCollatingElement -> PatternSetCollatingElement -> Bool
compare :: PatternSetCollatingElement
-> PatternSetCollatingElement -> Ordering
$ccompare :: PatternSetCollatingElement
-> PatternSetCollatingElement -> Ordering
$cp1Ord :: Eq PatternSetCollatingElement
Ord)
newtype PatternSetEquivalenceClass = PatternSetEquivalenceClass {PatternSetEquivalenceClass -> String
unSEC::String}
  deriving (PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
(PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> Bool)
-> Eq PatternSetEquivalenceClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c/= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
== :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c== :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
Eq,Eq PatternSetEquivalenceClass
Eq PatternSetEquivalenceClass =>
(PatternSetEquivalenceClass
 -> PatternSetEquivalenceClass -> Ordering)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> Bool)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> Bool)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> Bool)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> Bool)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> PatternSetEquivalenceClass)
-> (PatternSetEquivalenceClass
    -> PatternSetEquivalenceClass -> PatternSetEquivalenceClass)
-> Ord PatternSetEquivalenceClass
PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> Ordering
PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> PatternSetEquivalenceClass
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
min :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> PatternSetEquivalenceClass
$cmin :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> PatternSetEquivalenceClass
max :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> PatternSetEquivalenceClass
$cmax :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> PatternSetEquivalenceClass
>= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c>= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
> :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c> :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
<= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c<= :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
< :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
$c< :: PatternSetEquivalenceClass -> PatternSetEquivalenceClass -> Bool
compare :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> Ordering
$ccompare :: PatternSetEquivalenceClass
-> PatternSetEquivalenceClass -> Ordering
$cp1Ord :: Eq PatternSetEquivalenceClass
Ord)

instance Show PatternSetCharacterClass where
  showsPrec :: Int -> PatternSetCharacterClass -> ShowS
showsPrec _ p :: PatternSetCharacterClass
p = Char -> ShowS
showChar '[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ':' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (PatternSetCharacterClass -> String
unSCC PatternSetCharacterClass
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ':' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ']'
instance Show PatternSetCollatingElement where
  showsPrec :: Int -> PatternSetCollatingElement -> ShowS
showsPrec _ p :: PatternSetCollatingElement
p = Char -> ShowS
showChar '[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (PatternSetCollatingElement -> String
unSCE PatternSetCollatingElement
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ']'
instance Show PatternSetEquivalenceClass where
  showsPrec :: Int -> PatternSetEquivalenceClass -> ShowS
showsPrec _ p :: PatternSetEquivalenceClass
p = Char -> ShowS
showChar '[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '=' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (PatternSetEquivalenceClass -> String
unSEC PatternSetEquivalenceClass
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '=' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ']'

-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == 

-- | Do the transformation and simplification in a single traversal.
-- This removes the PPlus, PQuest, and PBound values, changing to POr
-- and PEmpty and PStar True\/False.  For some PBound values it adds
-- PNonEmpty and PNonCapture semantic marker.  It also simplifies to
-- flatten out nested POr and PConcat instances and eliminate some
-- unneeded PEmpty values.
starTrans :: Pattern -> Pattern
starTrans :: Pattern -> Pattern
starTrans = (Pattern -> Pattern) -> Pattern -> Pattern
dfsPattern (Pattern -> Pattern
simplify' (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
starTrans')

-- | Apply a Pattern transfomation function depth first
dfsPattern :: (Pattern -> Pattern)  -- ^ The transformation function
           -> Pattern               -- ^ The Pattern to transform
           -> Pattern               -- ^ The transformed Pattern
dfsPattern :: (Pattern -> Pattern) -> Pattern -> Pattern
dfsPattern f :: Pattern -> Pattern
f = Pattern -> Pattern
dfs
 where unary :: (Pattern -> Pattern) -> Pattern -> Pattern
unary c :: Pattern -> Pattern
c = Pattern -> Pattern
f (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
c (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
dfs
       dfs :: Pattern -> Pattern
dfs pattern :: Pattern
pattern = case Pattern
pattern of
                       POr ps :: [Pattern]
ps -> Pattern -> Pattern
f ([Pattern] -> Pattern
POr ((Pattern -> Pattern) -> [Pattern] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Pattern
dfs [Pattern]
ps))
                       PConcat ps :: [Pattern]
ps -> Pattern -> Pattern
f ([Pattern] -> Pattern
PConcat ((Pattern -> Pattern) -> [Pattern] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Pattern
dfs [Pattern]
ps))
                       PGroup i :: Maybe Int
i p :: Pattern
p -> (Pattern -> Pattern) -> Pattern -> Pattern
unary (Maybe Int -> Pattern -> Pattern
PGroup Maybe Int
i) Pattern
p
                       PQuest p :: Pattern
p -> (Pattern -> Pattern) -> Pattern -> Pattern
unary Pattern -> Pattern
PQuest Pattern
p
                       PPlus p :: Pattern
p -> (Pattern -> Pattern) -> Pattern -> Pattern
unary Pattern -> Pattern
PPlus Pattern
p
                       PStar i :: Bool
i p :: Pattern
p -> (Pattern -> Pattern) -> Pattern -> Pattern
unary (Bool -> Pattern -> Pattern
PStar Bool
i) Pattern
p
                       PBound i :: Int
i mi :: Maybe Int
mi p :: Pattern
p -> (Pattern -> Pattern) -> Pattern -> Pattern
unary (Int -> Maybe Int -> Pattern -> Pattern
PBound Int
i Maybe Int
mi) Pattern
p
                       _ -> Pattern -> Pattern
f Pattern
pattern

{- Replace by PNonCapture
unCapture = dfsPattern unCapture' where
  unCapture' (PGroup (Just _) p) = PGroup Nothing p
  unCapture' x = x
-}
reGroup :: Pattern -> Pattern
reGroup :: Pattern -> Pattern
reGroup p :: Pattern
p@(PConcat xs :: [Pattern]
xs) | 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Pattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern]
xs = Maybe Int -> Pattern -> Pattern
PGroup Maybe Int
forall a. Maybe a
Nothing Pattern
p
reGroup p :: Pattern
p@(POr xs :: [Pattern]
xs)     | 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Pattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern]
xs = Maybe Int -> Pattern -> Pattern
PGroup Maybe Int
forall a. Maybe a
Nothing Pattern
p
reGroup p :: Pattern
p = Pattern
p

starTrans' :: Pattern -> Pattern
starTrans' :: Pattern -> Pattern
starTrans' pIn :: Pattern
pIn =
  case Pattern
pIn of -- We know that "p" has been simplified in each of these cases:
    PQuest p :: Pattern
p -> [Pattern] -> Pattern
POr [Pattern
p,Pattern
PEmpty]

{- The PStar should not capture 0 characters on its first iteration,
   so set its mayFirstBeNull flag to False
 -}
    PPlus p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> Pattern
p
            | Bool
otherwise -> Pattern -> Pattern
asGroup (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ [Pattern] -> Pattern
PConcat [Pattern -> Pattern
reGroup Pattern
p,Bool -> Pattern -> Pattern
PStar Bool
False Pattern
p]

{- "An ERE matching a single character repeated by an '*' , '?' , or
   an interval expression shall not match a null expression unless
   this is the only match for the repetition or it is necessary to
   satisfy the exact or minimum number of occurrences for the interval
   expression."
 -}
{- p? is p|PEmpty which prefers even a 0-character match for p
   p{0,1} is p? is POr [p,PEmpty]
   p{0,2} is (pp?)? NOT p?p?
   p{0,3} is (p(pp?)?)?
   p{1,2} is like pp{0,1} is like pp? but see below
   p{2,5} is ppp{0,3} is pp(p(pp?)?)?

   But this is not always right.  Because if the second use of p in
   p?p? matches 0 characters then the perhaps non 0 character match of
   the first p is overwritten.

   We need a new operation "p!" that means "p?" unless "p" match 0
   characters, in which case skip p as if it failed in "p?".  Thus
   when p cannot accept 0 characters p! and p? are equivalent.  And
   when p can only match 0 characters p! is PEmpty.  So for
   simplicity, only use ! when p can match 0 characters but not only 0
   characters.

   Call this (PNonEmpty p) in the Pattern type. 
   p! is PNonEmpty p is POr [PEmpty,p]
   IS THIS TRUE?  Use QuickCheck?

   Note that if p cannot match 0 characters then p! is p? and vice versa

   The p{0,1} is still always p? and POr [p,PEmpty]
   Now p{0,2} means p?p! or (pp!)? and p{0,3} means (p(pp!)!)? or p?p!p!
   Equivalently p?p! and p?p!p!
   And p{2,2} is p'p and p{3,3} is p'p'p and p{4} is p'p'p'p
   The p{1,2} is pp! and p{1,3} is pp!p! or p(pp!)!
   And p{2,4} means p'pp!p! and p{3,6} is p'p'pp!p!p! or p'p'p(p(pp!)!)!

   But this second form still has a problem: the (pp!)! can have the first
   p match 0 and the second p match non-zero. This showed up for (.|$){1,3}
   since ($.!)! should not be a valid path but altered the qt_win commands.

   Thus only p'p'pp!p!p! has the right semantics.  For completeness:

   if p can only match only 0 characters then the cases are
   p{0,0} is (), p{0,_} = p?, p{_,_} is p

   if p can match 0 or non-zero characters then cases are
   p{0,0} is (), p{0,1} is (p)?, p{0,2} is (pp!)?, p{0,3} is (pp!p!)?
   p{1,1} is p, p{1,2} is pp!, p{1,3} is pp!p!, p{1,4} is pp!p!p!
   p{2,2} is p'p, 
   p{2,3} is p'pp!, 
   p{2,4} is p'pp!p! or p'p(pp!)!
   p{2,5} is p'pp!p!p! or p'p(p(pp!)!)!
   p{3,3} is p'p'p, p{3,4} is p'p'pp!, p{3,5} is p'p'pp!p!, p{3,6} is p'p'pp!p!p!

   if p can only match 1 or more characters then cases are
   p{0,0} is ()
   p{0,1} is p?, p{0,2} is (pp?)?, p{0,3} is (p(pp?)?)?, p{0,4} is (pp{0,3})?
   p{1,1} is p, p{1,j} is pp{0,pred j}
   p{2,2} is p'p, p{2,3} is p'pp?, p{2,4} is p'p(pp?)?, p{2,5} = p'p{1,4} = p'(pp{0,3})
   p{3,3} is p'p'p, p{3,4} is p'p'pp?, p{3,5} is p'p'p(pp?)?, p{3,6} is 

   And by this logic, the PStar False is really p*!  So p{0,} is p*
   and p{1,} is pp*! and p{2,} is p'pp*! and p{3,} is p'p'pp*!

   The (nonEmpty' p) below is the only way PNonEmpty is introduced
   into the Pattern.  It is always preceded by p inside a PConcat
   list.  The p involved never simplifies to PEmpty.  Thus it is
   impossible to have PNonEmpty directly nested, i.e. (PNonEmpty
   (PNonEmpty _)) never occurs even after simplifications.

   The (nonCapture' p) below is the only way PNonCapture is
   introduced into the Pattern. It is always followed by p inside a
   PConcat list.

-}
-- Easy cases
    PBound i :: Int
i _        _ | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<0 -> Pattern
PEmpty  -- impossibly malformed
    PBound i :: Int
i (Just j :: Int
j) _ | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j -> Pattern
PEmpty  -- impossibly malformed
    PBound _ (Just 0) _ -> Pattern
PEmpty
-- Medium cases
    PBound 0 Nothing  p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> Pattern -> Pattern
quest Pattern
p
                        | Bool
otherwise -> Bool -> Pattern -> Pattern
PStar Bool
True Pattern
p
    PBound 0 (Just 1) p :: Pattern
p -> Pattern -> Pattern
quest Pattern
p
-- Hard cases
    PBound i :: Int
i Nothing  p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> Pattern
p
                        | Bool
otherwise -> Pattern -> Pattern
asGroup (Pattern -> Pattern)
-> ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> Pattern
PConcat ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall a b. (a -> b) -> a -> b
$ ([Pattern] -> [Pattern]) -> Int -> [Pattern] -> [Pattern]
forall a. (a -> a) -> Int -> a -> a
apply (Pattern
nc'pPattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
:) (Int -> Int
forall a. Enum a => a -> a
pred Int
i) [Pattern -> Pattern
reGroup Pattern
p,Bool -> Pattern -> Pattern
PStar Bool
False Pattern
p]
      where nc'p :: Pattern
nc'p = Pattern -> Pattern
nonCapture' Pattern
p
    PBound 0 (Just j :: Int
j) p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> Pattern -> Pattern
quest Pattern
p
                        -- The first operation is quest NOT nonEmpty. This can be tested with
                        -- "a\nb" "((^)?|b){0,3}" and "a\nb" "((^)|b){0,3}"
                        | Bool
otherwise -> Pattern -> Pattern
quest (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Pattern -> Pattern
concat' Pattern
p) (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$
                                        (Pattern -> Pattern) -> Int -> Pattern -> Pattern
forall a. (a -> a) -> Int -> a -> a
apply (Pattern -> Pattern
nonEmpty' (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Pattern -> Pattern
concat' Pattern
p)) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-2) (Pattern -> Pattern
nonEmpty' Pattern
p)
{- 0.99.6 remove
| cannotMatchNull p -> apply (quest' . (concat' p)) (pred j) (quest' p)
| otherwise -> POr [ simplify' (PConcat (p : replicate (pred j) (nonEmpty' p))) , PEmpty ]
-}
{- 0.99.6 add, 0.99.7 remove
    PBound i (Just j) p | canOnlyMatchNull p -> p
                        | i == j -> PConcat $ apply (p':) (pred i) [p]
                        | otherwise -> PConcat $ apply (p':) (pred i)
                                        [p,apply (nonEmpty' . (concat' p)) (j-i-1) (nonEmpty' p) ]
      where p' = nonCapture' p
-}
{- 0.99.7 add -}
    PBound i :: Int
i (Just j :: Int
j) p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> Pattern
p
                        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> Pattern -> Pattern
asGroup (Pattern -> Pattern)
-> ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> Pattern
PConcat ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall a b. (a -> b) -> a -> b
$ ([Pattern] -> [Pattern]) -> Int -> [Pattern] -> [Pattern]
forall a. (a -> a) -> Int -> a -> a
apply (Pattern
nc'pPattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
:) (Int -> Int
forall a. Enum a => a -> a
pred Int
i) [Pattern -> Pattern
reGroup Pattern
p]
                        | Bool
otherwise -> Pattern -> Pattern
asGroup (Pattern -> Pattern)
-> ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> Pattern
PConcat ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall a b. (a -> b) -> a -> b
$ ([Pattern] -> [Pattern]) -> Int -> [Pattern] -> [Pattern]
forall a. (a -> a) -> Int -> a -> a
apply (Pattern
nc'pPattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
:) (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
                                        [Pattern -> Pattern
reGroup Pattern
p,(Pattern -> Pattern) -> Int -> Pattern -> Pattern
forall a. (a -> a) -> Int -> a -> a
apply (Pattern -> Pattern
nonEmpty' (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Pattern -> Pattern
concat' Pattern
p)) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Pattern
ne'p) ]
      where nc'p :: Pattern
nc'p = Pattern -> Pattern
nonCapture' Pattern
p
            ne'p :: Pattern
ne'p = Pattern -> Pattern
nonEmpty' Pattern
p
{- 0.99.6
| cannotMatchNull p -> PConcat $ apply (p':) (pred i) $ (p:) $
  [apply (quest' . (concat' p)) (pred (j-i)) (quest' p)]
| otherwise -> PConcat $ (replicate (pred i) p') ++ p : (replicate (j-i) (nonEmpty' p))
-}
    PStar mayFirstBeNull :: Bool
mayFirstBeNull p :: Pattern
p | Pattern -> Bool
canOnlyMatchNull Pattern
p -> if Bool
mayFirstBeNull then Pattern -> Pattern
quest Pattern
p
                                                                    else Pattern
PEmpty
                           | Bool
otherwise -> Pattern
pass
    -- Left intact
    PEmpty -> Pattern
pass
    PGroup {} -> Pattern
pass
    POr {} -> Pattern
pass
    PConcat {} -> Pattern
pass
    PCarat {} -> Pattern
pass
    PDollar {} -> Pattern
pass
    PDot {} -> Pattern
pass
    PAny {} -> Pattern
pass
    PAnyNot {} -> Pattern
pass
    PEscape {} -> Pattern
pass
    PChar {} -> Pattern
pass
    PNonCapture {} -> Pattern
pass
    PNonEmpty {} -> Pattern
pass -- TODO : remove PNonEmpty from program
  where
    quest :: Pattern -> Pattern
quest = (\ p :: Pattern
p -> [Pattern] -> Pattern
POr [Pattern
p,Pattern
PEmpty])  -- require p to have been simplified
--    quest' = (\ p -> simplify' $ POr [p,PEmpty])  -- require p to have been simplified
    concat' :: Pattern -> Pattern -> Pattern
concat' a :: Pattern
a b :: Pattern
b = Pattern -> Pattern
simplify' (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ [Pattern] -> Pattern
PConcat [Pattern -> Pattern
reGroup Pattern
a,Pattern -> Pattern
reGroup Pattern
b]      -- require a and b to have been simplified
    nonEmpty' :: Pattern -> Pattern
nonEmpty' = (\ p :: Pattern
p -> Pattern -> Pattern
simplify' (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ [Pattern] -> Pattern
POr [Pattern
PEmpty,Pattern
p]) -- 2009-01-19 : this was PNonEmpty
    nonCapture' :: Pattern -> Pattern
nonCapture' = Pattern -> Pattern
PNonCapture
    apply :: (a -> a) -> Int -> a -> a
apply f :: a -> a
f n :: Int
n x :: a
x = ((a -> a) -> a -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) a
x (Int -> (a -> a) -> [a -> a]
forall a. Int -> a -> [a]
replicate Int
n a -> a
f) -- function f applied n times to x : f^n(x)
    asGroup :: Pattern -> Pattern
asGroup p :: Pattern
p = Maybe Int -> Pattern -> Pattern
PGroup Maybe Int
forall a. Maybe a
Nothing (Pattern -> Pattern
simplify' Pattern
p)
    pass :: Pattern
pass = Pattern
pIn

-- | Function to transform a pattern into an equivalent, but less
-- redundant form.  Nested 'POr' and 'PConcat' are flattened. PEmpty
-- is propagated.
simplify' :: Pattern -> Pattern
simplify' :: Pattern -> Pattern
simplify' x :: Pattern
x@(POr _) = 
  let ps' :: [Pattern]
ps' = case (Pattern -> Bool) -> [Pattern] -> ([Pattern], [Pattern])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Pattern -> Bool
notPEmpty (Pattern -> [Pattern]
flatten Pattern
x) of
              (notEmpty :: [Pattern]
notEmpty,[]) -> [Pattern]
notEmpty
              (notEmpty :: [Pattern]
notEmpty,_:rest :: [Pattern]
rest) -> [Pattern]
notEmpty [Pattern] -> [Pattern] -> [Pattern]
forall a. [a] -> [a] -> [a]
++ (Pattern
PEmptyPattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
:(Pattern -> Bool) -> [Pattern] -> [Pattern]
forall a. (a -> Bool) -> [a] -> [a]
filter Pattern -> Bool
notPEmpty [Pattern]
rest) -- keep 1st PEmpty only
  in case [Pattern]
ps' of
       [] -> Pattern
PEmpty
       [p :: Pattern
p] -> Pattern
p
       _ -> [Pattern] -> Pattern
POr [Pattern]
ps'
simplify' x :: Pattern
x@(PConcat _) =
  let ps' :: [Pattern]
ps' = (Pattern -> Bool) -> [Pattern] -> [Pattern]
forall a. (a -> Bool) -> [a] -> [a]
filter Pattern -> Bool
notPEmpty (Pattern -> [Pattern]
flatten Pattern
x)
  in case [Pattern]
ps' of
       [] -> Pattern
PEmpty
       [p :: Pattern
p] -> Pattern
p
       _ -> [Pattern] -> Pattern
PConcat [Pattern]
ps' -- PConcat ps'
simplify' (PStar _ PEmpty) = Pattern
PEmpty
simplify' (PNonCapture PEmpty) = Pattern
PEmpty -- 2009, perhaps useful
--simplify' (PNonEmpty PEmpty) = err "simplify' (PNonEmpty PEmpty) = should be Impossible!" -- 2009
simplify' other :: Pattern
other = Pattern
other

-- | Function to flatten nested POr or nested PConcat applicataions.
flatten :: Pattern -> [Pattern]
flatten :: Pattern -> [Pattern]
flatten (POr ps :: [Pattern]
ps) = ((Pattern -> [Pattern]) -> [Pattern] -> [Pattern]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Pattern
x -> case Pattern
x of
                                       POr ps' :: [Pattern]
ps' -> [Pattern]
ps'
                                       p :: Pattern
p -> [Pattern
p]) [Pattern]
ps)
flatten (PConcat ps :: [Pattern]
ps) = ((Pattern -> [Pattern]) -> [Pattern] -> [Pattern]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Pattern
x -> case Pattern
x of
                                           PConcat ps' :: [Pattern]
ps' -> [Pattern]
ps'
                                           p :: Pattern
p -> [Pattern
p]) [Pattern]
ps)
flatten _ = String -> [Pattern]
forall a. String -> a
err "flatten can only be applied to POr or PConcat"

notPEmpty :: Pattern -> Bool
notPEmpty :: Pattern -> Bool
notPEmpty PEmpty = Bool
False
notPEmpty _      = Bool
True

-- | Determines if pIn will fail or accept [] and never accept any
-- characters. Treat PCarat and PDollar as True.
canOnlyMatchNull :: Pattern -> Bool
canOnlyMatchNull :: Pattern -> Bool
canOnlyMatchNull pIn :: Pattern
pIn =
  case Pattern
pIn of
    PEmpty -> Bool
True
    PGroup _ p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
    POr ps :: [Pattern]
ps -> (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Pattern -> Bool
canOnlyMatchNull [Pattern]
ps
    PConcat ps :: [Pattern]
ps -> (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Pattern -> Bool
canOnlyMatchNull [Pattern]
ps
    PQuest p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
    PPlus p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
    PStar _ p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
    PBound _ (Just 0) _ -> Bool
True
    PBound _ _ p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
    PCarat _ -> Bool
True
    PDollar _ -> Bool
True
    PNonCapture p :: Pattern
p -> Pattern -> Bool
canOnlyMatchNull Pattern
p
--    PNonEmpty p -> canOnlyMatchNull p -- like PQuest
    _ ->Bool
False

{-

-- | If 'cannotMatchNull' returns 'True' then it is known that the
-- 'Pattern' will never accept an empty string.  If 'cannotMatchNull'
-- returns 'False' then it is possible but not definite that the
-- 'Pattern' could accept an empty string.
cannotMatchNull :: Pattern -> Bool
cannotMatchNull pIn =
  case pIn of
    PEmpty -> False
    PGroup _ p -> cannotMatchNull p
    POr [] -> False
    POr ps -> all cannotMatchNull ps
    PConcat [] -> False
    PConcat ps -> any cannotMatchNull ps
    PQuest _ -> False
    PPlus p -> cannotMatchNull p
    PStar {} -> False
    PBound 0 _ _ -> False
    PBound _ _ p -> cannotMatchNull p
    PCarat _ -> False
    PDollar _ -> False
    PNonCapture p -> cannotMatchNull p
--    PNonEmpty _ -> False -- like PQuest
    _ -> True
-}