{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Regex.Internal.Regex
  ( RE(..)
  , Strictness(..)
  , Greediness(..)
  , Many(..)

  , token
  , anySingle
  , single
  , satisfy

  , foldlMany
  , foldlManyMin
  , manyr
  , optionalMin
  , someMin
  , manyMin
  , atLeast
  , atMost
  , betweenCount
  , atLeastMin
  , atMostMin
  , betweenCountMin
  , sepBy
  , sepBy1
  , endBy
  , endBy1
  , sepEndBy
  , sepEndBy1
  , chainl1
  , chainr1
  , toFind
  , toFindMany

  , fmap'
  , liftA2'
  , foldlMany'
  , foldlManyMin'
  ) where

import Control.Applicative
import Control.DeepSeq (NFData(..), NFData1(..), rnf1)
import Control.Monad
import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), showsUnaryWith)
import Data.Semigroup (Semigroup(..))
import qualified Data.Foldable as F

---------------------------------
-- RE and constructor functions
---------------------------------

-- | A regular expression. Operates on a sequence of elements of type @c@ and
-- capable of parsing into an @a@.
--
-- A @RE@ is a Functor, Applicative, and Alternative.
--
-- * 'pure': Succeed without consuming input.
-- * 'liftA2', '<*>', '*>', '<*': Sequential composition.
-- * 'empty': Fail.
-- * '<|>': Alternative composition. Left-biased, i.e. the result of parsing
--   using @a \<|> b@ is the result of parsing using @a@ if it succeeds,
--   otherwise it is the result of parsing using @b@ if it succeeds,
--   otherwise parsing fails.
-- * 'many': Zero or more. @many a@ parses multiple @a@s sequentially. Biased
--   towards matching more. Use 'manyMin' for a bias towards matching less.
--   Also see the section "Looping parsers".
-- * 'some': One or more. @some a@ parses multiple @a@s sequentially. Biased
--   towards matching more. Use 'someMin' for a bias towards matching less.
--
-- In addition to expected Functor, Applicative, and Alternative laws,
-- @RE@ obeys these Applicative-Alternative laws:
--
-- @
-- a \<*> empty = empty
-- empty \<*> a = empty
-- (a \<|> b) \<*> c = (a \<*> c) \<|> (b \<*> c)
-- a \<*> (b \<|> c) = (a \<*> b) \<|> (a \<*> c)
-- @
--
-- Note that, because of bias, it is /not true/ that @a \<|> b = b \<|> a@.
--
-- /Performance note/: Prefer the smaller of equivalent regexes, i.e. prefer
-- @(a \<|> b) \<*> c@ over @(a \<*> c) \<|> (b \<*> c)@.
--
data RE c a where
  RToken  :: !(c -> Maybe a) -> RE c a
  RFmap   :: !Strictness -> !(a1 -> a) -> !(RE c a1) -> RE c a
  RFmap_  :: a -> !(RE c a1) -> RE c a
  RPure   :: a -> RE c a
  RLiftA2 :: !Strictness -> !(a1 -> a2 -> a) -> !(RE c a1) -> !(RE c a2) -> RE c a
  REmpty  :: RE c a
  RAlt    :: !(RE c a) -> !(RE c a) -> (RE c a)
  RFold   :: !Strictness -> !Greediness -> !(a -> a1 -> a) -> a -> !(RE c a1) -> RE c a
  RMany   :: !(a1 -> a) -> !(a2 -> a) -> !(a2 -> a1 -> a2) -> !a2 -> !(RE c a1) -> RE c a -- Strict and greedy implicitly

data Strictness = Strict | NonStrict
data Greediness = Greedy | Minimal

instance Functor (RE c) where
  fmap :: forall a b. (a -> b) -> RE c a -> RE c b
fmap = Strictness -> (a -> b) -> RE c a -> RE c b
forall a1 a c. Strictness -> (a1 -> a) -> RE c a1 -> RE c a
RFmap Strictness
NonStrict
  <$ :: forall a b. a -> RE c b -> RE c a
