{-|
Module      : Parsley.Register
Description : The register combinators
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : stable

This module exposes combinators designed to work with /registers/. These are small pieces of state
that are carried through the parsing process. They can be used, for example, to perform indentation
sensitive parsing. In fact, they are a flexible replacement for the monadic combinators, in conjunction
with the "Parsley.Selective" combinators. In particular, the `bind` combinator implements a limited form
of the @(>>=)@ operation, where the structure of the resulting parser will still be statically
determinable. Registers paired with "Parsley.Selective" combinators are Turing-Compete.

@since 0.1.0.0
-}
module Parsley.Register (
    Reg, newRegister, get, put,
    newRegister_,
    put_,
    gets, gets_,
    modify, modify_,
    move, swap,
    local, local_,
    localModify, localModify_,
    bind, rollback,
    for
  ) where

import Prelude hiding      (pure, (<*>), (*>), (<*))
import Parsley.Alternative (empty, (<|>))
import Parsley.Applicative (pure, (<*>), (*>), (<*))
import Parsley.Internal    (Parser, Reg)
import Parsley.ParserOps   (ParserOps)
import Parsley.Selective   (when, while)

import qualified Parsley.Internal as Internal (newRegister, get, put)

{-|
Creates a new register initialised with the value obtained from parsing the first
argument. This register is provided to the second argument, a function that generates a parser
depending on operations derived from the register. This parser is then performed.

Note: The rank-2 type here serves a similar purpose to that in the @ST@ monad. It prevents the
register from leaking outside of the scope of the function, safely encapsulating the stateful
effect of the register.

@since 0.1.0.0
-}
newRegister :: Parser a                        -- ^ Parser with which to initialise the register
            -> (forall r. Reg r a -> Parser b) -- ^ Used to generate the second parser to execute
            -> Parser b
newRegister :: forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister = forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
Internal.newRegister

{-|
Fetches a value from a register and returns it as its result.

@since 0.1.0.0
-}
get :: Reg r a -> Parser a
get :: forall r a. Reg r a -> Parser a
get = forall r a. Reg r a -> Parser a
Internal.get

{-|
Puts the result of the given parser into the given register. The old value in the register will be
lost.

@since 0.1.0.0
-}
put :: Reg r a -> Parser a -> Parser ()
put :: forall r a. Reg r a -> Parser a -> Parser ()
put = forall r a. Reg r a -> Parser a -> Parser ()
Internal.put

{-|
Like `newRegister`, except the initial value of the register is seeded from a pure value as opposed
to the result of a parser.

@since 0.1.0.0
-}
newRegister_ :: ParserOps rep => rep a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister_ :: forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister_ rep a
x = forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister (forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure rep a
x)

{-|
Like `put`, except the new value of the register is a pure value as opposed to the result of a parser.

@since 0.1.0.0
-}
put_ :: ParserOps rep => Reg r a -> rep a -> Parser ()
put_ :: forall (rep :: Type -> Type) r a.
ParserOps rep =>
Reg r a -> rep a -> Parser ()
put_ Reg r a
r = forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure

{-|
@gets reg p@ first parses @p@ to get as a result, function @f@. Then, taking into account any changes
made during @p@, the value is fetched from @reg@ and applied to @f@.

@since 0.1.0.0
-}
gets :: Reg r a -> Parser (a -> b) -> Parser b
gets :: forall r a b. Reg r a -> Parser (a -> b) -> Parser b
gets Reg r a
r Parser (a -> b)
p = Parser (a -> b)
p forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> forall r a. Reg r a -> Parser a
get Reg r a
r

{-|
Like `gets`, except the adapter function is a pure argument as opposed to the result of a parser.

@since 0.1.0.0
-}
gets_ :: ParserOps rep => Reg r a -> rep (a -> b) -> Parser b
gets_ :: forall (rep :: Type -> Type) r a b.
ParserOps rep =>
Reg r a -> rep (a -> b) -> Parser b
gets_ Reg r a
r = forall r a b. Reg r a -> Parser (a -> b) -> Parser b
gets Reg r a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure

