{-# LANGUAGE Trustworthy #-}
module Text.Gigaparsec.Registers (
    Reg,
    make, unsafeMake,
    get, gets,
    put, puts,
    modify,
    local, localWith,
    rollback
  ) where

import Text.Gigaparsec (Parsec, (<|>), empty)
import Text.Gigaparsec.Internal.RT (Reg, newReg, readReg, writeReg)
import Text.Gigaparsec.Internal qualified as Internal (Parsec(..))

unsafeMake :: (forall r. Reg r a -> Parsec b) -> Parsec b
unsafeMake :: forall a b. (forall r. Reg r a -> Parsec b) -> Parsec b
unsafeMake = a -> (forall r. Reg r a -> Parsec b) -> Parsec b
forall a b. a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"reference used but not set")

_make :: Parsec a -> (forall r. Reg r a -> Parsec b) -> Parsec b
_make :: forall a b. Parsec a -> (forall r. Reg r a -> Parsec b) -> Parsec b
_make Parsec a
p forall r. Reg r a -> Parsec b
f = Parsec a
p Parsec a -> (a -> Parsec b) -> Parsec b
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> a -> (forall r. Reg r a -> Parsec b) -> Parsec b
forall a b. a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make a
x Reg r a -> Parsec b
forall r. Reg r a -> Parsec b
f

make :: a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make :: forall a b. a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make a
x forall r. Reg r a -> Parsec b
f = (forall r.
 State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec b)
