module Data.Aeson.Micro.Parser where

import           Control.Exception     as E
import           Control.Monad
import           Data.Char
import           Data.Word
import qualified GHC.Foreign           as GHC
import           GHC.IO.Encoding
import           System.IO.Unsafe
import           Text.Read             (readMaybe)

import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS.Char8

decodeEscapedHex :: BS.ByteString -> Maybe Char
decodeEscapedHex :: ByteString -> Maybe Char
decodeEscapedHex ByteString
bs = do
  [0x5c,0x75,d1,d2,d3,d4] <- [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [Word8]
BS.unpack ByteString
bs)

  let cp = (Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
h2n Word8
d1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
d2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
d3)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
d4

  guard (not (0xd800 <= cp && cp <= 0xdfff))

  pure (chr cp)

decodeEscapedHexSurr :: BS.ByteString -> Maybe Char
decodeEscapedHexSurr :: ByteString -> Maybe Char
decodeEscapedHexSurr ByteString
bs = do
  [0x5c,0x75,h1,h2,h3,h4,0x5c,0x75,l1,l2,l3,l4] <- [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [Word8]
BS.unpack ByteString
bs)

  let hsurr = (Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
h2n Word8
h1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
h2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
h3)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
h4
      lsurr = (Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10Int -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
0x10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
h2n Word8
l1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
l2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
l3)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
h2n Word8
l4

  guard ((0xd800 <= hsurr && hsurr <= 0xdbff) && (0xdc00 <= lsurr && lsurr <= 0xdfff))

  let cp = Int
0x10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
hsurrInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
0xd800)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
0x400) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
lsurrInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
0xdc00)

  pure (chr cp)

decodeNumber :: BS.ByteString -> Maybe Double
decodeNumber :: ByteString -> Maybe Double
decodeNumber = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double)
-> (ByteString -> String) -> ByteString -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.Char8.unpack

h2n :: Word8 -> Int
h2n :: Word8 -> Int
h2n Word8
w
  | Word8
0x30 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39  = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
0x30)
  | Word8
0x41 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x46  = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
0x37)
  | Word8
0x61 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x66  = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
0x57)
  | Bool
otherwise               = Int
forall a. HasCallStack => a
undefined

decodeEscaped :: BS.ByteString -> Maybe Char
decodeEscaped :: ByteString -> Maybe Char
decodeEscaped ByteString
bs = do
  [0x5c,c] <- [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [Word8]
BS.unpack ByteString
bs)
  case c of
    Word8
0x22 -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x22'
    Word8
0x5c -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x5c'
    Word8
0x2f -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x2f'
    Word8
0x62 -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x08'
    Word8
0x66 -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x0c'
    Word8
0x6e -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x0a'
    Word8
0x72 -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x0d'
    Word8
0x74 -> Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\x09'
    Word8
_    -> Maybe Char
forall a. Maybe a
Nothing

decodeUnescaped :: BS.ByteString -> Maybe String
decodeUnescaped :: ByteString -> Maybe String
decodeUnescaped = TextEncoding -> ByteString -> Maybe String
decodeString TextEncoding
utf8

decodeString :: TextEncoding -> BS.ByteString -> Maybe String
decodeString :: TextEncoding -> ByteString -> Maybe String
decodeString TextEncoding
te ByteString
bs = IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (TextEncoding -> ByteString -> IO (Maybe String)
decodeStringIO TextEncoding
te ByteString
bs)

{-# NOINLINE decodeStringIO #-}
decodeStringIO :: TextEncoding -> BS.ByteString -> IO (Maybe String)
decodeStringIO :: TextEncoding -> ByteString -> IO (Maybe String)
decodeStringIO TextEncoding
te ByteString
bs = Either IOException String -> Maybe String
forall a. Either IOException a -> Maybe a
cvtEx (Either IOException String -> Maybe String)
-> IO (Either IOException String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> IO (Either IOException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (ByteString -> (CStringLen -> IO String) -> IO String
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs (TextEncoding -> CStringLen -> IO String
GHC.peekCStringLen TextEncoding
te))
  where
    cvtEx :: Either IOException a -> Maybe a
    cvtEx :: forall a. Either IOException a -> Maybe a
cvtEx = (IOException -> Maybe a)
-> (a -> Maybe a) -> Either IOException a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> IOException -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just