module Argo.Decoder where

import qualified Argo.Literal as Literal
import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Array as Array
import qualified Data.ByteString as ByteString
import qualified Data.Word as Word

newtype Decoder a = Decoder
    { Decoder a -> ByteString -> Maybe (ByteString, a)
run :: ByteString.ByteString -> Maybe (ByteString.ByteString, a)
    }

instance Functor Decoder where
    fmap :: (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f Decoder a
d = (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, b)) -> Decoder b)
-> (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a b. (a -> b) -> a -> b
$ \ ByteString
b1 -> case Decoder a -> ByteString -> Maybe (ByteString, a)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder a
d ByteString
b1 of
        Maybe (ByteString, a)
Nothing -> Maybe (ByteString, b)
forall a. Maybe a
Nothing
        Just (ByteString
b2, a
x) -> (ByteString, b) -> Maybe (ByteString, b)
forall a. a -> Maybe a
Just (ByteString
b2, a -> b
f a
x)

instance Applicative Decoder where
    pure :: a -> Decoder a
pure a
x = (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, a)) -> Decoder a)
-> (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \ ByteString
b -> (ByteString, a) -> Maybe (ByteString, a)
forall a. a -> Maybe a
Just (ByteString
b, a
x)
    Decoder (a -> b)
df <*> :: Decoder (a -> b) -> Decoder a -> Decoder b
<*> Decoder a
dx = (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, b)) -> Decoder b)
-> (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a b. (a -> b) -> a -> b
$ \ ByteString
b1 -> case Decoder (a -> b) -> ByteString -> Maybe (ByteString, a -> b)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder (a -> b)
df ByteString
b1 of
        Maybe (ByteString, a -> b)
Nothing -> Maybe (ByteString, b)
forall a. Maybe a
Nothing
        Just (ByteString
b2, a -> b
f) -> case Decoder a -> ByteString -> Maybe (ByteString, a)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder a
dx ByteString
b2 of
            Maybe (ByteString, a)
Nothing -> Maybe (ByteString, b)
forall a. Maybe a
Nothing
            Just (ByteString
b3, a
x) -> (ByteString, b) -> Maybe (ByteString, b)
forall a. a -> Maybe a
Just (ByteString
b3, a -> b
f a
x)

instance Monad Decoder where
    Decoder a
d >>= :: Decoder a -> (a -> Decoder b) -> Decoder b
>>= a -> Decoder b
f = (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, b)) -> Decoder b)
-> (ByteString -> Maybe (ByteString, b)) -> Decoder b
forall a b. (a -> b) -> a -> b
$ \ ByteString
b1 -> case Decoder a -> ByteString -> Maybe (ByteString, a)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder a
d ByteString
b1 of
        Maybe (ByteString, a)
Nothing -> Maybe (ByteString, b)
forall a. Maybe a
Nothing
        Just (ByteString
b2, a
x) -> Decoder b -> ByteString -> Maybe (ByteString, b)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run (a -> Decoder b
f a
x) ByteString
b2

instance MonadFail Decoder where
    fail :: String -> Decoder a
fail String
_ = (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, a)) -> Decoder a)
-> (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a b. (a -> b) -> a -> b
$ Maybe (ByteString, a) -> ByteString -> Maybe (ByteString, a)
forall a b. a -> b -> a
const Maybe (ByteString, a)
forall a. Maybe a
Nothing

instance Applicative.Alternative Decoder where
    empty :: Decoder a
empty = String -> Decoder a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
    Decoder a
dx <|> :: Decoder a -> Decoder a -> Decoder a
<|> Decoder a
dy = (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, a)) -> Decoder a)
-> (ByteString -> Maybe (ByteString, a)) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \ ByteString
b1 -> case Decoder a -> ByteString -> Maybe (ByteString, a)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder a
dx ByteString
b1 of
        Maybe (ByteString, a)
Nothing -> Decoder a -> ByteString -> Maybe (ByteString, a)
forall a. Decoder a -> ByteString -> Maybe (ByteString, a)
run Decoder a
dy ByteString
b1
        Just (ByteString
b2, a
x) -> (ByteString, a) -> Maybe (ByteString, a)
forall a. a -> Maybe a
Just (ByteString
b2, a
x)

array :: Decoder a -> Decoder (Array.Array Int a)
array :: Decoder a -> Decoder (Array Int a)
array Decoder a
f = Decoder a -> Int -> [(Int, a)] -> Decoder (Array Int a)
forall a. Decoder a -> Int -> [(Int, a)] -> Decoder (Array Int a)
arrayWith Decoder a
f Int
0 []

