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
  [Word8
0x5c,Word8
0x75,Word8
d1,Word8
d2,Word8
d3,Word8
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
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

  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Int
0xd800 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cp Bool -> Bool -> Bool
&& Int
cp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdfff))

  Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
chr Int
cp)

decodeEscapedHexSurr :: BS.ByteString -> Maybe Char
decodeEscapedHexSurr :: ByteString -> Maybe Char
decodeEscapedHexSurr ByteString
bs = do
  [Word8
0x5c,Word8
0x75,Word8
h1,Word8
h2,Word8
h3,Word8
h4,Word8
0x5c,Word8
0x75,Word8
l1,Word8
l2,Word8
l3,Word8
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
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
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

  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Int
0xd800 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hsurr Bool -> Bool -> Bool
&& Int
hsurr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdbff) Bool -> Bool -> Bool
&& (Int
0xdc00 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lsurr Bool -> Bool -> Bool
&& Int
lsurr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdfff))

  let cp :: Int
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)

  Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
chr Int
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
  [Word8
0x5c,Word8
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 Word8
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