{-# LANGUAGE BangPatterns #-}

module HaskellWorks.Data.Json.Internal.Slurp
  ( JsonState(..)
  , slurpText
  , slurpNumber
  ) where

import Data.Text
import Data.Word
import Data.Word8
import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8
import Prelude                                               hiding (drop)

import qualified Data.Aeson.Parser.Internal as AP
import qualified Data.Attoparsec.ByteString as PBS
import qualified Data.ByteString            as BS
import qualified Data.Text                  as T

data JsonState
  = Escaped
  | InJson
  | InString
  | InNumber
  | InIdent

-- | Slurp a JSON string
--
-- Examples:
--
-- >>> :set -XOverloadedStrings
-- >>> slurpText "\"Hello\""
-- Right "Hello"
-- >>> slurpText "123"
-- Left "34: Failed reading: satisfy"
slurpText :: BS.ByteString -> Either Text Text
slurpText :: ByteString -> Either Text Text
slurpText ByteString
bs = case Parser Text -> ByteString -> Either String Text
forall a. Parser a -> ByteString -> Either String a
PBS.parseOnly Parser Text
AP.jstring ByteString
bs of
  Right Text
t -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
t
  Left String
e  -> Text -> Either Text Text
forall a b. a -> Either a b
Left (String -> Text
T.pack String
e)

-- | Slurp a JSON number
--
-- Examples:
--
-- >>> :set -XOverloadedStrings
-- >>> slurpNumber "123, true"
-- "123"
-- >>> slurpNumber "\"Hello\""
-- "\"Hello\""
slurpNumber :: BS.ByteString -> BS.ByteString
slurpNumber :: ByteString -> ByteString
slurpNumber ByteString
bs = let (!ByteString
cs, Maybe (JsonState, ByteString)
_) = Int
-> ((JsonState, ByteString)
    -> Maybe (Word8, (JsonState, ByteString)))
-> (JsonState, ByteString)
-> (ByteString, Maybe (JsonState, ByteString))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
bs) (JsonState, ByteString) -> Maybe (Word8, (JsonState, ByteString))
genNumber (JsonState
InJson, ByteString
bs) in ByteString
cs
    where genNumber :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString))
          genNumber :: (JsonState, ByteString) -> Maybe (Word8, (JsonState, ByteString))
genNumber (JsonState
InJson, ByteString
cs) = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (!Word8
d, !ByteString
ds) | Word8 -> Bool
isLeadingDigit Word8
d -> (Word8, (JsonState, ByteString))
-> Maybe (Word8, (JsonState, ByteString))
forall a. a -> Maybe a
Just (Word8
d           , (JsonState
InNumber , ByteString
ds))
            Just (!Word8
d, !ByteString
ds)                    -> (Word8, (JsonState, ByteString))
-> Maybe (Word8, (JsonState, ByteString))
forall a. a -> Maybe a
Just (Word8
d           , (JsonState
InJson   , ByteString
ds))
            Maybe (Word8, ByteString)
Nothing                           -> Maybe (Word8, (JsonState, ByteString))
forall a. Maybe a
Nothing
          genNumber (JsonState
InNumber, ByteString
cs) = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (!Word8
d, !ByteString
ds) | Word8 -> Bool
isTrailingDigit Word8
d -> (Word8, (JsonState, ByteString))
-> Maybe (Word8, (JsonState, ByteString))
forall a. a -> Maybe a
Just (Word8
d           , (JsonState
InNumber , ByteString
ds))
            Just (!Word8
d, !ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_quotedbl    -> (Word8, (JsonState, ByteString))
-> Maybe (Word8, (JsonState, ByteString))
forall a. a -> Maybe a
Just (Word8
_parenleft  , (JsonState
InString , ByteString
ds))
            Maybe (Word8, ByteString)
_                                  -> Maybe (Word8, (JsonState, ByteString))
forall a. Maybe a
Nothing
          genNumber (JsonState
_, ByteString
_) = Maybe (Word8, (JsonState, ByteString))
forall a. Maybe a
Nothing