(<$) = a -> RE c b -> RE c a
forall a c a1. a -> RE c a1 -> RE c a
RFmap_

fmap' :: (a -> b) -> RE c a -> RE c b
fmap' :: forall a b c. (a -> b) -> RE c a -> RE c b
fmap' = Strictness -> (a -> b) -> RE c a -> RE c b
forall a1 a c. Strictness -> (a1 -> a) -> RE c a1 -> RE c a
RFmap Strictness
Strict

instance Applicative (RE c) where
  pure :: forall a. a -> RE c a
pure = a -> RE c a
forall a c. a -> RE c a
RPure
  liftA2 :: forall a b c. (a -> b -> c) -> RE c a -> RE c b -> RE c c
liftA2 = Strictness -> (a -> b -> c) -> RE c a -> RE c b -> RE c c
forall a1 a2 a c.
Strictness -> (a1 -> a2 -> a) -> RE c a1 -> RE c a2 -> RE c a
RLiftA2 Strictness
NonStrict
  RE c a
re1 *> :: forall a b. RE c a -> RE c b -> RE c b
*> RE c b
re2 = (() -> b -> b) -> RE c () -> RE c b -> RE c b
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 ((b -> b) -> () -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id) (RE c a -> RE c ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void RE c a
re1) RE c b
re2
  RE c a
re1 <* :: forall a b. RE c a -> RE c b -> RE c a
<* RE c b
re2 = (a -> () -> a) -> RE c a -> RE c () -> RE c a
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 a -> () -> a
forall a b. a -> b -> a
const RE c a
re1 (RE c b -> RE c ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void RE c b
re2)

liftA2' :: (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' :: forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' = Strictness -> (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
forall a1 a2 a c.
Strictness -> (a1 -> a2 -> a) -> RE c a1 -> RE c a2 -> RE c a
RLiftA2 Strictness
Strict

instance Alternative (RE c) where
  empty :: forall a. RE c a
empty = RE c a
forall c a. RE c a
REmpty
  <|> :: forall a. RE c a -> RE c a -> RE c a
(<|>) = RE c a -> RE c a -> RE c a
forall c a. RE c a -> RE c a -> RE c a
RAlt
  some :: forall a. RE c a -> RE c [a]
some RE c a
re = (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE c a
re)
  many :: forall a. RE c a -> RE c [a]
