module Argo.Internal.Type.Decoder where

import qualified Argo.Internal.Literal as Literal
import qualified Argo.Vendor.ByteString as ByteString
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Functor.Identity as Identity
import qualified Data.Word as Word

type Decoder
    = Trans.StateT
          ByteString.ByteString
          (Trans.ExceptT String Identity.Identity)

unwrap
    :: Decoder a
    -> ByteString.ByteString
    -> Either String (a, ByteString.ByteString)
unwrap :: forall a. Decoder a -> ByteString -> Either String (a, ByteString)
unwrap Decoder a
d = forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Trans.runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Trans.runStateT Decoder a
d

run :: Decoder a -> ByteString.ByteString -> Either String a
run :: forall a. Decoder a -> ByteString -> Either String a
run Decoder a
d = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Decoder a -> ByteString -> Either String (a, ByteString)
unwrap (Decoder a
d forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder ()
eof)

list :: Decoder a -> Decoder [a]
list :: forall a. Decoder a -> Decoder [a]
list Decoder a
f = forall a. Decoder a -> [a] -> Decoder [a]
listWith Decoder a
f []

listWith :: Decoder a -> [a] -> Decoder [a]
listWith :: forall a. Decoder a -> [a] -> Decoder [a]
listWith Decoder a
f [a]
xs = do
    Maybe a
m <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs) forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Decoder ()
word8 Word8
Literal.comma
            Decoder ()
spaces
        Decoder a
f
    case Maybe a
m of
        Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [a]
xs
        Just a
x -> forall a. Decoder a -> [a] -> Decoder [a]
listWith Decoder a
f forall a b. (a -> b) -> a -> b
$ a
x forall a. a -> [a] -> [a]
: [a]
xs

byteString :: ByteString.ByteString -> Decoder ()
byteString :: ByteString -> Decoder ()
byteString ByteString
x = do
    ByteString
b1 <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    case ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
x ByteString
b1 of
        Maybe ByteString
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE forall a b. (a -> b) -> a -> b
$ String
"byteString: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
x
        Just ByteString
b2 -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2

dropWhile :: (Word.Word8 -> Bool) -> Decoder ()
dropWhile :: (Word8 -> Bool) -> Decoder ()
dropWhile Word8 -> Bool
f = do
    ByteString
b <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
ByteString.dropWhile Word8 -> Bool
f ByteString
b

eof :: Decoder ()
eof :: Decoder ()
eof = do
    ByteString
b <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (ByteString -> Bool
ByteString.null ByteString
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"eof"

isDigit :: Word.Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit Word8
x = Word8
Literal.digitZero forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
Literal.digitNine

isSpace :: Word.Word8 -> Bool
isSpace :: Word8 -> Bool
isSpace Word8
x =
    (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.space)
        Bool -> Bool -> Bool
|| (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.horizontalTabulation)
        Bool -> Bool -> Bool
|| (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.newLine)
        Bool -> Bool -> Bool
|| (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.carriageReturn)

satisfy :: (Word.Word8 -> Bool) -> Decoder Word.Word8
satisfy :: (Word8 -> Bool) -> Decoder Word8
satisfy Word8 -> Bool
f = do
    ByteString
b1 <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
b1 of
        Just (Word8
x, ByteString
b2) | Word8 -> Bool
f Word8
x -> do
            forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
x
        Maybe (Word8, ByteString)
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"satisfy"

spaces :: Decoder ()
spaces :: Decoder ()
spaces = (Word8 -> Bool) -> Decoder ()
Argo.Internal.Type.Decoder.dropWhile Word8 -> Bool
isSpace

takeWhile :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString
takeWhile :: (Word8 -> Bool) -> Decoder ByteString
takeWhile Word8 -> Bool
f = do
    ByteString
b1 <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    let (ByteString
x, ByteString
b2) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
f ByteString
b1
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

takeWhile1 :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString
takeWhile1 :: (Word8 -> Bool) -> Decoder ByteString
takeWhile1 Word8 -> Bool
f = do
    ByteString
x <- (Word8 -> Bool) -> Decoder ByteString
Argo.Internal.Type.Decoder.takeWhile Word8 -> Bool
f
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (ByteString -> Bool
ByteString.null ByteString
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"takeWhile1"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

word8 :: Word.Word8 -> Decoder ()
word8 :: Word8 -> Decoder ()
word8 = forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Decoder Word8
satisfy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)