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 :: Decoder a -> ByteString -> Either String (a, ByteString)
unwrap Decoder a
d = Identity (Either String (a, ByteString))
-> Either String (a, ByteString)
forall a. Identity a -> a
Identity.runIdentity (Identity (Either String (a, ByteString))
 -> Either String (a, ByteString))
-> (ByteString -> Identity (Either String (a, ByteString)))
-> ByteString
-> Either String (a, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String Identity (a, ByteString)
-> Identity (Either String (a, ByteString))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Trans.runExceptT (ExceptT String Identity (a, ByteString)
 -> Identity (Either String (a, ByteString)))
-> (ByteString -> ExceptT String Identity (a, ByteString))
-> ByteString
-> Identity (Either String (a, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> ByteString -> ExceptT String Identity (a, ByteString)
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 :: Decoder a -> ByteString -> Either String a
run Decoder a
d = ((a, ByteString) -> a)
-> Either String (a, ByteString) -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ByteString) -> a
forall a b. (a, b) -> a
fst (Either String (a, ByteString) -> Either String a)
-> (ByteString -> Either String (a, ByteString))
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> ByteString -> Either String (a, ByteString)
forall a. Decoder a -> ByteString -> Either String (a, ByteString)
unwrap (Decoder a
d Decoder a
-> StateT ByteString (ExceptT String Identity) () -> Decoder a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT ByteString (ExceptT String Identity) ()
eof)

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

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

byteString :: ByteString.ByteString -> Decoder ()
byteString :: ByteString -> StateT ByteString (ExceptT String Identity) ()
byteString ByteString
x = do
    ByteString
b1 <- StateT ByteString (ExceptT String Identity) ByteString
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 -> ExceptT String Identity ()
-> StateT ByteString (ExceptT String Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity ()
 -> StateT ByteString (ExceptT String Identity) ())
-> (String -> ExceptT String Identity ())
-> String
-> StateT ByteString (ExceptT String Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> StateT ByteString (ExceptT String Identity) ())
-> String -> StateT ByteString (ExceptT String Identity) ()
forall a b. (a -> b) -> a -> b
$ String
"byteString: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
x
        Just ByteString
b2 -> ByteString -> StateT ByteString (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2

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

eof :: Decoder ()
eof :: StateT ByteString (ExceptT String Identity) ()
eof = do
    ByteString
b <- StateT ByteString (ExceptT String Identity) ByteString
forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    Bool
-> StateT ByteString (ExceptT String Identity) ()
-> StateT ByteString (ExceptT String Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (ByteString -> Bool
ByteString.null ByteString
b) (StateT ByteString (ExceptT String Identity) ()
 -> StateT ByteString (ExceptT String Identity) ())
-> (ExceptT String Identity ()
    -> StateT ByteString (ExceptT String Identity) ())
-> ExceptT String Identity ()
-> StateT ByteString (ExceptT String Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String Identity ()
-> StateT ByteString (ExceptT String Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity ()
 -> StateT ByteString (ExceptT String Identity) ())
-> ExceptT String Identity ()
-> StateT ByteString (ExceptT String Identity) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity ()
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
Literal.digitNine

isSpace :: Word.Word8 -> Bool
isSpace :: Word8 -> Bool
isSpace Word8
x =
    (Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.space)
        Bool -> Bool -> Bool
|| (Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.horizontalTabulation)
        Bool -> Bool -> Bool
|| (Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.newLine)
        Bool -> Bool -> Bool
|| (Word8
x Word8 -> Word8 -> Bool
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 <- StateT ByteString (ExceptT String Identity) ByteString
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
            ByteString -> StateT ByteString (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2
            Word8 -> Decoder Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
x
        Maybe (Word8, ByteString)
_ -> ExceptT String Identity Word8 -> Decoder Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity Word8 -> Decoder Word8)
-> ExceptT String Identity Word8 -> Decoder Word8
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity Word8
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"satisfy"

spaces :: Decoder ()
spaces :: StateT ByteString (ExceptT String Identity) ()
spaces = (Word8 -> Bool) -> StateT ByteString (ExceptT String Identity) ()
Argo.Internal.Type.Decoder.dropWhile Word8 -> Bool
isSpace

takeWhile :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString
takeWhile :: (Word8 -> Bool)
-> StateT ByteString (ExceptT String Identity) ByteString
takeWhile Word8 -> Bool
f = do
    ByteString
b1 <- StateT ByteString (ExceptT String Identity) ByteString
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
    ByteString -> StateT ByteString (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2
    ByteString
-> StateT ByteString (ExceptT String Identity) ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

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

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