{-|
@modify reg p@ first parses @p@ to collect the function @f@, then taking into account any changes
made during @f@, the value in @reg@ is modified using the function @f@ and put back into it.

@since 0.1.0.0
-}
modify :: Reg r a -> Parser (a -> a) -> Parser ()
modify :: forall r a. Reg r a -> Parser (a -> a) -> Parser ()
modify Reg r a
r Parser (a -> a)
p = forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r (forall r a b. Reg r a -> Parser (a -> b) -> Parser b
gets Reg r a
r Parser (a -> a)
p)

{-|
Like `modify`, except the modification function is a pure argument as opposed to the result of a parser.

@since 0.1.0.0
-}
modify_ :: ParserOps rep => Reg r a -> rep (a -> a) -> Parser ()
modify_ :: forall (rep :: Type -> Type) r a.
ParserOps rep =>
Reg r a -> rep (a -> a) -> Parser ()
modify_ Reg r a
r = forall r a. Reg r a -> Parser (a -> a) -> Parser ()
modify Reg r a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure

{-|
@move dst src@ takes the value stored in @src@ and additionally stores it into @dst@.

@since 0.1.0.0
-}
move :: Reg r1 a -> Reg r2 a -> Parser ()
move :: forall r1 a r2. Reg r1 a -> Reg r2 a -> Parser ()
move Reg r1 a
dst Reg r2 a
src = forall r a. Reg r a -> Parser a -> Parser ()
put Reg r1 a
dst (forall r a. Reg r a -> Parser a
get Reg r2 a
src)

{-|
This combinator uses registers to emulate a restricted form of @(`>>=`)@: in a traditional monadic
setting, this would be considered to be the implementation:

> bind p f = p >>= f . pure

Essentially, the result of @p@ is available to be summoned purely as many times as needed. However,
it cannot be used to dynamically create structure: the selective combinators can be used to provide
that functionality partially.

@since 0.1.0.0
-}
bind :: Parser a -> (Parser a -> Parser b) -> Parser b
bind :: forall a b. Parser a -> (Parser a -> Parser b) -> Parser b
bind Parser a
p Parser a -> Parser b
f = forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister Parser a
p (Parser a -> Parser b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a. Reg r a -> Parser a
get)

{-|
@local reg p q@ first parses @p@ and stores its value in @reg@ for the /duration/ of parsing @q@.
If @q@ succeeds, @reg@ will be restored to its original state /before/ @p@ was parsed.

@since 0.1.0.0
-}
local :: Reg r a -> Parser a -> Parser b -> Parser b
local :: forall r a b. Reg r a -> Parser a -> Parser b -> Parser b
local Reg r a
r Parser a
p Parser b
q = forall a b. Parser a -> (Parser a -> Parser b) -> Parser b
bind (forall r a. Reg r a -> Parser a
get Reg r a
r) forall a b. (a -> b) -> a -> b
$ \Parser a
x -> forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r Parser a
p
                                forall a b. Parser a -> Parser b -> Parser b
*> Parser b
q
                                forall a b. Parser a -> Parser b -> Parser a
<* forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r Parser a
x

{-|
@local_ reg x p@ stores @x@ in @reg@ for the /duration/ of parsing @p@.
If @p@ succeeds, @reg@ will be restored to its original state.

@since 1.0.2.0
-}
local_ :: ParserOps rep => Reg r a -> rep a -> Parser b -> Parser b
local_ :: forall (rep :: Type -> Type) r a b.
ParserOps rep =>
Reg r a -> rep a -> Parser b -> Parser b
local_ Reg r a
r = forall r a b. Reg r a -> Parser a -> Parser b -> Parser b
local Reg r a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure

{-|
@localModify reg p q@ first parses @p@ and @reg@ with its returned function for the /duration/ of parsing @q@.
If @q@ succeeds, @reg@ will be restored to its original state /before/ @p@ was parsed.

@since 1.0.2.0
-}
localModify :: Reg r a -> Parser (a -> a) -> Parser b -> Parser b
localModify :: forall r a b. Reg r a -> Parser (a -> a) -> Parser b -> Parser b
localModify Reg r a
r Parser (a -> a)
p Parser b
q = forall a b. Parser a -> (Parser a -> Parser b) -> Parser b
bind (forall r a. Reg r a -> Parser a
get Reg r a
r) forall a b. (a -> b) -> a -> b
$ \Parser a
x -> forall r a. Reg r a -> Parser (a -> a) -> Parser ()
modify Reg r a
r Parser (a -> a)
p
                                forall a b. Parser a -> Parser b -> Parser b
