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
(Either ParseError a)
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
-> 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]
String
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)
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
(m i)
data RestorableInput m i = RestorableInput
(m i)
(i -> m ())
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 []
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
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
[] -> IO i
unbufferedGet
(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
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]
:)