module Data.Attoparsec.Run where

import Data.Attoparsec.Types

import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (intercalate)
import Prelude (Either (..), Eq, Ord, Show, String, IO, Monoid, mempty,
          pure, error, otherwise, null, ($), ($!), (++))
import Control.Monad.State (MonadState)
import qualified Control.Monad.State as State

data FinalResult i a = FinalResult
    i -- ^ Remaining unparsed input
    (Either ParseError a) -- ^ Either an error or a successfully parsed value
    deriving (FinalResult i a -> FinalResult i a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i a.
(Eq i, Eq a) =>
FinalResult i a -> FinalResult i a -> Bool
/= :: FinalResult i a -> FinalResult i a -> Bool
$c/= :: forall i a.
(Eq i, Eq a) =>
FinalResult i a -> FinalResult i a -> Bool
== :: FinalResult i a -> FinalResult i a -> Bool
$c== :: forall i a.
(Eq i, Eq a) =>
FinalResult i a -> FinalResult i a -> Bool
Eq, FinalResult i a -> FinalResult i a -> Bool
FinalResult i a -> FinalResult i a -> Ordering
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
forall {i} {a}. (Ord i, Ord a) => Eq (FinalResult i a)
forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Bool
forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Ordering
forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> FinalResult i a
min :: FinalResult i a -> FinalResult i a -> FinalResult i a
$cmin :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> FinalResult i a
max :: FinalResult i a -> FinalResult i a -> FinalResult i a
$cmax :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> FinalResult i a
>= :: FinalResult i a -> FinalResult i a -> Bool
$c>= :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Bool
> :: FinalResult i a -> FinalResult i a -> Bool
$c> :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Bool
<= :: FinalResult i a -> FinalResult i a -> Bool
$c<= :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Bool
< :: FinalResult i a -> FinalResult i a -> Bool
$c< :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Bool
compare :: FinalResult i a -> FinalResult i a -> Ordering
$ccompare :: forall i a.
(Ord i, Ord a) =>
FinalResult i a -> FinalResult i a -> Ordering
Ord, Int -> FinalResult i a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i a. (Show i, Show a) => Int -> FinalResult i a -> ShowS
forall i a. (Show i, Show a) => [FinalResult i a] -> ShowS
forall i a. (Show i, Show a) => FinalResult i a -> String
showList :: [FinalResult i a] -> ShowS
$cshowList :: forall i a. (Show i, Show a) => [FinalResult i a] -> ShowS
show :: FinalResult i a -> String
$cshow :: forall i a. (Show i, Show a) => FinalResult i a -> String
showsPrec :: Int -> FinalResult i a -> ShowS
$cshowsPrec :: forall i a. (Show i, Show a) => Int -> FinalResult i a -> ShowS
Show)

finalizeResult ::
    IResult i a -- ^ Must be either 'Done' or 'Fail', not 'Partial'
    -> FinalResult i a
finalizeResult :: forall i a. IResult i a -> FinalResult i a
finalizeResult IResult i a
r = case IResult i a
r of
    Done i
remainder a
v ->
        forall i a. i -> Either ParseError a -> FinalResult i a
FinalResult i
remainder (forall a b. b -> Either a b
Right a
v)
    Fail i
remainder [String]
context String
message ->
        forall i a. i -> Either ParseError a -> FinalResult i a
FinalResult i
remainder (forall a b. a -> Either a b
Left ([String] -> String -> ParseError
ParseError [String]
context String
message))
    Partial{} ->
        forall a. HasCallStack => String -> a
error String
"parseWith should not return Partial"

data ParseError = ParseError
    [String] -- ^ A list of contexts in which the error occurred
    String -- ^ The message describing the error, if any
    deriving (ParseError -> ParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Eq ParseError
ParseError -> ParseError -> Bool
ParseError -> ParseError -> Ordering
ParseError -> ParseError -> ParseError
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
min :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmax :: ParseError -> ParseError -> ParseError
>= :: ParseError -> ParseError -> Bool
$c>= :: ParseError -> ParseError -> Bool
> :: ParseError -> ParseError -> Bool
$c> :: ParseError -> ParseError -> Bool
<= :: ParseError -> ParseError -> Bool
$c<= :: ParseError -> ParseError -> Bool
< :: ParseError -> ParseError -> Bool
$c< :: ParseError -> ParseError -> Bool
compare :: ParseError -> ParseError -> Ordering
$ccompare :: ParseError -> ParseError -> Ordering
Ord, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show)