*> Parser b
q
                                forall a b. Parser a -> Parser b -> Parser a
<* forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r Parser a
x

{-|
@localModify_ reg x p@ modifes @reg@ using @f@ for the /duration/ of parsing @p@.
If @p@ succeeds, @reg@ will be restored to its original state.

@since 1.0.2.0
-}
localModify_ :: ParserOps rep => Reg r a -> rep (a -> a) -> Parser b -> Parser b
localModify_ :: forall (rep :: Type -> Type) r a b.
ParserOps rep =>
Reg r a -> rep (a -> a) -> Parser b -> Parser b
localModify_ Reg r a
r = forall r a b. Reg r a -> Parser (a -> a) -> Parser b -> Parser b
localModify Reg r a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure

{-|
This combinator will swap the values contained in two registers.

@since 0.1.0.0
-}
swap :: Reg r1 a -> Reg r2 a -> Parser ()
swap :: forall r1 a r2. Reg r1 a -> Reg r2 a -> Parser ()
swap Reg r1 a
r1 Reg r2 a
r2 = forall a b. Parser a -> (Parser a -> Parser b) -> Parser b
bind (forall r a. Reg r a -> Parser a
get Reg r1 a
r1) forall a b. (a -> b) -> a -> b
$ \Parser a
x -> forall r1 a r2. Reg r1 a -> Reg r2 a -> Parser ()
move Reg r1 a
r1 Reg r2 a
r2
                                forall a b. Parser a -> Parser b -> Parser b
*> forall r a. Reg r a -> Parser a -> Parser ()
put Reg r2 a
r2 Parser a
x

{-|
@rollback reg p@ will perform @p@ and if it fails without consuming input, @reg@ will be restored
to its original state from /before/ @p@ was parsed, and the combinator will fail. If @p@ succeeds
the state in @reg@ will not be restored to an old version.

@since 0.1.0.0
-}
rollback :: Reg r a -> Parser b -> Parser b
rollback :: forall r a b. Reg r a -> Parser b -> Parser b
rollback Reg r a
r Parser b
p = forall a b. Parser a -> (Parser a -> Parser b) -> Parser b
bind (forall r a. Reg r a -> Parser a
get Reg r a
r) forall a b. (a -> b) -> a -> b
$ \Parser a
x -> Parser b
p forall a. Parser a -> Parser a -> Parser a
<|> forall r a. Reg r a -> Parser a -> Parser ()
put Reg r a
r Parser a
x forall a b. Parser a -> Parser b -> Parser b
*> forall a. Parser a
empty

{-|
This combinator is like a traditional imperative-style @for@-loop. Given @for init cond step body@,
@init@ is first parsed to initialise a register called @i@; the parser @cond@ is then performed to
check that the value in @i@ adheres to the predicate it returns; if so, then the @body@ is parsed,
@step@ modifies the state in @i@, and then the process repeats from @cond@ again. When @cond@ returns
@False@ for the predicate applied to @i@'s state, the loop terminates gracefully. If any component
of this parser fails the loop will fail.

@since 0.1.0.0
-}
for :: Parser a -> Parser (a -> Bool) -> Parser (a -> a) -> Parser () -> Parser ()
for :: forall a.
Parser a
-> Parser (a -> Bool) -> Parser (a -> a) -> Parser () -> Parser ()
for Parser a
init Parser (a -> Bool)
cond Parser (a -> a)
step Parser ()
body =
  forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister Parser a
init forall a b. (a -> b) -> a -> b
$ \Reg r a
i ->
    let cond' :: Parser Bool
        cond' :: Parser Bool
cond' = forall r a b. Reg r a -> Parser (a -> b) -> Parser b
gets Reg r a
i Parser (a -> Bool)
cond
    in Parser Bool -> Parser () -> Parser ()
when Parser Bool
cond' (Parser Bool -> Parser ()
while (Parser ()
body forall a b. Parser a -> Parser b -> Parser b
*> forall r a. Reg r a -> Parser (a -> a) -> Parser ()
modify Reg r a
i Parser (a -> a)
step forall a b. Parser a -> Parser b -> Parser b
*> Parser Bool
cond'))