{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef RERE_NO_CFG
{-# LANGUAGE Trustworthy       #-}
#elif __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe              #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy       #-}
#endif
-- | Various examples of using @rere@,
-- as used [in the blog post](#).
module RERE.Examples where

import Control.Applicative (some, (<|>))
import Control.Monad       (void)
import Data.Void           (Void)

import qualified Text.Parsec        as P
import qualified Text.Parsec.String as P

import RERE

#ifndef RERE_NO_CFG
import Data.Vec.Lazy (Vec (..))

import qualified Data.Fin      as F
import qualified Data.Type.Nat as N
#endif

#ifdef RERE_INTERSECTION
import Data.Void (vacuous)
#endif

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((*>))
#endif

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif

-- $setup
-- >>> import Test.QuickCheck.Random (mkQCGen)
-- >>> import Test.QuickCheck.Gen (unGen)
-- >>> import Control.Monad.ST (runST)
-- >>> import RERE
-- >>> let runGen seed = maybe "<<null>>" (\g' -> unGen g' (mkQCGen seed) 10)
-- >>> let showRef re = matchDebugR re ""

-------------------------------------------------------------------------------
-- * Syntax
-------------------------------------------------------------------------------

-- | Demonstrates how various constructors are pretty printed.
syntaxExamples :: IO ()
syntaxExamples :: IO ()
syntaxExamples = do
    RE Void -> IO ()
putLatex forall a. RE a
Null
    RE Void -> IO ()
putLatex forall a. RE a
Eps

    RE Void -> IO ()
putLatex forall a b. (a -> b) -> a -> b
$ forall a. Char -> RE a
ch_ Char
'a'
    RE Void -> IO ()
putLatex forall a b. (a -> b) -> a -> b
$ forall a. Char -> RE a
ch_ Char
'b'

    RE Void -> IO ()
putLatex forall a b. (a -> b) -> a -> b
$ forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" forall a. RE a
Eps forall a b. (a -> b) -> a -> b
$ forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" forall a. RE a
Eps forall a b. (a -> b) -> a -> b
$ forall a. RE a -> RE a -> RE a
App (forall a. a -> RE a
Var forall a. Var a
B) (forall a. a -> RE a
Var (forall a. a -> Var a
F forall a. Var a
B))
    RE Void -> IO ()
putLatex forall a b. (a -> b) -> a -> b
$ forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" forall a. RE a
Eps forall a b. (a -> b) -> a -> b
$ forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" forall a. RE a
Eps forall a b. (a -> b) -> a -> b
$ forall a. RE a -> RE a -> RE a
Alt (forall a. a -> RE a
Var forall a. Var a
B) (forall a. a -> RE a
Var (forall a. a -> Var a
F forall a. Var a
B))
    RE Void -> IO ()
putLatex forall a b. (a -> b) -> a -> b
$ forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" forall a. RE a
Eps forall a b. (a -> b) -> a -> b
$ forall a. RE a -> RE a
Star (forall a. a -> RE a
Var forall a. Var a
B)

-------------------------------------------------------------------------------
-- * Example 1
-------------------------------------------------------------------------------

-- |
--
-- >>> match ex1 "abab"
-- True
--
-- >>> match ex1 "ababa"
-- False
--
-- >>> ex1
-- Star (App (Ch "a") (Ch "b"))
--
-- >>> charClasses ex1
-- fromList "\NULabc"
--
-- >>> showRef ex1
-- size: 4
-- show: Star (App (Ch "a") (Ch "b"))
-- null: True
--
-- >>> matchR ex1 "abab"
-- True
--
-- >>> matchR ex1 "ababa"
-- False
--
-- >>> runGen 43 (generate 10 20 ex1)
-- "abababababababababab"
--
-- >>> runGen 44 (generate 10 20 ex1)
-- "ababab"
--
ex1 :: RE Void
ex1 :: RE Void
ex1 = forall a. RE a -> RE a
star_ (forall a. Char -> RE a
ch_ Char
'a' forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'b')

ex1run1 :: IO ()
ex1run1 :: IO ()
ex1run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex1 String
"abab"

-------------------------------------------------------------------------------
-- * Example 2
-------------------------------------------------------------------------------

-- |
--
-- >>> match ex2 "aaa"
-- True
--
-- Note: how "sharing" is preserved.
--
-- >>> showRef ex2
-- size: 5
-- show: App (Star (Ch "a")) (Star (Ch "a"))
-- null: True
--
-- >> matchR ex2 "aaa"
-- True
--
-- >>> runGen 42 (generate 10 20 ex2)
-- "aaaaaa"
--
-- >>> runGen 44 (generate 10 20 ex2)
-- "aaaaaaaaaa"
--
ex2 :: RE Void
ex2 :: RE Void
ex2 = forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
"r" (forall a. RE a -> RE a
star_ (forall a. Char -> RE a
ch_ Char
'a')) (forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B)

ex2run1 :: IO ()
ex2run1 :: IO ()
ex2run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex2 String
"aaa"

-------------------------------------------------------------------------------
-- * Example 3
-------------------------------------------------------------------------------

-- |
--
-- >>> match ex3 "abab"
-- True
--
-- >>> match ex3 "ababa"
-- False
--
-- >>> showRef ex3
-- size: 8
-- show: Ref 0 (Alt Eps (App (Ch "a") (App (Ch "b") (Ref 0 <<loop>>))))
-- null: True
--
-- >>> matchR ex3 "abab"
-- True
--
-- >>> matchR ex3 "ababa"
-- False
--
-- >>> runGen 43 (generate 10 20 ex3)
-- "abababab"
--
-- >>> runGen 44 (generate 10 20 ex3)
-- "abab"
--
ex3 :: RE Void
ex3 :: RE Void
ex3 = forall a. Name -> RE (Var a) -> RE a
Fix Name
"x" (forall a. RE a
Eps forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. Char -> RE a
ch_ Char
'a' forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'b' forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B)

ex3run1 :: IO ()
ex3run1 :: IO ()
ex3run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex3 String
"abab"

-------------------------------------------------------------------------------
-- * Example 4
-------------------------------------------------------------------------------

-- |
--
-- >>> match ex4 "aaaabbbb"
-- True
--
-- >>> showRef ex4
-- size: 8
-- show: Ref 0 (Alt Eps (App (Ch "a") (App (Ref 0 <<loop>>) (Ch "b"))))
-- null: True
--
-- >>> matchR ex4 "aaaabbbb"
-- True
--
-- >>> runGen 43 (generate 10 20 ex4)
-- "ab"
--
-- >>> runGen 47 (generate 10 20 ex4)
-- "aaaabbbb"
--
ex4 :: RE Void
ex4 :: RE Void
ex4 = forall a. Name -> RE (Var a) -> RE a
Fix Name
"x" (forall a. RE a
Eps forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. Char -> RE a
ch_ Char
'a' forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'b')

ex4run1 :: IO ()
ex4run1 :: IO ()
ex4run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex4 String
"aaaabbbb"

-------------------------------------------------------------------------------
-- * Example 5
-------------------------------------------------------------------------------

-- |
--
-- >>> match ex5 "abab"
-- True
--
-- >>> match ex5 "ababa"
-- False
--
-- >>> showRef ex5
-- size: 8
-- show: Ref 0 (Alt Eps (App (Ref 0 <<loop>>) (App (Ch "a") (Ch "b"))))
-- null: True
--
-- >>> matchR ex5 "abab"
-- True
--
-- >>> matchR ex5 "ababa"
-- False
--
-- >>> runGen 43 (generate 10 20 ex5)
-- "ab"
--
-- >>> runGen 51 (generate 10 20 ex5)
-- "abab"
--
ex5 :: RE Void
ex5 :: RE Void
ex5 = forall a. Name -> RE (Var a) -> RE a
Fix Name
"x" (forall a. RE a
Eps forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'a' forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'b')

ex5run1 :: IO ()
ex5run1 :: IO ()
ex5run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex5 String
"abab"

-------------------------------------------------------------------------------
-- * Example 6
-------------------------------------------------------------------------------

-- |
--
-- Using fix-point operator:
--
-- @
-- fix expr = "(" expr ")" | "1" | "2" | ... | "9" | expr "+" expr | expr "*" expr
-- @
--
-- which in BNF is almost he same
--
-- @
-- expr ::= "(" expr ")" | "1" | "2" | ... | "9" | expr "+" expr | expr "*" expr
-- @
--
-- >>> matchR ex6 "(1+2)*3"
-- True
--
-- >>> runGen 43 (generate 5 5 ex6)
-- "74501+(534*19450)*(99050)"
--
ex6 :: RE Void
ex6 :: RE Void
ex6 = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
"d" (forall a. CharSet -> RE a
Ch CharSet
"0123456789")
    forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
"n" (forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. RE a -> RE a
star_ (forall a. a -> RE a
Var forall a. Var a
B))
    forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
"e"
    forall a b. (a -> b) -> a -> b
$  forall a. Char -> RE a
ch_ Char
'(' forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
')'
    forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. a -> RE a
Var (forall a. a -> Var a
F forall a. Var a
B)
    forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'+' forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B
    forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. a -> RE a
Var forall a. Var a
B forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'*' forall a. Semigroup a => a -> a -> a
<> forall a. a -> RE a
Var forall a. Var a
B

--
-- (displayTraced . traced) is "match" function, which
-- also prints the trace of execution.
--
-- True
ex6run1 :: IO ()
ex6run1 :: IO ()
ex6run1 = RE Void -> String -> IO ()
putLatexTrace RE Void
ex6 String
"1*(20+3)"

-------------------------------------------------------------------------------
-- * Example 7
-------------------------------------------------------------------------------

#ifndef RERE_NO_CFG
exCfg :: Ord a => CFG N.Nat5 a
exCfg :: forall a. Ord a => CFG Nat5 a
exCfg =
    forall a. RE a
digit forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: CFGBase Nat5 a
digits forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: CFGBase Nat5 a
term forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: CFGBase Nat5 a
mult forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: CFGBase Nat5 a
expr forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: forall a. Vec 'Z a
VNil
  where
    expr :: CFGBase Nat5 a
expr = forall a. RE a -> RE a -> RE a
Alt (forall a. CFGBase Nat5 a
multV forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'*' forall a. Semigroup a => a -> a -> a
<> forall a. CFGBase Nat5 a
exprV) forall a. CFGBase Nat5 a
multV
    mult :: CFGBase Nat5 a
mult = forall a. RE a -> RE a -> RE a
Alt (forall a. CFGBase Nat5 a
termV forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
'+' forall a. Semigroup a => a -> a -> a
<> forall a. CFGBase Nat5 a
multV) forall a. CFGBase Nat5 a
termV
    term :: CFGBase Nat5 a
term = forall a. RE a -> RE a -> RE a
Alt forall a. CFGBase Nat5 a
digitsV (forall a. Char -> RE a
ch_ Char
'(' forall a. Semigroup a => a -> a -> a
<> forall a. CFGBase Nat5 a
exprV forall a. Semigroup a => a -> a -> a
<> forall a. Char -> RE a
ch_ Char
')')

    digit :: RE a
digit = forall a. CharSet -> RE a
Ch CharSet
"0123456789"
    digits :: CFGBase Nat5 a
digits = forall a. CFGBase Nat5 a
digitV forall a. Semigroup a => a -> a -> a
<> forall a. RE a -> RE a
star_ forall a. CFGBase Nat5 a
digitV

    digitV, digitsV, exprV, multV, termV :: CFGBase N.Nat5 a
    exprV :: forall a. CFGBase Nat5 a
exprV   = forall a. a -> RE a
Var forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (n :: Nat). Fin (Plus ('S Nat3) ('S n))
F.fin4
    multV :: forall a. CFGBase Nat5 a
multV   = forall a. a -> RE a
Var forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (n :: Nat). Fin (Plus Nat3 ('S n))
F.fin3
    termV :: forall a. CFGBase Nat5 a
termV   = forall a. a -> RE a
Var forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (n :: Nat). Fin (Plus ('S Nat1) ('S n))
F.fin2
    digitsV :: forall a. CFGBase Nat5 a
digitsV = forall a. a -> RE a
Var forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (n :: Nat). Fin (Plus Nat1 ('S n))
F.fin1
    digitV :: forall a. CFGBase Nat5 a
digitV  = forall a. a -> RE a
Var forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (n :: Nat). Fin (Plus 'Z ('S n))
F.fin0

exCfgN :: Vec N.Nat5 Name
exCfgN :: Vec Nat5 Name
exCfgN = Name
"digit" forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: Name
"digits" forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: Name
"term" forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: Name
"mult" forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: Name
"expr" forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
::: forall a. Vec 'Z a
VNil

-- |
--
-- >>> matchR ex7 "12"
-- True
--
-- >>> matchR ex7 "(1+2)*3"
-- True
--
-- >>> charClasses ex7
-- fromList "\NUL()*+,0:"
--
-- >>> runGen 43 (generate 5 5 ex7)
-- "(3431*((0337+5+070346+4))+76848+((4126+350875)*98769+308194+270+03118)+888*(95+90904)+(301069+7+715835)+2809)"
--
ex7 :: Ord a => RE a
ex7 :: forall a. Ord a => RE a
ex7 = forall (n :: Nat) a.
(SNatI n, Ord a) =>
Vec ('S n) Name -> CFG ('S n) a -> RE a
cfgToRE Vec Nat5 Name
exCfgN forall a. Ord a => CFG Nat5 a
exCfg

-- ex7 :: RE Void
-- ex7 = Let "digit" (Ch '0' \/ Ch '1' \/ Ch '2' \/ Ch '3')
--     $ Let "digits" (Var B <> star (Var B))
--     $ Fix "expr"
--     $ Let "term" (Var (F B) \/ Ch '(' <> Var B <> Ch ')')
--     $ Let "mult" (Fix "mult" $ Var (F B) <> Ch '+' <> Var B \/ Var (F B))
--     $ Var B <> Ch '*' <> Var (F B) \/ Var B

ex7run1 :: IO ()
ex7run1 :: IO ()
ex7run1 = String -> IO ()
ex7run String
"1*(20+3)"

ex7run :: String -> IO ()
ex7run :: String -> IO ()
ex7run String
str = RE Void -> String -> IO ()
putLatexTrace forall a. Ord a => RE a
ex7 String
str
#endif

ex7parsec :: P.Parser ()
ex7parsec :: Parser ()
ex7parsec = forall {u}. ParsecT String u Identity ()
expr where
    expr :: ParsecT String u Identity ()
expr   = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT String u Identity ()
mult forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'*' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
expr) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String u Identity ()
mult
    mult :: ParsecT String u Identity ()
mult   = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT String u Identity ()
term forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'+' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
mult) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String u Identity ()
term
    term :: ParsecT String u Identity ()
term   = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall {u}. ParsecT String u Identity ()
digits forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity ()
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
')')
    digits :: ParsecT String u Identity ()
digits = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall {u}. ParsecT String u Identity Char
digit
    digit :: ParsecT String u Identity Char
digit  = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9')

ex7parsecRun :: IO ()
ex7parsecRun :: IO ()
ex7parsecRun = forall s t a.
(Stream s Identity t, Show a) =>
Parsec s () a -> s -> IO ()
P.parseTest Parser ()
ex7parsec String
"1*(20+3)"

-------------------------------------------------------------------------------
-- * Example 8
-------------------------------------------------------------------------------

#ifdef RERE_INTERSECTION
xnyn :: Name -> Char -> Char -> RE Void
xnyn n x y = Fix n (Eps \/ ch_ x <> Var B <> ch_ y)

ambncn :: RE Void
ambncn = star_ (ch_ 'a') <> xnyn "bc" 'b' 'c'

anbncm :: RE Void
anbncm = xnyn "ab" 'a' 'b' <> star_ (ch_ 'c')

-- |
--
-- >>> match ex8 "aabbcc"
-- True
--
-- >>> match ex8 "aabbccc"
-- False
--
-- >> matchR ex8 "aabbcc"
-- True
--
-- >> matchR ex8 "aabbccc"
-- False
--
-- >>> runGen 42 (generate 10 20 ex8)
-- "<<null>>"
--
ex8 :: RE Void
ex8 = ambncn /\ anbncm

ex8run1 :: IO ()
ex8run1 = putLatexTrace ex8 "aaabbbccc"

-- |
--
-- >> matchR ex8b "aabbccaaabbbccc"
-- True
ex8b :: RE Void
ex8b = Fix "abc" (Eps \/ vacuous ex8 <> Var B)

ex8run2 :: IO ()
ex8run2 = putLatexTrace ex8b "aabbccaabbcc"

#endif

-------------------------------------------------------------------------------
-- * Example 9
-------------------------------------------------------------------------------

#ifdef RERE_INTERSECTION

evenRE :: RE Void
evenRE = star_ (ch_ 'a' <> ch_ 'a')

oddRE :: RE Void
oddRE = ch_ 'a' <> evenRE

evenRE' :: RE Void
evenRE' = fix_ "even" (Eps \/ ch_ 'a' <> ch_ 'a' <> Var B)

oddRE' :: RE Void
oddRE' = ch_ 'a' <> evenRE'

ex9 :: RE Void
ex9 = let_ "odd" oddRE
    $ let_ "even" (fmap F evenRE)
    $ Var B /\ Var (F B)

ex9run1 :: IO ()
ex9run1 = putLatexTrace ex9 "aaa"

ex9b :: RE Void
ex9b = let_ "odd" oddRE'
     $ let_ "even" (fmap F evenRE')
     $ Var B /\ Var (F B)

ex9run2 :: IO ()
ex9run2 = putLatexTrace ex9b "aaa"
#endif