-- | Format a parse error in a matter suitable for displaying in log output
showParseError :: ParseError -> String
showParseError :: ParseError -> String
showParseError (ParseError [String]
context String
message)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
context = String
message
    | Bool
otherwise = forall a. [a] -> [[a]] -> [a]
intercalate String
" > " [String]
context forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message

data BufferedInput m i = BufferedInput
    i -- ^ Initial input
    (m i) -- ^ Get the next chunk of input, or an empty string if the
          --   end of input has been reached

{-| An effectful source of parser input which supports a "restore" operation
    that can be used to push unused portions of input back to the source

For an example, see 'newRestorableIO'. -}
data RestorableInput m i = RestorableInput
    (m i) -- ^ Get the next chunk of input, or an empty string if the
          --   end of input has been reached
    (i -> m ()) -- ^ Restore a non-empty chunk of input to the input stream

{-| Turn any 'IO' input source into a 'RestorableInput'

Internally, this is backed by an 'IORef' that holds any unparsed remainder. -}
newRestorableIO :: IO i -> IO (RestorableInput IO i)
newRestorableIO :: forall i. IO i -> IO (RestorableInput IO i)
newRestorableIO IO i
unbufferedGet = do
    IORef [i]
buffer <- forall a. a -> IO (IORef a)
newIORef [] -- The buffer stores the unparsed inputs
                          -- that have pushed back by "restore".
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i. m i -> (i -> m ()) -> RestorableInput m i
RestorableInput (IORef [i] -> IO i
get IORef [i]
buffer) (forall {a}. IORef [a] -> a -> IO ()
restore IORef [i]
buffer)

  where
    -- Restoring writes an input chunk to the top of the stack.
    restore :: IORef [a] -> a -> IO ()
restore IORef [a]
buffer a
x = do
        [a]
xs <- forall a. IORef a -> IO a
readIORef IORef [a]
buffer
        forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
buffer forall a b. (a -> b) -> a -> b
$! (a
x forall a. a -> [a] -> [a]
: [a]
xs)

    get :: IORef [i] -> IO i
get IORef [i]
buffer = do
        [i]
bufferContent <- forall a. IORef a -> IO a
readIORef IORef [i]
buffer
        case [i]
bufferContent of

            -- If the buffer is empty, then "get" just runs the action.
            [] -> IO i
unbufferedGet

            -- If there is content that has been pushed back onto the
            -- buffer, then "get" pops a chunk off of the stack instead
            -- of running the action.
            (i
x : [i]
xs) -> do
                forall a. IORef a -> a -> IO ()
writeIORef IORef [i]
buffer forall a b. (a -> b) -> a -> b
$! [i]
xs
                forall (f :: * -> *) a. Applicative f => a -> f a
pure i
x

{-| A 'RestorableInput' in which getting and restoring are both backed
    by 'MonadState' operations. -}
inputState :: (Monoid i, MonadState [i] m) => RestorableInput m i
inputState :: forall i (m :: * -> *).
(Monoid i, MonadState [i] m) =>
RestorableInput m i
inputState = forall (m :: * -> *) i. m i -> (i -> m ()) -> RestorableInput m i
RestorableInput m i
get forall {a} {m :: * -> *}. MonadState [a] m => a -> m ()
restore
  where
    get :: m i
get = do
        [i]
xs <- forall s (m :: * -> *). MonadState s m => m s
State.get
        case [i]
xs of
            [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
            (i
x : [i]
xs') -> do
                forall s (m :: * -> *). MonadState s m => s -> m ()
State.put [i]
xs'
                forall (f :: * -> *) a. Applicative f => a -> f a
pure i
x

    restore :: a -> m ()
restore a
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (a
x forall a. a -> [a] -> [a]
:)