{-# LANGUAGE BangPatterns #-}
module Regex.Internal.List
  (
    list
  , manyList
  , someList
  , manyListMin
  , someListMin

  , charIgnoreCase
  , oneOfChar
  , stringIgnoreCase
  , manyStringOf
  , someStringOf
  , manyStringOfMin
  , someStringOfMin

  , naturalDec
  , integerDec
  , naturalHex
  , integerHex
  , wordRangeDec
  , intRangeDec
  , wordRangeHex
  , intRangeHex
  , wordDecN
  , wordHexN

  , toMatch
  , withMatch

  , reParse
  , parse
  , parseSure

  , find
  , findAll
  , splitOn
  , replace
  , replaceAll
  ) where

import Control.Applicative
import Data.Char
import Data.Maybe (fromMaybe)
import Numeric.Natural

import Data.CharSet (CharSet)
import qualified Data.CharSet as CS
import Regex.Internal.Parser (Parser)
import qualified Regex.Internal.Parser as P
import Regex.Internal.Regex (RE(..), Greediness(..), Strictness(..))
import qualified Regex.Internal.Regex as R
import qualified Regex.Internal.Num as RNum
import qualified Regex.Internal.Generated.CaseFold as CF

------------------------
-- REs and combinators
------------------------

-- | Parse the given list.
list :: Eq c => [c] -> RE c [c]
list :: forall c. Eq c => [c] -> RE c [c]
list [c]
xs = [c]
xs [c] -> RE c () -> RE c [c]
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (c -> RE c () -> RE c ()) -> RE c () -> [c] -> RE c ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RE c c -> RE c () -> RE c ()
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (RE c c -> RE c () -> RE c ())
-> (c -> RE c c) -> c -> RE c () -> RE c ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> RE c c
forall c. Eq c => c -> RE c c
R.single) (() -> RE c ()
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [c]
xs

-- | Parse any list. Biased towards matching more.
manyList :: RE c [c]
manyList :: forall c. RE c [c]
manyList = RE c c -> RE c [c]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE c c
forall c. RE c c
R.anySingle

-- | Parse any non-empty list. Biased towards matching more.
someList :: RE c [c]
someList :: forall c. RE c [c]
someList = RE c c -> RE c [c]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some RE c c
forall c. RE c c
R.anySingle

-- | Parse any list. Minimal, i.e. biased towards matching less.
manyListMin :: RE c [c]
manyListMin :: forall c. RE c [c]
manyListMin = RE c c -> RE c [c]
forall c a. RE c a -> RE c [a]
R.manyMin RE c c
forall c. RE c c
R.anySingle

-- | Parse any non-empty @String@. Minimal, i.e. biased towards matching less.
someListMin :: RE c [c]
someListMin :: forall c. RE c [c]
someListMin = RE c c -> RE c [c]
forall c a. RE c a -> RE c [a]
R.someMin RE c c
forall c. RE c c
R.anySingle

-----------
-- String
-----------

-- | Parse the given @Char@, ignoring case.
--
-- Comparisons are performed after applying
-- [simple case folding](https://www.unicode.org/reports/tr44/#Simple_Case_Folding)
-- as described by the Unicode standard.
charIgnoreCase :: Char -> RE Char Char
charIgnoreCase :: Char -> RE Char Char
charIgnoreCase Char
c = (Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy ((Char -> Bool) -> RE Char Char) -> (Char -> Bool) -> RE Char Char
forall a b. (a -> b) -> a -> b
$ (Char
c'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Char -> Bool) -> (Char -> Char) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
CF.caseFoldSimple
  where
    !c' :: Char
c' = Char -> Char
CF.caseFoldSimple Char
c
-- See Note [Why simple case fold] in Regex.Internal.Text

-- | Parse a @Char@ if it is a member of the @CharSet@.
oneOfChar :: CharSet -> RE Char Char
oneOfChar :: CharSet -> RE Char Char
oneOfChar !CharSet
cs = (Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy (Char -> CharSet -> Bool
`CS.member` CharSet
cs)

-- | Parse the given @String@, ignoring case.
--
-- Comparisons are performed after applying
-- [simple case folding](https://www.unicode.org/reports/tr44/#Simple_Case_Folding)
-- as described by the Unicode standard.
stringIgnoreCase :: String -> RE Char String
stringIgnoreCase :: String -> RE Char String
stringIgnoreCase = (Char -> RE Char String -> RE Char String)
-> RE Char String -> String -> RE Char String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Char -> String -> String)
-> RE Char Char -> RE Char String -> RE Char String
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
R.liftA2' (:) (RE Char Char -> RE Char String -> RE Char String)
-> (Char -> RE Char Char)
-> Char
-> RE Char String
-> RE Char String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> RE Char Char
charIgnoreCase) (String -> RE Char String
forall a. a -> RE Char a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
-- See Note [Why simple case fold] in Regex.Internal.Text

-- | Parse any @String@ containing members of the @CharSet@.
-- Biased towards matching more.
manyStringOf :: CharSet -> RE Char String
manyStringOf :: CharSet -> RE Char String
manyStringOf !CharSet
cs = RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy (Char -> CharSet -> Bool
`CS.member` CharSet
cs))

-- | Parse any non-empty @String@ containing members of the @CharSet@.
-- Biased towards matching more.
someStringOf :: CharSet -> RE Char String
someStringOf :: CharSet -> RE Char String
someStringOf !CharSet
cs = RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy (Char -> CharSet -> Bool
`CS.member` CharSet
cs))

-- | Parse any @String@ containing members of the @CharSet@.
-- Minimal, i.e. biased towards matching less.
manyStringOfMin :: CharSet -> RE Char String
manyStringOfMin :: CharSet -> RE Char String
manyStringOfMin !CharSet
cs = RE Char Char -> RE Char String
forall c a. RE c a -> RE c [a]
R.manyMin ((Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy (Char -> CharSet -> Bool
`CS.member` CharSet
cs))

-- | Parse any non-empty @String@ containing members of the @CharSet@.
-- Minimal, i.e. biased towards matching less.
someStringOfMin :: CharSet -> RE Char String
someStringOfMin :: CharSet -> RE Char String
someStringOfMin !CharSet
cs = RE Char Char -> RE Char String
forall c a. RE c a -> RE c [a]
R.someMin ((Char -> Bool) -> RE Char Char
forall c. (c -> Bool) -> RE c c
R.satisfy (Char -> CharSet -> Bool
`CS.member` CharSet
cs))

-----------------
-- Numeric REs
-----------------

-- | Parse a decimal @Natural@.
-- Leading zeros are not accepted. Biased towards matching more.
naturalDec :: RE Char Natural
naturalDec :: RE Char Natural
naturalDec = (Word -> Word -> RE Char Word) -> RE Char Natural
forall c. (Word -> Word -> RE c Word) -> RE c Natural
RNum.mkNaturalDec Word -> Word -> RE Char Word
digitRange

-- | Parse a decimal @Integer@. Parse an optional sign, @\'-\'@ or @\'+\'@,
-- followed by the given @RE@, followed by the absolute value of the integer.
-- Leading zeros are not accepted. Biased towards matching more.
integerDec :: RE Char a -> RE Char Integer
integerDec :: forall a. RE Char a -> RE Char Integer
integerDec RE Char a
sep = RE Char () -> RE Char () -> RE Char Natural -> RE Char Integer
forall c minus plus.
RE c minus -> RE c plus -> RE c Natural -> RE c Integer
RNum.mkSignedInteger RE Char ()
minus RE Char ()
plus (RE Char a
sep RE Char a -> RE Char Natural -> RE Char Natural
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char Natural
naturalDec)

-- | Parse a hexadecimal @Natural@. Both uppercase @\'A\'..\'F\'@ and lowercase
-- @\'a\'..\'f\'@ are accepted.
-- Leading zeros are not accepted. Biased towards matching more.
naturalHex :: RE Char Natural
naturalHex :: RE Char Natural
naturalHex = (Word -> Word -> RE Char Word) -> RE Char Natural
forall c. (Word -> Word -> RE c Word) -> RE c Natural
RNum.mkNaturalHex Word -> Word -> RE Char Word
hexDigitRange

-- | Parse a hexadecimal @Integer@. Parse an optional sign, @\'-\'@ or @\'+\'@,
-- followed by the given @RE@, followed by the absolute value of the integer.
-- Both uppercase @\'A\'..\'F\'@ and lowercase @\'a\'..\'f\'@ are accepted.
-- Leading zeros are not accepted. Biased towards matching more.
integerHex :: RE Char a -> RE Char Integer
integerHex :: forall a. RE Char a -> RE Char Integer
integerHex RE Char a
sep = RE Char () -> RE Char () -> RE Char Natural -> RE Char Integer
forall c minus plus.
RE c minus -> RE c plus -> RE c Natural -> RE c Integer
RNum.mkSignedInteger RE Char ()
minus RE Char ()
plus (RE Char a
sep RE Char a -> RE Char Natural -> RE Char Natural
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char Natural
naturalHex)

-- | Parse a decimal @Word@ in the range @[low..high]@.
-- Leading zeros are not accepted. Biased towards matching more.
wordRangeDec :: (Word, Word) -> RE Char Word
wordRangeDec :: (Word, Word) -> RE Char Word
wordRangeDec (Word, Word)
lh = (Word -> Word -> RE Char Word) -> (Word, Word) -> RE Char Word
forall c. (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
RNum.mkWordRangeDec Word -> Word -> RE Char Word
digitRange (Word, Word)
lh

-- | Parse a decimal @Int@ in the range @[low..high]@. Parse an optional sign,
-- @\'-\'@ or @\'+\'@, followed by the given @RE@, followed by the absolute
-- value of the integer.
-- Leading zeros are not accepted. Biased towards matching more.
intRangeDec :: RE Char a -> (Int, Int) -> RE Char Int
intRangeDec :: forall a. RE Char a -> (Int, Int) -> RE Char Int
intRangeDec RE Char a
sep (Int, Int)
lh =
  RE Char ()
-> RE Char ()
-> ((Word, Word) -> RE Char Word)
-> (Int, Int)
-> RE Char Int
forall c minus plus.
RE c minus
-> RE c plus
-> ((Word, Word) -> RE c Word)
-> (Int, Int)
-> RE c Int
RNum.mkSignedIntRange RE Char ()
minus RE Char ()
plus ((RE Char a
sep RE Char a -> RE Char Word -> RE Char Word
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (RE Char Word -> RE Char Word)
-> ((Word, Word) -> RE Char Word) -> (Word, Word) -> RE Char Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word, Word) -> RE Char Word
wordRangeDec) (Int, Int)
lh

-- | Parse a hexadecimal @Word@ in the range @[low..high]@. Both uppercase
-- @\'A\'..\'F\'@ and lowercase @\'a\'..\'f\'@ are accepted.
-- Leading zeros are not accepted. Biased towards matching more.
wordRangeHex :: (Word, Word) -> RE Char Word
wordRangeHex :: (Word, Word) -> RE Char Word
wordRangeHex (Word, Word)
lh = (Word -> Word -> RE Char Word) -> (Word, Word) -> RE Char Word
forall c. (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
RNum.mkWordRangeHex Word -> Word -> RE Char Word
hexDigitRange (Word, Word)
lh

-- | Parse a hexadecimal @Int@ in the range @[low..high]@. Parse an optional
-- sign, @\'-\'@ or @\'+\'@, followed by the given @RE@, followed by the
-- absolute value of the integer.
-- Both uppercase @\'A\'..\'F\'@ and lowercase @\'a\'..\'f\'@ are accepted.
-- Leading zeros are not accepted. Biased towards matching more.
intRangeHex :: RE Char a -> (Int, Int) -> RE Char Int
intRangeHex :: forall a. RE Char a -> (Int, Int) -> RE Char Int
intRangeHex RE Char a
sep (Int, Int)
lh =
  RE Char ()
-> RE Char ()
-> ((Word, Word) -> RE Char Word)
-> (Int, Int)
-> RE Char Int
forall c minus plus.
RE c minus
-> RE c plus
-> ((Word, Word) -> RE c Word)
-> (Int, Int)
-> RE c Int
RNum.mkSignedIntRange RE Char ()
minus RE Char ()
plus ((RE Char a
sep RE Char a -> RE Char Word -> RE Char Word
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (RE Char Word -> RE Char Word)
-> ((Word, Word) -> RE Char Word) -> (Word, Word) -> RE Char Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word, Word) -> RE Char Word
wordRangeHex) (Int, Int)
lh

-- | Parse a @Word@ of exactly n decimal digits, including any leading zeros.
-- Will not parse values that do not fit in a @Word@.
-- Biased towards matching more.
wordDecN :: Int -> RE Char Word
wordDecN :: Int -> RE Char Word
wordDecN Int
n = (Word -> Word -> RE Char Word) -> Int -> RE Char Word
forall c. (Word -> Word -> RE c Word) -> Int -> RE c Word
RNum.mkWordDecN Word -> Word -> RE Char Word
digitRange Int
n

-- | Parse a @Word@ of exactly n hexadecimal digits, including any leading
-- zeros. Both uppercase @\'A\'..\'F\'@ and lowercase @\'a\'..\'f\'@ are
-- accepted. Will not parse values that do not fit in a @Word@.
-- Biased towards matching more.
wordHexN :: Int -> RE Char Word
wordHexN :: Int -> RE Char Word
wordHexN Int
n = (Word -> Word -> RE Char Word) -> Int -> RE Char Word
forall c. (Word -> Word -> RE c Word) -> Int -> RE c Word
RNum.mkWordHexN Word -> Word -> RE Char Word
hexDigitRange Int
n

minus, plus :: RE Char ()
minus :: RE Char ()
minus = (Char -> Maybe ()) -> RE Char ()
forall c a. (c -> Maybe a) -> RE c a
R.token ((Char -> Maybe ()) -> RE Char ())
-> (Char -> Maybe ()) -> RE Char ()
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing
plus :: RE Char ()
plus = (Char -> Maybe ()) -> RE Char ()
forall c a. (c -> Maybe a) -> RE c a
R.token ((Char -> Maybe ()) -> RE Char ())
-> (Char -> Maybe ()) -> RE Char ()
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing

-- l and h must be in [0..9]
digitRange :: Word -> Word -> RE Char Word
digitRange :: Word -> Word -> RE Char Word
digitRange !Word
l !Word
h = (Char -> Maybe Word) -> RE Char Word
forall c a. (c -> Maybe a) -> RE c a
R.token ((Char -> Maybe Word) -> RE Char Word)
-> (Char -> Maybe Word) -> RE Char Word
forall a b. (a -> b) -> a -> b
$ \Char
c ->
  let d :: Word
d = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
  in if Word
l Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
d Bool -> Bool -> Bool
&& Word
d Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
h then Word -> Maybe Word
forall a. a -> Maybe a
Just Word
d else Maybe Word
forall a. Maybe a
Nothing

-- l and h must be in [0..15]
hexDigitRange :: Word -> Word -> RE Char Word
hexDigitRange :: Word -> Word -> RE Char Word
hexDigitRange !Word
l !Word
h = (Char -> Maybe Word) -> RE Char Word
forall c a. (c -> Maybe a) -> RE c a
R.token ((Char -> Maybe Word) -> RE Char Word)
-> (Char -> Maybe Word) -> RE Char Word
forall a b. (a -> b) -> a -> b
$ \Char
c ->
  let dec :: Word
dec = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
      hexl :: Word
hexl = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
      hexu :: Word
hexu = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A')
  in do
    d <- case () of
      ()
_ | Word
dec Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
9 -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
dec
        | Word
hexl Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
5 -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$! Word
10 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
hexl
        | Word
hexu Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
5 -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$! Word
10 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
hexu
        | Bool
otherwise -> Maybe Word
forall a. Maybe a
Nothing
    if l <= d && d <= h then Just d else Nothing

----------------
-- Match stuff
----------------

-- | Rebuild the @RE@ such that the result is the matched section of the list
-- instead.
toMatch :: RE c a -> RE c [c]
toMatch :: forall c a. RE c a -> RE c [c]
toMatch = (DList c -> [c]) -> RE c (DList c) -> RE c [c]
forall a b. (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList c -> [c]
forall a. DList a -> [a]
dToL (RE c (DList c) -> RE c [c])
-> (RE c a -> RE c (DList c)) -> RE c a -> RE c [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c a -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_

toMatch_ :: RE c b -> RE c (DList c)
toMatch_ :: forall c b. RE c b -> RE c (DList c)
toMatch_ RE c b
re = case RE c b
re of
  RToken c -> Maybe b
t -> (c -> Maybe (DList c)) -> RE c (DList c)
forall c a. (c -> Maybe a) -> RE c a
RToken (\c
c -> c -> DList c
forall a. a -> DList a
singletonD c
c DList c -> Maybe b -> Maybe (DList c)
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ c -> Maybe b
t c
c)
  RFmap Strictness
_ a1 -> b
_ RE c a1
re1 -> RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1
  RFmap_ b
_ RE c a1
re1 -> RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1
  RPure b
_ -> DList c -> RE c (DList c)
forall a c. a -> RE c a
RPure DList c
forall a. Monoid a => a
mempty
  RLiftA2 Strictness
_ a1 -> a2 -> b
_ RE c a1
re1 RE c a2
re2 -> Strictness
-> (DList c -> DList c -> DList c)
-> RE c (DList c)
-> RE c (DList c)
-> RE c (DList c)
forall a1 a2 a c.
Strictness -> (a1 -> a2 -> a) -> RE c a1 -> RE c a2 -> RE c a
RLiftA2 Strictness
Strict DList c -> DList c -> DList c
forall a. Semigroup a => a -> a -> a
(<>) (RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1) (RE c a2 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a2
re2)
  RE c b
REmpty -> RE c (DList c)
forall c a. RE c a
REmpty
  RAlt RE c b
re1 RE c b
re2 -> RE c (DList c) -> RE c (DList c) -> RE c (DList c)
forall c a. RE c a -> RE c a -> RE c a
RAlt (RE c b -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c b
re1) (RE c b -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c b
re2)
  RMany a1 -> b
_ a2 -> b
_ a2 -> a1 -> a2
_ a2
_ RE c a1
re1 -> Strictness
-> Greediness
-> (DList c -> DList c -> DList c)
-> DList c
-> RE c (DList c)
-> RE c (DList c)
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
Strict Greediness
Greedy DList c -> DList c -> DList c
forall a. Semigroup a => a -> a -> a
(<>) DList c
forall a. Monoid a => a
mempty (RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1)
  RFold Strictness
_ Greediness
gr b -> a1 -> b
_ b
_ RE c a1
re1 -> Strictness
-> Greediness
-> (DList c -> DList c -> DList c)
-> DList c
-> RE c (DList c)
-> RE c (DList c)
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
Strict Greediness
gr DList c -> DList c -> DList c
forall a. Semigroup a => a -> a -> a
(<>) DList c
forall a. Monoid a => a
mempty (RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1)

data WithMatch c a = WM !(DList c) a

instance Functor (WithMatch c) where
  fmap :: forall a b. (a -> b) -> WithMatch c a -> WithMatch c b
fmap a -> b
f (WM DList c
t a
x) = DList c -> b -> WithMatch c b
forall c a. DList c -> a -> WithMatch c a
WM DList c
t (a -> b
f a
x)

fmapWM' :: (a -> b) -> WithMatch c a -> WithMatch c b
fmapWM' :: forall a b c. (a -> b) -> WithMatch c a -> WithMatch c b
fmapWM' a -> b
f (WM DList c
t a
x) = DList c -> b -> WithMatch c b
forall c a. DList c -> a -> WithMatch c a
WM DList c
t (b -> WithMatch c b) -> b -> WithMatch c b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
x

instance Applicative (WithMatch c) where
  pure :: forall a. a -> WithMatch c a
pure = DList c -> a -> WithMatch c a
forall c a. DList c -> a -> WithMatch c a
WM DList c
forall a. Monoid a => a
mempty
  liftA2 :: forall a b c.
(a -> b -> c) -> WithMatch c a -> WithMatch c b -> WithMatch c c
liftA2 a -> b -> c
f (WM DList c
t1 a
x) (WM DList c
t2 b
y) = DList c -> c -> WithMatch c c
forall c a. DList c -> a -> WithMatch c a
WM (DList c
t1 DList c -> DList c -> DList c
forall a. Semigroup a => a -> a -> a
<> DList c
t2) (a -> b -> c
f a
x b
y)

liftA2WM' :: (a1 -> a2 -> b) -> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
liftA2WM' :: forall a1 a2 b c.
(a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
liftA2WM' a1 -> a2 -> b
f (WM DList c
t1 a1
x) (WM DList c
t2 a2
y) = DList c -> b -> WithMatch c b
forall c a. DList c -> a -> WithMatch c a
WM (DList c
t1 DList c -> DList c -> DList c
forall a. Semigroup a => a -> a -> a
<> DList c
t2) (b -> WithMatch c b) -> b -> WithMatch c b
forall a b. (a -> b) -> a -> b
$! a1 -> a2 -> b
f a1
x a2
y

-- | Rebuild the @RE@ to include the matched section of the list alongside the
-- result.
withMatch :: RE c a -> RE c ([c], a)
withMatch :: forall c a. RE c a -> RE c ([c], a)
withMatch = (WithMatch c a -> ([c], a))
-> RE c (WithMatch c a) -> RE c ([c], a)
forall a b c. (a -> b) -> RE c a -> RE c b
R.fmap' (\(WM DList c
cs a
x) -> (DList c -> [c]
forall a. DList a -> [a]
dToL DList c
cs, a
x)) (RE c (WithMatch c a) -> RE c ([c], a))
-> (RE c a -> RE c (WithMatch c a)) -> RE c a -> RE c ([c], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c a -> RE c (WithMatch c a)
forall c b. RE c b -> RE c (WithMatch c b)
go
  where
    go :: RE c b -> RE c (WithMatch c b)
    go :: forall c b. RE c b -> RE c (WithMatch c b)
go RE c b
re = case RE c b
re of
      RToken c -> Maybe b
t -> (c -> Maybe (WithMatch c b)) -> RE c (WithMatch c b)
forall c a. (c -> Maybe a) -> RE c a
RToken (\c
c -> DList c -> b -> WithMatch c b
forall c a. DList c -> a -> WithMatch c a
WM (c -> DList c
forall a. a -> DList a
singletonD c
c) (b -> WithMatch c b) -> Maybe b -> Maybe (WithMatch c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> Maybe b
t c
c)
      RFmap Strictness
st a1 -> b
f RE c a1
re1 ->
        let g :: WithMatch c a1 -> WithMatch c b
g = case Strictness
st of
              Strictness
Strict -> (a1 -> b) -> WithMatch c a1 -> WithMatch c b
forall a b c. (a -> b) -> WithMatch c a -> WithMatch c b
fmapWM' a1 -> b
f
              Strictness
NonStrict -> (a1 -> b) -> WithMatch c a1 -> WithMatch c b
forall a b. (a -> b) -> WithMatch c a -> WithMatch c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> b
f
        in Strictness
-> (WithMatch c a1 -> WithMatch c b)
-> RE c (WithMatch c a1)
-> RE c (WithMatch c b)
forall a1 a c. Strictness -> (a1 -> a) -> RE c a1 -> RE c a
RFmap Strictness
Strict WithMatch c a1 -> WithMatch c b
forall {c}. WithMatch c a1 -> WithMatch c b
g (RE c a1 -> RE c (WithMatch c a1)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c a1
re1)
      RFmap_ b
b RE c a1
re1 -> Strictness
-> (DList c -> WithMatch c b)
-> RE c (DList c)
-> RE c (WithMatch c b)
forall a1 a c. Strictness -> (a1 -> a) -> RE c a1 -> RE c a
RFmap Strictness
Strict ((DList c -> b -> WithMatch c b) -> b -> DList c -> WithMatch c b
forall a b c. (a -> b -> c) -> b -> a -> c
flip DList c -> b -> WithMatch c b
forall c a. DList c -> a -> WithMatch c a
WM b
b) (RE c a1 -> RE c (DList c)
forall c b. RE c b -> RE c (DList c)
toMatch_ RE c a1
re1)
      RPure b
b -> WithMatch c b -> RE c (WithMatch c b)
forall a c. a -> RE c a
RPure (b -> WithMatch c b
forall a. a -> WithMatch c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b)
      RLiftA2 Strictness
st a1 -> a2 -> b
f RE c a1
re1 RE c a2
re2 ->
        let g :: WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
g = case Strictness
st of
              Strictness
Strict -> (a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
forall a1 a2 b c.
(a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
liftA2WM' a1 -> a2 -> b
f
              Strictness
NonStrict -> (a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
forall a b c.
(a -> b -> c) -> WithMatch c a -> WithMatch c b -> WithMatch c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a1 -> a2 -> b
f
        in Strictness
-> (WithMatch c a1 -> WithMatch c a2 -> WithMatch c b)
-> RE c (WithMatch c a1)
-> RE c (WithMatch c a2)
-> RE c (WithMatch c b)
forall a1 a2 a c.
Strictness -> (a1 -> a2 -> a) -> RE c a1 -> RE c a2 -> RE c a
RLiftA2 Strictness
Strict WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
forall {c}. WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
g (RE c a1 -> RE c (WithMatch c a1)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c a1
re1) (RE c a2 -> RE c (WithMatch c a2)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c a2
re2)
      RE c b
REmpty -> RE c (WithMatch c b)
forall c a. RE c a
REmpty
      RAlt RE c b
re1 RE c b
re2 -> RE c (WithMatch c b)
-> RE c (WithMatch c b) -> RE c (WithMatch c b)
forall c a. RE c a -> RE c a -> RE c a
RAlt (RE c b -> RE c (WithMatch c b)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c b
re1) (RE c b -> RE c (WithMatch c b)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c b
re2)
      RMany a1 -> b
f1 a2 -> b
f2 a2 -> a1 -> a2
f a2
z RE c a1
re1 ->
        (WithMatch c a1 -> WithMatch c b)
-> (WithMatch c a2 -> WithMatch c b)
-> (WithMatch c a2 -> WithMatch c a1 -> WithMatch c a2)
-> WithMatch c a2
-> RE c (WithMatch c a1)
-> RE c (WithMatch c b)
forall a1 a a2 c.
(a1 -> a)
-> (a2 -> a) -> (a2 -> a1 -> a2) -> a2 -> RE c a1 -> RE c a
RMany ((a1 -> b) -> WithMatch c a1 -> WithMatch c b
forall a b c. (a -> b) -> WithMatch c a -> WithMatch c b
fmapWM' a1 -> b
f1) ((a2 -> b) -> WithMatch c a2 -> WithMatch c b
forall a b c. (a -> b) -> WithMatch c a -> WithMatch c b
fmapWM' a2 -> b
f2) ((a2 -> a1 -> a2)
-> WithMatch c a2 -> WithMatch c a1 -> WithMatch c a2
forall a1 a2 b c.
(a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
liftA2WM' a2 -> a1 -> a2
f) (a2 -> WithMatch c a2
forall a. a -> WithMatch c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a2
z) (RE c a1 -> RE c (WithMatch c a1)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c a1
re1)
      RFold Strictness
st Greediness
gr b -> a1 -> b
f b
z RE c a1
re1 ->
        let g :: WithMatch c b -> WithMatch c a1 -> WithMatch c b
g = case Strictness
st of
              Strictness
Strict -> (b -> a1 -> b) -> WithMatch c b -> WithMatch c a1 -> WithMatch c b
forall a1 a2 b c.
(a1 -> a2 -> b)
-> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
liftA2WM' b -> a1 -> b
f
              Strictness
NonStrict -> (b -> a1 -> b) -> WithMatch c b -> WithMatch c a1 -> WithMatch c b
forall a b c.
(a -> b -> c) -> WithMatch c a -> WithMatch c b -> WithMatch c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> a1 -> b
f
        in Strictness
-> Greediness
-> (WithMatch c b -> WithMatch c a1 -> WithMatch c b)
-> WithMatch c b
-> RE c (WithMatch c a1)
-> RE c (WithMatch c b)
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
Strict Greediness
gr WithMatch c b -> WithMatch c a1 -> WithMatch c b
forall {c}. WithMatch c b -> WithMatch c a1 -> WithMatch c b
g (b -> WithMatch c b
forall a. a -> WithMatch c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
z) (RE c a1 -> RE c (WithMatch c a1)
forall c b. RE c b -> RE c (WithMatch c b)
go RE c a1
re1)

----------
-- Parse
----------

-- | \(O(mn \log m)\). Parse a list with a @RE@.
--
-- Parses the entire list, not just a prefix or a substring.
-- Returns early without demanding the entire list on parse failure.
--
-- Uses 'Regex.List.compile', see the note there.
--
-- If parsing multiple lists using the same @RE@, it is wasteful to compile
-- the @RE@ every time. So, prefer to
--
-- * Compile once with 'Regex.List.compile' or 'Regex.List.compileBounded' and
--   use the compiled 'Parser'  with 'parse' as many times as required.
-- * Alternately, partially apply this function to a @RE@ and use the function
--   as many times as required.
reParse :: RE c a -> [c] -> Maybe a
reParse :: forall c a. RE c a -> [c] -> Maybe a
reParse RE c a
re = let !p :: Parser c a
p = RE c a -> Parser c a
forall c a. RE c a -> Parser c a
P.compile RE c a
re in Parser c a -> [c] -> Maybe a
forall c a. Parser c a -> [c] -> Maybe a
parse Parser c a
p
{-# INLINE reParse #-}

-- | \(O(mn \log m)\). Parse a list with a @Parser@.
--
-- Parses the entire list, not just a prefix or a substring.
-- Returns early without demanding the entire list on parse failure.
parse :: Parser c a -> [c] -> Maybe a
parse :: forall c a. Parser c a -> [c] -> Maybe a
parse = Foldr [c] c -> Parser c a -> [c] -> Maybe a
forall f c a. Foldr f c -> Parser c a -> f -> Maybe a
P.parseFoldr (c -> b -> b) -> b -> [c] -> b
Foldr [c] c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
{-# INLINE parse #-}

-- | \(O(mn \log m)\). Parse a list with a @Parser@. Calls 'error' on
-- parse failure.
--
-- For use with parsers that are known to never fail.
--
-- Parses the entire list, not just a prefix or a substring.
-- Returns early without demanding the entire list on parse failure.
parseSure :: Parser c a -> [c] -> a
parseSure :: forall c a. Parser c a -> [c] -> a
parseSure Parser c a
p = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. a
parseSureError (Maybe a -> a) -> ([c] -> Maybe a) -> [c] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser c a -> [c] -> Maybe a
forall c a. Parser c a -> [c] -> Maybe a
parse Parser c a
p
{-# INLINE parseSure #-}

parseSureError :: a
parseSureError :: forall a. a
parseSureError = String -> a
forall a. String -> a
errorWithoutStackTrace
  String
"Regex.List.parseSure: parse failed; if parsing can fail use 'parse' instead"

reParseSure :: RE c a -> [c] -> a
reParseSure :: forall c a. RE c a -> [c] -> a
reParseSure RE c a
re = let !p :: Parser c a
p = RE c a -> Parser c a
forall c a. RE c a -> Parser c a
P.compile RE c a
re in Parser c a -> [c] -> a
forall c a. Parser c a -> [c] -> a
parseSure Parser c a
p
{-# INLINE reParseSure #-}

-- | \(O(mn \log m)\). Find the first occurence of the given @RE@ in a list.
--
-- ==== __Examples__
--
-- >>> find (list "meow") "homeowner"
-- Just "meow"
--
-- To test whether a list is present in another list, like above, prefer
-- @Data.List.'Data.List.isInfixOf'@.
--
-- >>> find (stringIgnoreCase "haskell") "Look I'm Haskelling!"
-- Just "Haskell"
-- >>> find (list "backtracking") "parser-regex"
-- Nothing
--
find :: RE c a -> [c] -> Maybe a
find :: forall c a. RE c a -> [c] -> Maybe a
find = RE c a -> [c] -> Maybe a
forall c a. RE c a -> [c] -> Maybe a
reParse (RE c a -> [c] -> Maybe a)
-> (RE c a -> RE c a) -> RE c a -> [c] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c a -> RE c a
forall c a. RE c a -> RE c a
R.toFind
{-# INLINE find #-}

-- | \(O(mn \log m)\). Find all non-overlapping occurences of the given @RE@ in
-- the list.
--
-- ==== __Examples__
--
-- >>> findAll (list "ana") "banananana"
-- ["ana","ana"]
--
-- @
-- data Roll = Roll
--   Natural -- ^ Rolls
--   Natural -- ^ Faces on the die
--   deriving Show
--
-- roll :: RE Char Roll
-- roll = Roll \<$> ('naturalDec' \<|> pure 1) \<* 'R.single' \'d\' \<*> naturalDec
-- @
--
-- >>> findAll roll "3d6, d10, 2d10"
-- [Roll 3 6,Roll 1 10,Roll 2 10]
--
findAll :: RE c a -> [c] -> [a]
findAll :: forall c a. RE c a -> [c] -> [a]
findAll = RE c [a] -> [c] -> [a]
forall c a. RE c a -> [c] -> a
reParseSure (RE c [a] -> [c] -> [a])
-> (RE c a -> RE c [a]) -> RE c a -> [c] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c a -> RE c [a]
forall c a. RE c a -> RE c [a]
R.toFindMany
{-# INLINE findAll #-}

-- | \(O(mn \log m)\). Split a list at occurences of the given @RE@.
--
-- ==== __Examples__
--
-- >>> splitOn (single ' ') "Glasses are really versatile"
-- ["Glasses","are","really","versatile"]
--
-- In cases like above, prefer using 'words' or 'lines' instead, if
-- applicable.
--
-- >>> splitOn (single ' ' *> oneOfChar "+-=" *> single ' ') "3 - 1 + 1/2 - 2 = 0"
-- ["3","1","1/2","2","0"]
--
-- If the list starts or ends with a delimiter, the result will contain
-- empty lists at those positions.
--
-- >>> splitOn (single 'a') "ayaya"
-- ["","y","y",""]
--
splitOn :: RE c a -> [c] -> [[c]]
splitOn :: forall c a. RE c a -> [c] -> [[c]]
splitOn = RE c [[c]] -> [c] -> [[c]]
forall c a. RE c a -> [c] -> a
reParseSure (RE c [[c]] -> [c] -> [[c]])
-> (RE c a -> RE c [[c]]) -> RE c a -> [c] -> [[c]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c a -> RE c [[c]]
forall c a. RE c a -> RE c [[c]]
toSplitOn
{-# INLINE splitOn #-}

toSplitOn :: RE c a -> RE c [[c]]
toSplitOn :: forall c a. RE c a -> RE c [[c]]
toSplitOn RE c a
re = RE c [c]
forall c. RE c [c]
manyListMin RE c [c] -> RE c a -> RE c [[c]]
forall c a sep. RE c a -> RE c sep -> RE c [a]
`R.sepBy` RE c a
re

-- | \(O(mn \log m)\). Replace the first match of the given @RE@ with its
-- result. If there is no match, the result is @Nothing@.
--
-- ==== __Examples__
--
-- >>> replace ("world" <$ list "Haskell") "Hello, Haskell!"
-- Just "Hello, world!"
--
-- >>> replace ("," <$ some (single '.')) "one...two...ten"
-- Just "one,two...ten"
--
replace :: RE c [c] -> [c] -> Maybe [c]
replace :: forall c. RE c [c] -> [c] -> Maybe [c]
replace = RE c [c] -> [c] -> Maybe [c]
forall c a. RE c a -> [c] -> Maybe a
reParse (RE c [c] -> [c] -> Maybe [c])
-> (RE c [c] -> RE c [c]) -> RE c [c] -> [c] -> Maybe [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c [c] -> RE c [c]
forall c. RE c [c] -> RE c [c]
toReplace
{-# INLINE replace #-}

toReplace :: RE c [c] -> RE c [c]
toReplace :: forall c. RE c [c] -> RE c [c]
toReplace RE c [c]
re = ([c] -> [c] -> [c] -> [c])
-> RE c [c] -> RE c [c] -> RE c ([c] -> [c])
forall a b c. (a -> b -> c) -> RE c a -> RE c b -> RE c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [c] -> [c] -> [c] -> [c]
forall {a}. [a] -> [a] -> [a] -> [a]
f RE c [c]
forall c. RE c [c]
manyListMin RE c [c]
re RE c ([c] -> [c]) -> RE c [c] -> RE c [c]
forall a b. RE c (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE c [c]
forall c. RE c [c]
manyList
  where
    f :: [a] -> [a] -> [a] -> [a]
f [a]
a [a]
b [a]
c = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]
a,[a]
b,[a]
c]

-- | \(O(mn \log m)\). Replace all non-overlapping matches of the given @RE@
-- with their results.
--
-- ==== __Examples__
--
-- >>> replaceAll (" and " <$ list ", ") "red, blue, green"
-- "red and blue and green"
--
-- >>> replaceAll ("Fruit" <$ list "Time" <|> "a banana" <$ list "an arrow") "Time flies like an arrow"
-- "Fruit flies like a banana"
--
-- @
-- sep = 'oneOfChar' "-./"
-- digits n = 'Control.Monad.replicateM' n (oneOfChar 'Data.CharSet.digit')
-- toYmd d m y = concat [y, \"-\", m, \"-\", d]
-- date = toYmd \<$> digits 2 \<* sep
--              \<*> digits 2 \<* sep
--              \<*> digits 4
-- @
-- >>> replaceAll date "01/01/1970, 01-04-1990, 03.07.2011"
-- "1970-01-01, 1990-04-01, 2011-07-03"
--
replaceAll :: RE c [c] -> [c] -> [c]
replaceAll :: forall c. RE c [c] -> [c] -> [c]
replaceAll = RE c [c] -> [c] -> [c]
forall c a. RE c a -> [c] -> a
reParseSure (RE c [c] -> [c] -> [c])
-> (RE c [c] -> RE c [c]) -> RE c [c] -> [c] -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c [c] -> RE c [c]
forall c. RE c [c] -> RE c [c]
toReplaceMany
{-# INLINE replaceAll #-}

toReplaceMany :: RE c [c] -> RE c [c]
toReplaceMany :: forall c. RE c [c] -> RE c [c]
toReplaceMany RE c [c]
re = [[c]] -> [c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[c]] -> [c]) -> RE c [[c]] -> RE c [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE c [c] -> RE c [[c]]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (RE c [c]
re RE c [c] -> RE c [c] -> RE c [c]
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (c -> Maybe [c]) -> RE c [c]
forall c a. (c -> Maybe a) -> RE c a
R.token ([c] -> Maybe [c]
forall a. a -> Maybe a
Just ([c] -> Maybe [c]) -> (c -> [c]) -> c -> Maybe [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[])))

---------------------
-- Difference lists
---------------------

newtype DList a = DList { forall a. DList a -> [a] -> [a]
unDList :: [a] -> [a] }

instance Semigroup (DList a) where
  DList a
xs <> :: DList a -> DList a -> DList a
<> DList a
ys = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDList DList a
xs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDList DList a
ys)

instance Monoid (DList a) where
  mempty :: DList a
mempty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id

singletonD :: a -> DList a
singletonD :: forall a. a -> DList a
singletonD = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)

dToL :: DList a -> [a]
dToL :: forall a. DList a -> [a]
dToL = (([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ []) (([a] -> [a]) -> [a]) -> (DList a -> [a] -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDList

----------
-- Notes
----------

-- Note [Token for Regex.List]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Regex.Text uses a token TextToken, but Regex.List doesn't, why?
--
-- TextToken is used for efficient slicing, but here a DList is used for that
-- purpose. This has the effect that combinators like manyText and friends
-- don't need to allocate a linear amount of memory, since slicing is free, but
-- manyList and friends do. We could use a token type for list like
--
-- data Take a = Take !Int ![a]
--
-- to refer to the input list and save memory.
--
-- This is not done because
-- * It increases complexity. Currently this module offers the simplest possible
--   application of RE, which is nice to have.
-- * If the list does not already exist in memory, Take would keep the entire
--   list alive in memory instead of the just the slice it needs.
-- * The current implementation is a good consumer, which can fuse with a good
--   producer of the input list.
--
-- In the end it is about the two distinct use cases of lists in Haskell:
-- * As a structure in memory, the Take token would be the better choice
-- * As a stream of elements, the current implementation is the better choice