many = ([a] -> [a]) -> RE c [a] -> RE c [a]
forall a b. (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (RE c [a] -> RE c [a])
-> (RE c a -> RE c [a]) -> RE c a -> RE c [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> RE c a -> RE c [a]
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- | @(<>) = liftA2 (<>)@
instance Semigroup a => Semigroup (RE c a) where
  <> :: RE c a -> RE c a -> RE c a
(<>) = (a -> a -> a) -> RE c a -> RE c a -> RE c a
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 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
  sconcat :: NonEmpty (RE c a) -> RE c a
sconcat = (NonEmpty a -> a) -> RE c (NonEmpty a) -> RE c a
forall a b. (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> a
forall a. Semigroup a => NonEmpty a -> a
sconcat (RE c (NonEmpty a) -> RE c a)
-> (NonEmpty (RE c a) -> RE c (NonEmpty a))
-> NonEmpty (RE c a)
-> RE c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (RE c a) -> RE c (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
NonEmpty (f a) -> f (NonEmpty a)
sequenceA
  {-# INLINE sconcat #-}

-- | @mempty = pure mempty@
instance Monoid a => Monoid (RE c a) where
  mempty :: RE c a
mempty = a -> RE c a
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mconcat :: [RE c a] -> RE c a
mconcat = ([a] -> a) -> RE c [a] -> RE c a
forall a b. (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (RE c [a] -> RE c a)
-> ([RE c a] -> RE c [a]) -> [RE c a] -> RE c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RE c a] -> RE c [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
  {-# INLINE mconcat #-}
-- Use the underlying type's sconcat/mconcat because it may be more efficient
-- than the default right-associative definition.
-- stimes is not defined here since there is no way to delegate to the stimes
-- of a.

-- | Parse a @c@ into an @a@ if the given function returns @Just@.
token :: (c -> Maybe a) -> RE c a
token :: forall c a. (c -> Maybe a) -> RE c a
token = (c -> Maybe a) -> RE c a
forall c a. (c -> Maybe a) -> RE c a
RToken

-- | Zero or more. Biased towards matching more.
--
-- Also see the section "Looping parsers".
manyr :: RE c a -> RE c (Many a)
manyr :: forall c a. RE c a -> RE c (Many a)
manyr = (a -> Many a)
-> ([a] -> Many a)
-> ([a] -> a -> [a])
-> [a]
-> RE c a
-> RE c (Many a)
forall a1 a a2 c.
(a1 -> a)
-> (a2 -> a) -> (a2 -> a1 -> a2) -> a2 -> RE c a1 -> RE c a
RMany a -> Many a
forall a. a -> Many a
Repeat ([a] -> Many a
forall a. [a] -> Many a
Finite ([a] -> Many a) -> ([a] -> [a]) -> [a] -> Many a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse) ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- | Parse many occurences of the given @RE@. Biased towards matching more.
--
-- Also see the section "Looping parsers".
foldlMany :: (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany :: forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany = Strictness -> Greediness -> (b -> a -> b) -> b -> RE c a -> RE c b
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
NonStrict Greediness
Greedy

foldlMany' :: (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany' :: forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany' b -> a -> b
f !b
z = Strictness -> Greediness -> (b -> a -> b) -> b -> RE c a -> RE c b
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
Strict Greediness
Greedy b -> a -> b
f b
z

-- | Parse many occurences of the given @RE@. Minimal, i.e. biased towards
-- matching less.
foldlManyMin :: (b -> a -> b) -> b -> RE c a -> RE c b
foldlManyMin :: forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlManyMin = Strictness -> Greediness -> (b -> a -> b) -> b -> RE c a -> RE c b
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
NonStrict Greediness
Minimal

foldlManyMin' :: (b -> a -> b) -> b -> RE c a -> RE c b
foldlManyMin' :: forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlManyMin' b -> a -> b
f !b
z = Strictness -> Greediness -> (b -> a -> b) -> b -> RE c a -> RE c b
forall a a1 c.
Strictness
-> Greediness -> (a -> a1 -> a) -> a -> RE c a1 -> RE c a
RFold Strictness
Strict Greediness
Minimal b -> a -> b
f b
z

-- | Parse a @c@ if it satisfies the given predicate.
satisfy :: (c -> Bool) -> RE c c
satisfy :: forall c. (c -> Bool) -> RE c c
satisfy c -> Bool
p = (c -> Maybe c) -> RE c c
forall c a. (c -> Maybe a) -> RE c a
token (\c
c -> if c -> Bool
p c
c then c -> Maybe c
forall a. a -> Maybe a
Just c
c else Maybe c
forall a. Maybe a
Nothing)
{-# INLINE satisfy #-}

-- | Parse the given @c@.
single :: Eq c => c -> RE c c
single :: forall c. Eq c => c -> RE c c
single !c
c = (c -> Bool) -> RE c c
forall c. (c -> Bool) -> RE c c
satisfy (c
cc -> c -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Parse any @c@.
anySingle :: RE c c
anySingle :: forall c. RE c c
anySingle = (c -> Maybe c) -> RE c c
forall c a. (c -> Maybe a) -> RE c a
token c -> Maybe c
forall a. a -> Maybe a
Just

---------
-- Many
---------

data Many a
  = Repeat a   -- ^ A single value repeating indefinitely
  | Finite [a] -- ^ A finite list
  deriving (Many a -> Many a -> Bool
(Many a -> Many a -> Bool)
-> (Many a -> Many a -> Bool) -> Eq (Many a)
forall a. Eq a => Many a -> Many a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Many a -> Many a -> Bool
== :: Many a -> Many a -> Bool
$c/= :: forall a. Eq a => Many a -> Many a -> Bool
/= :: Many a -> Many a -> Bool
Eq, Int -> Many a -> ShowS
[Many a] -> ShowS
Many a -> String
(Int -> Many a -> ShowS)
-> (Many a -> String) -> ([Many a] -> ShowS) -> Show (Many a)
forall a. Show a => Int -> Many a -> ShowS
forall a. Show a => [Many a] -> ShowS
forall a. Show a => Many a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Many a -> ShowS
showsPrec :: Int -> Many a -> ShowS
$cshow :: forall a. Show a => Many a -> String
show :: Many a -> String
$cshowList :: forall a. Show a => [Many a] -> ShowS
showList :: [Many a] -> ShowS
Show)

instance Ord a => Ord (Many a) where
  compare :: Many a -> Many a -> Ordering
compare (Repeat a
x) (Repeat a
y) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y
  compare Many a
xs Many a
ys = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Many a -> [a]
forall a. Many a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Many a
xs) (Many a -> [a]
forall a. Many a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Many a
ys)

instance Eq1 Many where
  liftEq :: forall a b. (a -> b -> Bool) -> Many a -> Many b -> Bool
liftEq a -> b -> Bool
f Many a
m1 Many b
m2 = case (Many a
m1,Many b
m2) of
    (Repeat a
x, Repeat b
y) -> a -> b -> Bool
f a
x b
y
    (Finite [a]
xs, Finite [b]
ys) -> (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f [a]
xs [b]
ys
    (Many a, Many b)
_ -> Bool
False

instance Ord1 Many where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Many a -> Many b -> Ordering
liftCompare a -> b -> Ordering
f Many a
m1 Many b
m2 = case (Many a
m1,Many b
m2) of
    (Repeat a
x, Repeat b
y) -> a -> b -> Ordering
f a
x b
y
    (Many a, Many b)
_ -> (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f (Many a -> [a]
forall a. Many a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Many a
m1) (Many b -> [b]
forall a. Many a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Many b
m2)

instance Show1 Many where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Many a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p Many a
m = case Many a
m of
    Repeat a
x -> (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Repeat" Int
p a
x
    Finite [a]
xs -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"Finite" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
sl [a]
xs

instance Functor Many where
  fmap :: forall a b. (a -> b) -> Many a -> Many b
fmap a -> b
f Many a
m = case Many a
m of
    Repeat a
x -> b -> Many b
forall a. a -> Many a
Repeat (a -> b
f a
x)
    Finite [a]
xs -> [b] -> Many b
forall a. [a] -> Many a
Finite ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)

instance Foldable Many where
  foldr :: forall a b. (a -> b -> b) -> b -> Many a -> b
foldr a -> b -> b
f b
z Many a
m = case Many a
m of
    Repeat a
x -> let r :: b
r = a -> b -> b
f a
x b
r in b
r
    Finite [a]
xs -> (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z [a]
xs

  foldl' :: forall b a. (b -> a -> b) -> b -> Many a -> b
foldl' b -> a -> b
f b
z Many a
m = case Many a
m of
    Repeat a
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"Foldable Many: Repeat: foldl'"
    Finite [a]
xs -> (b -> a -> b) -> b -> [a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f b
z [a]
xs

  foldl :: forall b a. (b -> a -> b) -> b -> Many a -> b
foldl b -> a -> b
f b
z Many a
m = case Many a
m of
    Repeat a
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"Foldable Many: Repeat: foldl"
    Finite [a]
xs -> (b -> a -> b) -> b -> [a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z [a]
xs

  toList :: forall a. Many a -> [a]
toList Many a
m = case Many a
m of
    Repeat a
x -> a -> [a]
forall a. a -> [a]
repeat a
x
    Finite [a]
xs -> [a]
xs

instance NFData a => NFData (Many a) where
  rnf :: Many a -> ()
rnf = Many a -> ()
forall (f :: * -> *) a. (NFData1 f, NFData a) => f a -> ()
rnf1

instance NFData1 Many where
  liftRnf :: forall a. (a -> ()) -> Many a -> ()
liftRnf a -> ()
f Many a
m = case Many a
m of
    Repeat a
x -> a -> ()
f a
x
    Finite [a]
xs -> (a -> ()) -> [a] -> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f [a]
xs

----------------
-- Combinators
----------------

-- | Zero or one. Minimal, i.e. biased towards zero.
--
-- @Use Control.Applicative.'optional'@ for the same but biased towards one.
optionalMin :: RE c a -> RE c (Maybe a)
optionalMin :: forall c a. RE c a -> RE c (Maybe a)
optionalMin RE c a
re = Maybe a -> RE c (Maybe a)
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing RE c (Maybe a) -> RE c (Maybe a) -> RE c (Maybe a)
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> RE c a -> RE c (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE c a
re

-- | One or more. Minimal, i.e. biased towards matching less.
someMin :: RE c a -> RE c [a]
someMin :: forall c a. RE c a -> RE c [a]
someMin RE c a
re = (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (RE c a -> RE c [a]
forall c a. RE c a -> RE c [a]
manyMin RE c a
re)

-- | Zero or more. Minimal, i.e. biased towards matching less.
manyMin :: RE c a -> RE c [a]
manyMin :: forall c a. RE c a -> RE c [a]
manyMin = ([a] -> [a]) -> RE c [a] -> RE c [a]
forall a b. (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (RE c [a] -> RE c [a])
-> (RE c a -> RE c [a]) -> RE c a -> RE c [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> RE c a -> RE c [a]
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlManyMin' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- | At least n times. Biased towards matching more.
atLeast :: Int -> RE c a -> RE c [a]
atLeast :: forall c a. Int -> RE c a -> RE c [a]
atLeast Int
n RE c a
re = Int -> RE c a -> RE c [a] -> RE c [a]
forall c a. Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) RE c a
re (RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE c a
re)

-- | At most n times. Biased towards matching more.
atMost :: Int -> RE c a -> RE c [a]
atMost :: forall c a. Int -> RE c a -> RE c [a]
atMost Int
n = (Int, Int) -> RE c a -> RE c [a]
forall c a. (Int, Int) -> RE c a -> RE c [a]
betweenCount (Int
0,Int
n)

-- | Between m and n times (inclusive). Biased towards matching more.
betweenCount :: (Int, Int) -> RE c a -> RE c [a]
betweenCount :: forall c a. (Int, Int) -> RE c a -> RE c [a]
betweenCount (Int
l,Int
h) RE c a
re
  | Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h = RE c [a]
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
  | Bool
otherwise = Int -> RE c a -> RE c [a] -> RE c [a]
forall c a. Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM Int
l' RE c a
re (Int -> RE c [a]
go (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l'))
  where
    l' :: Int
l' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
0
    go :: Int -> RE c [a]
go Int
0 = [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go Int
n = (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (Int -> RE c [a]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) RE c [a] -> RE c [a] -> RE c [a]
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | At least n times. Minimal, i.e. biased towards matching less.
atLeastMin :: Int -> RE c a -> RE c [a]
atLeastMin :: forall c a. Int -> RE c a -> RE c [a]
atLeastMin Int
n RE c a
re = Int -> RE c a -> RE c [a] -> RE c [a]
forall c a. Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) RE c a
re (RE c a -> RE c [a]
forall c a. RE c a -> RE c [a]
manyMin RE c a
re)

-- | At most n times. Minimal, i.e. biased towards matching less.
atMostMin :: Int -> RE c a -> RE c [a]
atMostMin :: forall c a. Int -> RE c a -> RE c [a]
atMostMin Int
n = (Int, Int) -> RE c a -> RE c [a]
forall c a. (Int, Int) -> RE c a -> RE c [a]
betweenCountMin (Int
0,Int
n)

-- | Between m and n times (inclusive). Minimal, i.e. biased towards matching
-- less.
betweenCountMin :: (Int, Int) -> RE c a -> RE c [a]
betweenCountMin :: forall c a. (Int, Int) -> RE c a -> RE c [a]
betweenCountMin (Int
l,Int
h) RE c a
re
  | Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h = RE c [a]
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
  | Bool
otherwise = Int -> RE c a -> RE c [a] -> RE c [a]
forall c a. Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM Int
l' RE c a
re (Int -> RE c [a]
go (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l'))
  where
    l' :: Int
l' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
0
    go :: Int -> RE c [a]
go Int
0 = [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go Int
n = [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] RE c [a] -> RE c [a] -> RE c [a]
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (Int -> RE c [a]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- n0 must be >= 0
replicateAppendM :: Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM :: forall c a. Int -> RE c a -> RE c [a] -> RE c [a]
replicateAppendM Int
n0 RE c a
re RE c [a]
re1 = Int -> RE c [a]
go Int
n0
  where
    go :: Int -> RE c [a]
go Int
0 = RE c [a]
re1
    go Int
n = (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (Int -> RE c [a]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- | @r \`sepBy\` sep@ parses zero or more occurences of @r@, separated by
-- @sep@. Biased towards matching more.
sepBy :: RE c a -> RE c sep -> RE c [a]
sepBy :: forall c a sep. RE c a -> RE c sep -> RE c [a]
sepBy RE c a
re RE c sep
sep = RE c a -> RE c sep -> RE c [a]
forall c a sep. RE c a -> RE c sep -> RE c [a]
sepBy1 RE c a
re RE c sep
sep RE c [a] -> RE c [a] -> RE c [a]
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | @r \`sepBy1\` sep@ parses one or more occurences of @r@, separated by
-- @sep@. Biased towards matching more.
sepBy1 :: RE c a -> RE c sep -> RE c [a]
sepBy1 :: forall c a sep. RE c a -> RE c sep -> RE c [a]
sepBy1 RE c a
re RE c sep
sep = (a -> [a] -> [a]) -> RE c a -> RE c [a] -> RE c [a]
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
liftA2' (:) RE c a
re (RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (RE c sep
sep RE c sep -> RE c a -> RE c a
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 a
re))

-- | @r \`endBy\` sep@ parses zero or more occurences of @r@, separated and
-- ended by @sep@. Biased towards matching more.
endBy :: RE c a -> RE c sep -> RE c [a]
endBy :: forall c a sep. RE c a -> RE c sep -> RE c [a]
endBy RE c a
re RE c sep
sep = RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (RE c a
re RE c a -> RE c sep -> RE c a
forall a b. RE c a -> RE c b -> RE c a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE c sep
sep)

-- | @r \`endBy1\` sep@ parses one or more occurences of @r@, separated and
-- ended by @sep@. Biased towards matching more.
endBy1 :: RE c a -> RE c sep -> RE c [a]
endBy1 :: forall c a sep. RE c a -> RE c sep -> RE c [a]
endBy1 RE c a
re RE c sep
sep = RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (RE c a
re RE c a -> RE c sep -> RE c a
forall a b. RE c a -> RE c b -> RE c a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE c sep
sep)

-- | @r \`sepEndBy\` sep@ parses zero or more occurences of @r@, separated and
-- optionally ended by @sep@. Biased towards matching more.
sepEndBy :: RE c a -> RE c sep -> RE c [a]
sepEndBy :: forall c a sep. RE c a -> RE c sep -> RE c [a]
sepEndBy RE c a
re RE c sep
sep = RE c a -> RE c sep -> RE c [a]
forall c a sep. RE c a -> RE c sep -> RE c [a]
sepEndBy1 RE c a
re RE c sep
sep RE c [a] -> RE c [a] -> RE c [a]
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> RE c [a]
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | @r \`sepEndBy1\` sep@ parses one or more occurences of @r@, separated and
-- optionally ended by @sep@. Biased towards matching more.
sepEndBy1 :: RE c a -> RE c sep -> RE c [a]
sepEndBy1 :: forall c a sep. RE c a -> RE c sep -> RE c [a]
sepEndBy1 RE c a
re RE c sep
sep = RE c a -> RE c sep -> RE c [a]
forall c a sep. RE c a -> RE c sep -> RE c [a]
sepBy1 RE c a
re RE c sep
sep RE c [a] -> RE c (Maybe sep) -> RE c [a]
forall a b. RE c a -> RE c b -> RE c a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE c sep -> RE c (Maybe sep)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional RE c sep
sep

-- | @chainl1 r op@ parses one or more occurences of @r@, separated by @op@.
-- The result is obtained by left associative application of all functions
-- returned by @op@ to the values returned by @p@. Biased towards matching more.
chainl1 :: RE c a -> RE c (a -> a -> a) -> RE c a
chainl1 :: forall c a. RE c a -> RE c (a -> a -> a) -> RE c a
chainl1 RE c a
re RE c (a -> a -> a)
op = (a -> (a -> a) -> a) -> RE c a -> RE c (a -> a) -> RE c a
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 (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
forall a. a -> a
id) RE c a
re RE c (a -> a)
rest
  where
    rest :: RE c (a -> a)
rest = ((a -> a) -> (a -> a) -> a -> a)
-> (a -> a) -> RE c (a -> a) -> RE c (a -> a)
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany (((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> (a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) a -> a
forall a. a -> a
id (((a -> a -> a) -> a -> a -> a)
-> RE c (a -> a -> a) -> RE c a -> RE c (a -> a)
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 (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RE c (a -> a -> a)
op RE c a
re)

-- | @chainr1 r op@ parses one or more occurences of @r@, separated by @op@.
-- The result is obtained by right associative application of all functions
-- returned by @op@ to the values returned by @p@. Biased towards matching more.
chainr1 :: RE c a -> RE c (a -> a -> a) -> RE c a
chainr1 :: forall c a. RE c a -> RE c (a -> a -> a) -> RE c a
chainr1 RE c a
re RE c (a -> a -> a)
op = ((a -> a) -> a -> a) -> RE c (a -> a) -> RE c a -> RE c a
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 (a -> a) -> a -> a
forall a. a -> a
id RE c (a -> a)
rest RE c a
re
  where
    rest :: RE c (a -> a)
rest = ((a -> a) -> (a -> a) -> a -> a)
-> (a -> a) -> RE c (a -> a) -> RE c (a -> a)
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> a
forall a. a -> a
id ((a -> (a -> a -> a) -> a -> a)
-> RE c a -> RE c (a -> a -> a) -> RE c (a -> a)
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 (((a -> a -> a) -> a -> a -> a) -> a -> (a -> a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a -> a) -> a -> a -> a
forall a. a -> a
id) RE c a
re RE c (a -> a -> a)
op)

-- | Results in the first occurence of the given @RE@. Fails if no occurence
-- is found.
toFind :: RE c a -> RE c a
toFind :: forall c a. RE c a -> RE c a
toFind RE c a
re = RE c c -> RE c [c]
forall c a. RE c a -> RE c [a]
manyMin RE c c
forall c. RE c c
anySingle RE c [c] -> RE c a -> RE c a
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 a
re RE c a -> RE c [c] -> RE c a
forall a b. RE c a -> RE c b -> RE c a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
anySingle

-- | Results in all non-overlapping occurences of the given @RE@. Always
-- succeeds.
toFindMany :: RE c a -> RE c [a]
toFindMany :: forall c a. RE c a -> RE c [a]
toFindMany RE c a
re =
  [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> RE c [a] -> RE c [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ([a] -> ([a] -> [a]) -> [a])
-> [a] -> RE c ([a] -> [a]) -> RE c [a]
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
foldlMany' ((([a] -> [a]) -> [a] -> [a]) -> [a] -> ([a] -> [a]) -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
($)) [] ((:) (a -> [a] -> [a]) -> RE c a -> RE c ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE c a
re RE c ([a] -> [a]) -> RE c ([a] -> [a]) -> RE c ([a] -> [a])
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> RE c c -> RE c ([a] -> [a])
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE c c
forall c. RE c c
anySingle)