{-# LANGUAGE CPP   #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Safe  #-}
{-# OPTIONS_HADDOCK not-home #-}
module Kleene.Internal.Functor (
    K (..),
    Greediness (..),
    -- * Constructors
    few,
    anyChar,
    oneof,
    char,
    charRange,
    dot,
    everything,
    everything1,
    -- * Queries
    isEmpty,
    isEverything,
    -- * Matching
    match,
    -- * Conversions
    toRE,
    toKleene,
    fromRE,
    toRA,
    ) where

import Control.Applicative (Alternative (..), liftA2)
import Data.Foldable       (toList)
import Data.Functor.Apply  (Apply (..))
import Data.RangeSet.Map   (RSet)
import Data.String         (IsString (..))

import qualified Data.Functor.Alt       as Alt
import qualified Data.RangeSet.Map      as RSet
import qualified Text.Regex.Applicative as R

import qualified Kleene.Classes         as C
import           Kleene.Internal.Pretty
import           Kleene.Internal.Sets
import qualified Kleene.RE              as RE


-- $setup
--
-- >>> import Control.Applicative (Alternative (..), liftA2)
-- >>> import Data.Semigroup (Semigroup (..))
-- >>> import Kleene.Internal.Pretty (putPretty)
-- >>> import qualified Kleene.Classes as C
-- >>> import qualified Kleene.RE as RE
-- >>> import qualified Text.Regex.Applicative as R

-------------------------------------------------------------------------------
-- Functor RE
-------------------------------------------------------------------------------

-- | Star behaviour
data Greediness
    = Greedy    -- ^ 'many'
    | NonGreedy -- ^ 'few'
  deriving (Greediness -> Greediness -> Bool
(Greediness -> Greediness -> Bool)
-> (Greediness -> Greediness -> Bool) -> Eq Greediness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Greediness -> Greediness -> Bool
== :: Greediness -> Greediness -> Bool
$c/= :: Greediness -> Greediness -> Bool
/= :: Greediness -> Greediness -> Bool
Eq, Eq Greediness
Eq Greediness =>
(Greediness -> Greediness -> Ordering)
-> (Greediness -> Greediness -> Bool)
-> (Greediness -> Greediness -> Bool)
-> (Greediness -> Greediness -> Bool)
-> (Greediness -> Greediness -> Bool)
-> (Greediness -> Greediness -> Greediness)
-> (Greediness -> Greediness -> Greediness)
-> Ord Greediness
Greediness -> Greediness -> Bool
Greediness -> Greediness -> Ordering
Greediness -> Greediness -> Greediness
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
$ccompare :: Greediness -> Greediness -> Ordering
compare :: Greediness -> Greediness -> Ordering
$c< :: Greediness -> Greediness -> Bool
< :: Greediness -> Greediness -> Bool
$c<= :: Greediness -> Greediness -> Bool
<= :: Greediness -> Greediness -> Bool
$c> :: Greediness -> Greediness -> Bool
> :: Greediness -> Greediness -> Bool
$c>= :: Greediness -> Greediness -> Bool
>= :: Greediness -> Greediness -> Bool
$cmax :: Greediness -> Greediness -> Greediness
max :: Greediness -> Greediness -> Greediness
$cmin :: Greediness -> Greediness -> Greediness
min :: Greediness -> Greediness -> Greediness
Ord, Int -> Greediness -> ShowS
[Greediness] -> ShowS
Greediness -> String
(Int -> Greediness -> ShowS)
-> (Greediness -> String)
-> ([Greediness] -> ShowS)
-> Show Greediness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Greediness -> ShowS
showsPrec :: Int -> Greediness -> ShowS
$cshow :: Greediness -> String
show :: Greediness -> String
$cshowList :: [Greediness] -> ShowS
showList :: [Greediness] -> ShowS
Show, Int -> Greediness
Greediness -> Int
Greediness -> [Greediness]
Greediness -> Greediness
Greediness -> Greediness -> [Greediness]
Greediness -> Greediness -> Greediness -> [Greediness]
(Greediness -> Greediness)
-> (Greediness -> Greediness)
-> (Int -> Greediness)
-> (Greediness -> Int)
-> (Greediness -> [Greediness])
-> (Greediness -> Greediness -> [Greediness])
-> (Greediness -> Greediness -> [Greediness])
-> (Greediness -> Greediness -> Greediness -> [Greediness])
-> Enum Greediness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Greediness -> Greediness
succ :: Greediness -> Greediness
$cpred :: Greediness -> Greediness
pred :: Greediness -> Greediness
$ctoEnum :: Int -> Greediness
toEnum :: Int -> Greediness
$cfromEnum :: Greediness -> Int
fromEnum :: Greediness -> Int
$cenumFrom :: Greediness -> [Greediness]
enumFrom :: Greediness -> [Greediness]
$cenumFromThen :: Greediness -> Greediness -> [Greediness]
enumFromThen :: Greediness -> Greediness -> [Greediness]
$cenumFromTo :: Greediness -> Greediness -> [Greediness]
enumFromTo :: Greediness -> Greediness -> [Greediness]
$cenumFromThenTo :: Greediness -> Greediness -> Greediness -> [Greediness]
enumFromThenTo :: Greediness -> Greediness -> Greediness -> [Greediness]
Enum, Greediness
Greediness -> Greediness -> Bounded Greediness
forall a. a -> a -> Bounded a
$cminBound :: Greediness
minBound :: Greediness
$cmaxBound :: Greediness
maxBound :: Greediness
Bounded)

-- | 'Applicative' 'Functor' regular expression.
data K c a where
    KEmpty  :: K c a
    KPure   :: a -> K c a
    KChar   :: (Ord c, Enum c) => RSet c -> K c c
    KAppend :: (a -> b -> r) -> K c a -> K c b -> K c r
    KUnion  :: K c a -> K c a -> K c a
    KStar   :: Greediness -> K c a -> K c [a]

    -- optimisations
    KMap    :: (a -> b) -> K c a -> K c b -- could use Pure and Append
    KString :: Eq c => [c] -> K c [c]     -- could use Char and Append

instance (c ~ Char, IsString a) => IsString (K c a) where
    fromString :: String -> K c a
fromString String
s = (String -> a) -> K c String -> K c a
forall a b c. (a -> b) -> K c a -> K c b
KMap String -> a
forall a. IsString a => String -> a
fromString ([c] -> K c [c]
forall c. Eq c => [c] -> K c [c]
KString [c]
String
s)

instance Functor (K c) where
    fmap :: forall a b. (a -> b) -> K c a -> K c b
fmap a -> b
_ K c a
KEmpty          = K c b
forall c a. K c a
KEmpty
    fmap a -> b
f (KPure a
x)       = b -> K c b
forall a c. a -> K c a
KPure (a -> b
f a
x)
    fmap a -> b
f (KMap a -> a
g K c a
k)      = (a -> b) -> K c a -> K c b
forall a b c. (a -> b) -> K c a -> K c b
KMap (a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g) K c a
k
    fmap a -> b
f (KAppend a -> b -> a
g K c a
a K c b
b) = (a -> b -> b) -> K c a -> K c b -> K c b
forall a b r c. (a -> b -> r) -> K c a -> K c b -> K c r
KAppend (\a
x b
y -> a -> b
f (a -> b -> a
g a
x b
y)) K c a
a K c b
b
    fmap a -> b
f K c a
k               = (a -> b) -> K c a -> K c b
forall a b c. (a -> b) -> K c a -> K c b
KMap a -> b
f K c a
k

instance Apply (K c) where
    K c (a -> b)
KEmpty <.> :: forall a b. K c (a -> b) -> K c a -> K c b
<.> K c a
_ = K c b
forall c a. K c a
KEmpty
    K c (a -> b)
_ <.> K c a
KEmpty = K c b
forall c a. K c a
KEmpty

    KPure a -> b
f <.> K c a
k = (a -> b) -> K c a -> K c b
forall a b. (a -> b) -> K c a -> K c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f K c a
k
    K c (a -> b)
k <.> KPure a
x = ((a -> b) -> b) -> K c (a -> b) -> K c b
forall a b. (a -> b) -> K c a -> K c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) K c (a -> b)
k

    K c (a -> b)
f <.> K c a
x = ((a -> b) -> a -> b) -> K c (a -> b) -> K c a -> K c b
forall a b r c. (a -> b -> r) -> K c a -> K c b -> K c r
KAppend (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) K c (a -> b)
f K c a
x

    liftF2 :: forall a b c. (a -> b -> c) -> K c a -> K c b -> K c c
liftF2 = (a -> b -> c) -> K c a -> K c b -> K c c
forall a b r c. (a -> b -> r) -> K c a -> K c b -> K c r
KAppend

instance Applicative (K c) where
    pure :: forall a. a -> K c a
pure  = a -> K c a
forall a c. a -> K c a
KPure
    <*> :: forall a b. K c (a -> b) -> K c a -> K c b
(<*>) = K c (a -> b) -> K c a -> K c b
forall a b. K c (a -> b) -> K c a -> K c b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)