arrayWith :: Decoder a -> Int -> [(Int, a)] -> Decoder (Array.Array Int a)
arrayWith :: Decoder a -> Int -> [(Int, a)] -> Decoder (Array Int a)
arrayWith Decoder a
f Int
n [(Int, a)]
xs = do
    Maybe a
m <- Decoder a -> Decoder (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional (Decoder a -> Decoder (Maybe a)) -> Decoder a -> Decoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Decoder () -> Decoder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Decoder () -> Decoder ()) -> Decoder () -> Decoder ()
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 -> Array Int a -> Decoder (Array Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array Int a -> Decoder (Array Int a))
-> Array Int a -> Decoder (Array Int a)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [(Int, a)] -> Array Int a
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(Int, a)]
xs
        Just a
x -> Decoder a -> Int -> [(Int, a)] -> Decoder (Array Int a)
forall a. Decoder a -> Int -> [(Int, a)] -> Decoder (Array Int a)
arrayWith Decoder a
f (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([(Int, a)] -> Decoder (Array Int a))
-> [(Int, a)] -> Decoder (Array Int a)
forall a b. (a -> b) -> a -> b
$ (Int
n, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
xs

byteString :: ByteString.ByteString -> Decoder ()
byteString :: ByteString -> Decoder ()
byteString ByteString
x = do
    ByteString
b1 <- Decoder ByteString
get
    case ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
x ByteString
b1 of
        Maybe ByteString
Nothing -> String -> Decoder ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder ()) -> String -> Decoder ()
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 -> Decoder ()
put ByteString
b2

dropWhile :: (Word.Word8 -> Bool) -> Decoder ()
dropWhile :: (Word8 -> Bool) -> Decoder ()
dropWhile Word8 -> Bool
f = do
    ByteString
b <- Decoder ByteString
get
    ByteString -> Decoder ()
put (ByteString -> Decoder ()) -> ByteString -> Decoder ()
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 <- Decoder ByteString
get
    Bool -> Decoder () -> Decoder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (ByteString -> Bool
ByteString.null ByteString
b) (Decoder () -> Decoder ()) -> Decoder () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"eof"

get :: Decoder ByteString.ByteString
get :: Decoder ByteString
get = (ByteString -> Maybe (ByteString, ByteString))
-> Decoder ByteString
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, ByteString))
 -> Decoder ByteString)
-> (ByteString -> Maybe (ByteString, ByteString))
-> Decoder ByteString
forall a b. (a -> b) -> a -> b
$ \ ByteString
b -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
b, ByteString
b)

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

put :: ByteString.ByteString -> Decoder ()
put :: ByteString -> Decoder ()
put ByteString
b = (ByteString -> Maybe (ByteString, ())) -> Decoder ()
forall a. (ByteString -> Maybe (ByteString, a)) -> Decoder a
Decoder ((ByteString -> Maybe (ByteString, ())) -> Decoder ())
-> (ByteString -> Maybe (ByteString, ())) -> Decoder ()
forall a b. (a -> b) -> a -> b
$ \ ByteString
_ -> (ByteString, ()) -> Maybe (ByteString, ())
forall a. a -> Maybe a
Just (ByteString
b, ())

satisfy :: (Word.Word8 -> Bool) -> Decoder Word.Word8
satisfy :: (Word8 -> Bool) -> Decoder Word8
satisfy Word8 -> Bool
f = do
    ByteString
b1 <- Decoder ByteString
get
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
b1 of
        Just (Word8
x, ByteString
b2) | Word8 -> Bool
f Word8
x -> do
            ByteString -> Decoder ()
put ByteString
b2
            Word8 -> Decoder Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
x
        Maybe (Word8, ByteString)
_ -> String -> Decoder Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfy"

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

takeWhile :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString
takeWhile :: (Word8 -> Bool) -> Decoder ByteString
takeWhile Word8 -> Bool
f = do
    ByteString
b1 <- Decoder ByteString
get
    let (ByteString
x, ByteString
b2) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
f ByteString
b1
    ByteString -> Decoder ()
put ByteString
b2
    ByteString -> Decoder ByteString
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.Decoder.takeWhile Word8 -> Bool
f
    Bool -> Decoder () -> Decoder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (ByteString -> Bool
ByteString.null ByteString
x) (Decoder () -> Decoder ()) -> Decoder () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"takeWhile1"
    ByteString -> Decoder ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

word8 :: Word.Word8 -> Decoder ()
word8 :: Word8 -> Decoder ()
word8 = Decoder Word8 -> Decoder ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Decoder Word8 -> Decoder ())
-> (Word8 -> Decoder Word8) -> Word8 -> Decoder ()
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
(==)