-> (forall r.
    State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a b. (a -> b) -> a -> b
$ \State
st b -> State -> RT r
good Error -> State -> RT r
bad ->
  a -> (forall {r}. Reg r a -> RT r) -> RT r
forall a b. a -> (forall r. Reg r a -> RT b) -> RT b
newReg a
x ((forall {r}. Reg r a -> RT r) -> RT r)
-> (forall {r}. Reg r a -> RT r) -> RT r
forall a b. (a -> b) -> a -> b
$ \Reg r a
reg ->
    let Internal.Parsec forall r.
State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p = Reg r a -> Parsec b
forall r. Reg r a -> Parsec b
f Reg r a
reg
    in State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st b -> State -> RT r
good Error -> State -> RT r
bad

get :: Reg r a -> Parsec a
get :: forall r a. Reg r a -> Parsec a
get Reg r a
reg = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
_ ->
  do a
x <- Reg r a -> RT a
forall r a. Reg r a -> RT a
readReg Reg r a
reg
     a -> State -> RT r
good a
x State
st

-- parsley provides multiple overloadings...
_gets :: Reg r a -> Parsec (a -> b) -> Parsec b
_gets :: forall r a b. Reg r a -> Parsec (a -> b) -> Parsec b
_gets Reg r a
reg Parsec (a -> b)
pf = Parsec (a -> b)
pf Parsec (a -> b) -> Parsec a -> Parsec b
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reg r a -> Parsec a
forall r a. Reg r a -> Parsec a
get Reg r a
reg

gets :: Reg r a -> (a -> b) -> Parsec b
gets :: forall r a b. Reg r a -> (a -> b) -> Parsec b
gets Reg r a
reg a -> b
f = a -> b
f (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reg r a -> Parsec a
forall r a. Reg r a -> Parsec a
get Reg r a
reg

_put :: Reg r a -> Parsec a -> Parsec ()
_put :: forall r a. Reg r a -> Parsec a -> Parsec ()
_put Reg r a
reg Parsec a
px = Parsec a
px Parsec a -> (a -> Parsec ()) -> Parsec ()
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Reg r a -> a -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r a
reg

put :: Reg r a -> a -> Parsec ()
put :: forall r a. Reg r a -> a -> Parsec ()
put Reg r a
reg a
x = (forall r.
 State -> (() -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec ()
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (() -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec ())
-> (forall r.
    State -> (() -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec ()
forall a b. (a -> b) -> a -> b
$ \State
st () -> State -> RT r
good Error -> State -> RT r
_ ->
  do Reg r a -> a -> RT ()
forall r a. Reg r a -> a -> RT ()
writeReg Reg r a
reg a
x
     () -> State -> RT r
good () State
st

puts :: Reg r b -> (a -> b) -> Parsec a -> Parsec ()
puts :: forall r b a. Reg r b -> (a -> b) -> Parsec a -> Parsec ()
puts Reg r b
reg a -> b
f Parsec a
px = Reg r b -> Parsec b -> Parsec ()
forall r a. Reg r a -> Parsec a -> Parsec ()
_put Reg r b
reg (a -> b
f (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec a
px)

_modify :: Reg r a -> Parsec (a -> a) -> Parsec ()
_modify :: forall r a. Reg r a -> Parsec (a -> a) -> Parsec ()
_modify Reg r a
reg Parsec (a -> a)
pf = Reg r a -> Parsec a -> Parsec ()
forall r a. Reg r a -> Parsec a -> Parsec ()
_put Reg r a
reg (Reg r a -> Parsec (a -> a) -> Parsec a
forall r a b. Reg r a -> Parsec (a -> b) -> Parsec b
_gets Reg r a
reg Parsec (a -> a)
pf)

modify :: Reg r a -> (a -> a) -> Parsec ()
modify :: forall r a. Reg r a -> (a -> a) -> Parsec ()
modify Reg r a
reg a -> a
f = Reg r a -> Parsec a -> Parsec ()
forall r a. Reg r a -> Parsec a -> Parsec ()
_put Reg r a
reg (Reg r a -> (a -> a) -> Parsec a
forall r a b. Reg r a -> (a -> b) -> Parsec b
gets Reg r a
reg a -> a
f)

local :: Reg r a -> (a -> a) -> Parsec b -> Parsec b
local :: forall r a b. Reg r a -> (a -> a) -> Parsec b -> Parsec b
local Reg r a
reg a -> a
f Parsec b
p = do a
x <- Reg r a -> Parsec a
forall r a. Reg r a -> Parsec a
get Reg r a
reg
                   Reg r a -> a -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r a
reg (a -> a
f a
x)
                   Parsec b
p Parsec b -> Parsec () -> Parsec b
forall a b. Parsec a -> Parsec b -> Parsec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Reg r a -> a -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r a
reg a
x

localWith :: Reg r a -> a -> Parsec b -> Parsec b
localWith :: forall r a b. Reg r a -> a -> Parsec b -> Parsec b
localWith Reg r a
reg a
x = Reg r a -> (a -> a) -> Parsec b -> Parsec b
forall r a b. Reg r a -> (a -> a) -> Parsec b -> Parsec b
local Reg r a
reg (a -> a -> a
forall a b. a -> b -> a
const a
x)

_localWith :: Reg r a -> Parsec a -> Parsec b -> Parsec b
_localWith :: forall r a b. Reg r a -> Parsec a -> Parsec b -> Parsec b
_localWith Reg r a
reg Parsec a
px Parsec b
q = Parsec a
px Parsec a -> (a -> Parsec b) -> Parsec b
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Parsec b -> Parsec b) -> Parsec b -> a -> Parsec b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Reg r a -> a -> Parsec b -> Parsec b
forall r a b. Reg r a -> a -> Parsec b -> Parsec b
localWith Reg r a
reg) Parsec b
q

rollback :: Reg r a -> Parsec a -> Parsec a
rollback :: forall r a. Reg r a -> Parsec a -> Parsec a
rollback Reg r a
reg Parsec a
p = Reg r a -> Parsec a
forall r a. Reg r a -> Parsec a
get Reg r a
reg Parsec a -> (a -> Parsec a) -> Parsec a
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Parsec a
p Parsec a -> Parsec a -> Parsec a
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Reg r a -> a -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r a
reg a
x Parsec () -> Parsec a -> Parsec a
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec a
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty)

-- TODO: for combinators