#if MIN_VERSION_base(4,10,0)
    liftA2 :: forall a b c. (a -> b -> c) -> K c a -> K c b -> K c c
liftA2 = (a -> b -> c) -> K c a -> K c b -> K c c
forall a b c. (a -> b -> c) -> K c a -> K c b -> K c c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2
#endif

instance Alt.Alt (K c) where
    K c a
KEmpty <!> :: forall a. K c a -> K c a -> K c a
<!> K c a
k = K c a
k
    K c a
k <!> K c a
KEmpty = K c a
k
    KChar RSet c
a <!> KChar RSet c
b = RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar (RSet c -> RSet c -> RSet c
forall a. (Ord a, Enum a) => RSet a -> RSet a -> RSet a
RSet.union RSet c
a RSet c
b)

    K c a
a <!> K c a
b = K c a -> K c a -> K c a
forall c a. K c a -> K c a -> K c a
KUnion K c a
a K c a
b

    many :: forall a. Applicative (K c) => K c a -> K c [a]
many K c a
KEmpty      = [a] -> K c [a]
forall a c. a -> K c a
KPure []
    many (KStar Greediness
_ K c a
k) = (a -> [a]) -> K c a -> K c [a]
forall a b c. (a -> b) -> K c a -> K c b
KMap a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
Greedy K c a
k)
    many K c a
k           = Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
Greedy K c a
k

    some :: forall a. Applicative (K c) => K c a -> K c [a]
some K c a
KEmpty      = K c [a]
forall c a. K c a
KEmpty
    some (KStar Greediness
_ K c a
k) = (a -> [a]) -> K c a -> K c [a]
forall a b c. (a -> b) -> K c a -> K c b
KMap a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
Greedy K c a
k)
    some K c a
k           = (a -> [a] -> [a]) -> K c a -> K c [a] -> K c [a]
forall a b c. (a -> b -> c) -> K c a -> K c b -> K c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) K c a
k (Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
Greedy K c a
k)

instance Alternative (K c) where
    empty :: forall a. K c a
empty = K c a
forall c a. K c a
KEmpty
    <|> :: forall a. K c a -> K c a -> K c a
(<|>) = K c a -> K c a -> K c a
forall a. K c a -> K c a -> K c a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(Alt.<!>)
    some :: forall a. K c a -> K c [a]
some  = K c a -> K c [a]
forall a. Applicative (K c) => K c a -> K c [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
Alt.some
    many :: forall a. K c a -> K c [a]
many  = K c a -> K c [a]
forall a. Applicative (K c) => K c a -> K c [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
Alt.many

-- | 'few', not 'many'.
--
-- Let's define two similar regexps
--
-- >>> let re1 = liftA2 (,) (few  $ char 'a') (many $ char 'a')
-- >>> let re2 = liftA2 (,) (many $ char 'a') (few  $ char 'a')
--
-- Their 'RE' behaviour is the same:
--
-- >>> C.equivalent (toRE re1) (toRE re2)
-- True
--
-- >>> map (C.match $ toRE re1) ["aaa","bbb"]
-- [True,False]
--
-- However, the 'RA' behaviour is different!
--
-- >>> R.match (toRA re1) "aaaa"
-- Just ("","aaaa")
--
-- >>> R.match (toRA re2) "aaaa"
-- Just ("aaaa","")
--
few :: K c a -> K c [a]
few :: forall c a. K c a -> K c [a]
few K c a
KEmpty      = [a] -> K c [a]
forall a c. a -> K c a
KPure []
few (KStar Greediness
_ K c a
k) = (a -> [a]) -> K c a -> K c [a]
forall a b c. (a -> b) -> K c a -> K c b
KMap a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
NonGreedy K c a
k)
few K c a
k           = Greediness -> K c a -> K c [a]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
NonGreedy K c a
k

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

-- | >>> putPretty anyChar
-- ^[^]$
anyChar :: (Ord c, Enum c, Bounded c) => K c c
anyChar :: forall c. (Ord c, Enum c, Bounded c) => K c c
anyChar = RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar RSet c
forall a. Bounded a => RSet a
RSet.full

-- | >>> putPretty $ oneof ("foobar" :: [Char])
-- ^[a-bfor]$
oneof :: (Ord c, Enum c, Foldable f) => f c -> K c c
oneof :: forall c (f :: * -> *). (Ord c, Enum c, Foldable f) => f c -> K c c
oneof = RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar (RSet c -> K c c) -> (f c -> RSet c) -> f c -> K c c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> RSet c
forall a. (Ord a, Enum a) => [a] -> RSet a
RSet.fromList ([c] -> RSet c) -> (f c -> [c]) -> f c -> RSet c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f c -> [c]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | >>> putPretty $ char 'x'
-- ^x$
char :: (Ord c, Enum c) => c -> K c c
char :: forall c. (Ord c, Enum c) => c -> K c c
char = RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar (RSet c -> K c c) -> (c -> RSet c) -> c -> K c c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> RSet c
forall a. a -> RSet a
RSet.singleton

-- | >>> putPretty $ charRange 'a' 'z'
-- ^[a-z]$
charRange :: (Enum c, Ord c) => c -> c -> K c c
charRange :: forall c. (Enum c, Ord c) => c -> c -> K c c
charRange c
a c
b = RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar ((c, c) -> RSet c
forall a. Ord a => (a, a) -> RSet a
RSet.singletonRange (c
a, c
b))

-- | >>> putPretty dot
-- ^.$
dot :: K Char Char
dot :: K Char Char
dot = RSet Char -> K Char Char
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar RSet Char
dotRSet

-- | >>> putPretty everything
-- ^[^]*$
everything :: (Ord c, Enum c, Bounded c) => K c [c]
everything :: forall c. (Ord c, Enum c, Bounded c) => K c [c]
everything = K c c -> K c [c]
forall a. K c a -> K c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many K c c
forall c. (Ord c, Enum c, Bounded c) => K c c
anyChar

-- | >>> putPretty everything1
-- ^[^][^]*$
everything1 :: (Ord c, Enum c, Bounded c) => K c [c]
everything1 :: forall c. (Ord c, Enum c, Bounded c) => K c [c]
everything1 = K c c -> K c [c]
forall a. K c a -> K c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some K c c
forall c. (Ord c, Enum c, Bounded c) => K c c
anyChar

-- | Matches nothing?
isEmpty :: (Ord c, Enum c, Bounded c) => K c a -> Bool
isEmpty :: forall c a. (Ord c, Enum c, Bounded c) => K c a -> Bool
isEmpty K c a
k = RE c -> RE c -> Bool
forall c k. Equivalent c k => k -> k -> Bool
C.equivalent (K c a -> RE c
forall c a. (Ord c, Enum c, Bounded c) => K c a -> RE c
toRE K c a
k) RE c
forall k. Kleene k => k
C.empty

-- | Matches whole input?
isEverything :: (Ord c, Enum c, Bounded c) => K c a -> Bool
isEverything :: forall c a. (Ord c, Enum c, Bounded c) => K c a -> Bool
isEverything K c a
k = RE c -> RE c -> Bool
forall c k. Equivalent c k => k -> k -> Bool
C.equivalent (K c a -> RE c
forall c a. (Ord c, Enum c, Bounded c) => K c a -> RE c
toRE K c a
k) RE c
forall c k. FiniteKleene c k => k
C.everything

-------------------------------------------------------------------------------
-- Matching
-------------------------------------------------------------------------------

-- | Match using @regex-applicative@
match :: K c a -> [c] -> Maybe a
match :: forall c a. K c a -> [c] -> Maybe a
match = RE c a -> [c] -> Maybe a
forall s a. RE s a -> [s] -> Maybe a
R.match (RE c a -> [c] -> Maybe a)
-> (K c a -> RE c a) -> K c a -> [c] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K c a -> RE c a
forall c a. K c a -> RE c a
toRA

-------------------------------------------------------------------------------
-- RE
-------------------------------------------------------------------------------

-- | Convert to 'RE'.
--
-- >>> putPretty (toRE $ many "foo" :: RE.RE Char)
-- ^(foo)*$
--
toRE :: (Ord c, Enum c, Bounded c) => K c a -> RE.RE c
toRE :: forall c a. (Ord c, Enum c, Bounded c) => K c a -> RE c
toRE = K c a -> RE c
forall c k a. FiniteKleene c k => K c a -> k
toKleene

-- | Convert to any 'Kleene'
toKleene :: C.FiniteKleene c k => K c a -> k
toKleene :: forall c k a. FiniteKleene c k => K c a -> k
toKleene (KMap a -> a
_ K c a
a)      = K c a -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c a
a
toKleene (KUnion K c a
a K c a
b)    = [k] -> k
forall k. Kleene k => [k] -> k
C.unions [K c a -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c a
a, K c a -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c a
b]
toKleene (KAppend a -> b -> a
_ K c a
a K c b
b) = [k] -> k
forall k. Kleene k => [k] -> k
C.appends [K c a -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c a
a, K c b -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c b
b]
toKleene (KStar Greediness
_ K c a
a)     = k -> k
forall k. Kleene k => k -> k
C.star (K c a -> k
forall c k a. FiniteKleene c k => K c a -> k
toKleene K c a
a)
toKleene (KString [c]
s)     = [k] -> k
forall k. Kleene k => [k] -> k
C.appends ((c -> k) -> [c] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map c -> k
forall c k. CharKleene c k => c -> k
C.char [c]
s)
toKleene K c a
KEmpty          = k
forall k. Kleene k => k
C.empty
toKleene (KPure a
_)       = k
forall k. Kleene k => k
C.eps
toKleene (KChar RSet c
cs)      = RSet c -> k
forall c k. FiniteKleene c k => RSet c -> k
C.fromRSet RSet c
cs

-- | Convert from 'RE'.
--
-- /Note:/ all 'RE.REStar's are converted to 'Greedy' ones,
-- it doesn't matter, as we don't capture anything.
--
-- >>> match (fromRE "foobar") "foobar"
-- Just "foobar"
--
-- >>> match (fromRE $ C.star "a" <> C.star "a") "aaaa"
-- Just "aaaa"
--
fromRE :: (Ord c, Enum c) => RE.RE c -> K c [c]
fromRE :: forall c. (Ord c, Enum c) => RE c -> K c [c]
fromRE (RE.REChars RSet c
cs)    = c -> [c]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> [c]) -> K c c -> K c [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar RSet c
cs
fromRE (RE.REAppend [RE c]
rs)   = [[c]] -> [c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[c]] -> [c]) -> K c [[c]] -> K c [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RE c -> K c [c]) -> [RE c] -> K c [[c]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse RE c -> K c [c]
forall c. (Ord c, Enum c) => RE c -> K c [c]
fromRE [RE c]
rs
fromRE (RE.REUnion RSet c
cs Set (RE c)
rs) = (RE c -> K c [c] -> K c [c]) -> K c [c] -> [RE c] -> K 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 (K c [c] -> K c [c] -> K c [c]
forall c a. K c a -> K c a -> K c a
KUnion (K c [c] -> K c [c] -> K c [c])
-> (RE c -> K c [c]) -> RE c -> K c [c] -> K c [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE c -> K c [c]
forall c. (Ord c, Enum c) => RE c -> K c [c]
fromRE) (c -> [c]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> [c]) -> K c c -> K c [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RSet c -> K c c
forall c. (Ord c, Enum c) => RSet c -> K c c
KChar RSet c
cs) (Set (RE c) -> [RE c]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (RE c)
rs)
fromRE (RE.REStar RE c
r)      = [[c]] -> [c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[c]] -> [c]) -> K c [[c]] -> K c [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Greediness -> K c [c] -> K c [[c]]
forall c a. Greediness -> K c a -> K c [a]
KStar Greediness
Greedy (RE c -> K c [c]
forall c. (Ord c, Enum c) => RE c -> K c [c]
fromRE RE c
r)

-------------------------------------------------------------------------------
-- regex-applicative
-------------------------------------------------------------------------------

-- | Convert 'K' to 'R.RE' from @regex-applicative@.
--
-- >>> R.match (toRA ("xx" *> everything <* "zz" :: K Char String)) "xxyyyzz"
-- Just "yyy"
--
-- See also 'match'.
--
toRA :: K c a -> R.RE c a
toRA :: forall c a. K c a -> RE c a
toRA K c a
KEmpty              = RE c a
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
toRA (KPure a
x)           = a -> RE c a
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
toRA (KChar RSet c
cs)          = (c -> Bool) -> RE c c
forall s. (s -> Bool) -> RE s s
R.psym (\c
c -> c -> RSet c -> Bool
forall a. Ord a => a -> RSet a -> Bool
RSet.member c
c RSet c
cs)
toRA (KAppend a -> b -> a
f K c a
a K c b
b)     = (a -> b -> a) -> RE c a -> RE c b -> 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 -> b -> a
f (K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
a) (K c b -> RE c b
forall c a. K c a -> RE c a
toRA K c b
b)
toRA (KUnion K c a
a K c a
b)        = K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
a 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
<|> K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
b
toRA (KStar Greediness
Greedy K c a
a)    = RE c a -> RE c [a]
forall a. RE c a -> RE c [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
a)
toRA (KStar Greediness
NonGreedy K c a
a) = RE c a -> RE c [a]
forall s a. RE s a -> RE s [a]
R.few (K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
a)
toRA (KMap a -> a
f K c a
a)          = (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
f (K c a -> RE c a
forall c a. K c a -> RE c a
toRA K c a
a)
toRA (KString [c]
s)         = [c] -> RE c [c]
forall a. Eq a => [a] -> RE a [a]
R.string [c]
s

-------------------------------------------------------------------------------
-- JavaScript
-------------------------------------------------------------------------------

-- | Convert to non-matching JavaScript string which can be used
-- as an argument to @new RegExp@
--
-- >>> putPretty ("foobar" :: K Char String)
-- ^foobar$
--
-- >>> putPretty $ many ("foobar" :: K Char String)
-- ^(foobar)*$
--
instance c ~ Char => Pretty (K c a) where
    pretty :: K c a -> String
pretty = RE c -> String
forall a. Pretty a => a -> String
pretty (RE c -> String) -> (K c a -> RE c) -> K c a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K c a -> RE c
forall c a. (Ord c, Enum c, Bounded c) => K c a -> RE c
toRE