{-# LANGUAGE DeriveDataTypeable, UnboxedTuples, MagicHash,
             BangPatterns, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.JSString.Internal.Type ( JSString(..)
                                   , empty
                                   , empty_
                                   , safe
                                   , firstf
                                   ) where

                                     {-
    -- * Construction
    , text
    , textP
    -- * Safety
    , safe
    -- * Code that must be here for accessibility
    , empty
    , empty_
    -- * Utilities
    , firstf
    -- * Checked multiplication
    , mul
    , mul32
    , mul64
    -- * Debugging
    , showText

                                   ) where
-}

import Prelude ()
import Prelude.Compat

import Control.DeepSeq

import Data.Coerce                    (coerce)
import Data.Text                      (Text)
import qualified Data.Text as T       (empty)
import Data.String                    (IsString)
import Data.Aeson                     (ToJSON(..), FromJSON(..))
import Data.Data                      (Data)
-- import Data.Text.Internal.Unsafe.Char (ord)
import Data.Typeable                  (Typeable)
import GHC.Exts                       (Char(..), ord#, andI#, (/=#), isTrue#)

-- | A wrapper around a JavaScript string
newtype JSString = JSString Text deriving(Int -> JSString -> ShowS
[JSString] -> ShowS
JSString -> String
(Int -> JSString -> ShowS)
-> (JSString -> String) -> ([JSString] -> ShowS) -> Show JSString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSString -> ShowS
showsPrec :: Int -> JSString -> ShowS
$cshow :: JSString -> String
show :: JSString -> String
$cshowList :: [JSString] -> ShowS
showList :: [JSString] -> ShowS
Show, ReadPrec [JSString]
ReadPrec JSString
Int -> ReadS JSString
ReadS [JSString]
(Int -> ReadS JSString)
-> ReadS [JSString]
-> ReadPrec JSString
-> ReadPrec [JSString]
-> Read JSString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JSString
readsPrec :: Int -> ReadS JSString
$creadList :: ReadS [JSString]
readList :: ReadS [JSString]
$creadPrec :: ReadPrec JSString
readPrec :: ReadPrec JSString
$creadListPrec :: ReadPrec [JSString]
readListPrec :: ReadPrec [JSString]
Read, String -> JSString
(String -> JSString) -> IsString JSString
forall a. (String -> a) -> IsString a
$cfromString :: String -> JSString
fromString :: String -> JSString
IsString, NonEmpty JSString -> JSString
JSString -> JSString -> JSString
(JSString -> JSString -> JSString)
-> (NonEmpty JSString -> JSString)
-> (forall b. Integral b => b -> JSString -> JSString)
-> Semigroup JSString
forall b. Integral b => b -> JSString -> JSString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: JSString -> JSString -> JSString
<> :: JSString -> JSString -> JSString
$csconcat :: NonEmpty JSString -> JSString
sconcat :: NonEmpty JSString -> JSString
$cstimes :: forall b. Integral b => b -> JSString -> JSString
stimes :: forall b. Integral b => b -> JSString -> JSString
Semigroup, Semigroup JSString
JSString
Semigroup JSString =>
JSString
-> (JSString -> JSString -> JSString)
-> ([JSString] -> JSString)
-> Monoid JSString
[JSString] -> JSString
JSString -> JSString -> JSString
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: JSString
mempty :: JSString
$cmappend :: JSString -> JSString -> JSString
mappend :: JSString -> JSString -> JSString
$cmconcat :: [JSString] -> JSString
mconcat :: [JSString] -> JSString
Monoid, Eq JSString
Eq JSString =>
(JSString -> JSString -> Ordering)
-> (JSString -> JSString -> Bool)
-> (JSString -> JSString -> Bool)
-> (JSString -> JSString -> Bool)
-> (JSString -> JSString -> Bool)
-> (JSString -> JSString -> JSString)
-> (JSString -> JSString -> JSString)
-> Ord JSString
JSString -> JSString -> Bool
JSString -> JSString -> Ordering
JSString -> JSString -> JSString
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSString -> JSString -> Ordering
compare :: JSString -> JSString -> Ordering
$c< :: JSString -> JSString -> Bool
< :: JSString -> JSString -> Bool
$c<= :: JSString -> JSString -> Bool
<= :: JSString -> JSString -> Bool
$c> :: JSString -> JSString -> Bool
> :: JSString -> JSString -> Bool
$c>= :: JSString -> JSString -> Bool
>= :: JSString -> JSString -> Bool
$cmax :: JSString -> JSString -> JSString
max :: JSString -> JSString -> JSString
$cmin :: JSString -> JSString -> JSString
min :: JSString -> JSString -> JSString
Ord, JSString -> JSString -> Bool
(JSString -> JSString -> Bool)
-> (JSString -> JSString -> Bool) -> Eq JSString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSString -> JSString -> Bool
== :: JSString -> JSString -> Bool
$c/= :: JSString -> JSString -> Bool
/= :: JSString -> JSString -> Bool
Eq, Typeable JSString
Typeable JSString =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JSString -> c JSString)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JSString)
-> (JSString -> Constr)
-> (JSString -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JSString))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSString))
-> ((forall b. Data b => b -> b) -> JSString -> JSString)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JSString -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JSString -> r)
-> (forall u. (forall d. Data d => d -> u) -> JSString -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JSString -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JSString -> m JSString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JSString -> m JSString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JSString -> m JSString)
-> Data JSString
JSString -> Constr
JSString -> DataType
(forall b. Data b => b -> b) -> JSString -> JSString
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JSString -> u
forall u. (forall d. Data d => d -> u) -> JSString -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSString
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSString -> c JSString
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JSString)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSString)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSString -> c JSString
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSString -> c JSString
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSString
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSString
$ctoConstr :: JSString -> Constr
toConstr :: JSString -> Constr
$cdataTypeOf :: JSString -> DataType
dataTypeOf :: JSString -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JSString)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JSString)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSString)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSString)
$cgmapT :: (forall b. Data b => b -> b) -> JSString -> JSString
gmapT :: (forall b. Data b => b -> b) -> JSString -> JSString
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JSString -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JSString -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JSString -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JSString -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JSString -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSString -> m JSString
Data, [JSString] -> Value
[JSString] -> Encoding
JSString -> Bool
JSString -> Value
JSString -> Encoding
(JSString -> Value)
-> (JSString -> Encoding)
-> ([JSString] -> Value)
-> ([JSString] -> Encoding)
-> (JSString -> Bool)
-> ToJSON JSString
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: JSString -> Value
toJSON :: JSString -> Value
$ctoEncoding :: JSString -> Encoding
toEncoding :: JSString -> Encoding
$ctoJSONList :: [JSString] -> Value
toJSONList :: [JSString] -> Value
$ctoEncodingList :: [JSString] -> Encoding
toEncodingList :: [JSString] -> Encoding
$comitField :: JSString -> Bool
omitField :: JSString -> Bool
ToJSON, Maybe JSString
Value -> Parser [JSString]
Value -> Parser JSString
(Value -> Parser JSString)
-> (Value -> Parser [JSString])
-> Maybe JSString
-> FromJSON JSString
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser JSString
parseJSON :: Value -> Parser JSString
$cparseJSONList :: Value -> Parser [JSString]
parseJSONList :: Value -> Parser [JSString]
$comittedField :: Maybe JSString
omittedField :: Maybe JSString
FromJSON, Typeable)

instance NFData JSString where rnf :: JSString -> ()
rnf !JSString
_ = ()

-- | /O(1)/ The empty 'JSString'.
empty :: JSString
empty :: JSString
empty = Text -> JSString
forall a b. Coercible a b => a -> b
coerce Text
T.empty
{-# INLINE [1] empty #-}

-- | A non-inlined version of 'empty'.
empty_ :: JSString
empty_ :: JSString
empty_ = Text -> JSString
forall a b. Coercible a b => a -> b
coerce Text
T.empty
{-# NOINLINE empty_ #-}

safe :: Char -> Char
safe :: Char -> Char
safe c :: Char
c@(C# Char#
cc)
    | Int# -> Bool
isTrue# (Int# -> Int# -> Int#
andI# (Char# -> Int#
ord# Char#
cc) Int#
0x1ff800# Int# -> Int# -> Int#
/=# Int#
0xd800#) = Char
c
    | Bool
otherwise                    = Char
'\xfffd'
{-# INLINE [0] safe #-}


-- | Apply a function to the first element of an optional pair.
firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
firstf :: forall a c b. (a -> c) -> Maybe (a, b) -> Maybe (c, b)
firstf a -> c
f (Just (a
a, b
b)) = (c, b) -> Maybe (c, b)
forall a. a -> Maybe a
Just (a -> c
f a
a, b
b)
firstf a -> c
_  Maybe (a, b)
Nothing      = Maybe (c, b)
forall a. Maybe a
Nothing

{-
-- | Checked multiplication.  Calls 'error' if the result would
-- overflow.
mul :: Int -> Int -> Int
#if WORD_SIZE_IN_BITS == 64
mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
#else
mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
#endif
{-# INLINE mul #-}
infixl 7 `mul`

-- | Checked multiplication.  Calls 'error' if the result would
-- overflow.
mul64 :: Int64 -> Int64 -> Int64
mul64 a b
  | a >= 0 && b >= 0 =  mul64_ a b
  | a >= 0           = -mul64_ a (-b)
  | b >= 0           = -mul64_ (-a) b
  | otherwise        =  mul64_ (-a) (-b)
{-# INLINE mul64 #-}
infixl 7 `mul64`

mul64_ :: Int64 -> Int64 -> Int64
mul64_ a b
  | ahi > 0 && bhi > 0 = error "overflow"
  | top > 0x7fffffff   = error "overflow"
  | total < 0          = error "overflow"
  | otherwise          = total
  where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
        (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
        top            = ahi * blo + alo * bhi
        total          = (top `shiftL` 32) + alo * blo
{-# INLINE mul64_ #-}

-- | Checked multiplication.  Calls 'error' if the result would
-- overflow.
mul32 :: Int32 -> Int32 -> Int32
mul32 a b = case fromIntegral a * fromIntegral b of
              ab | ab < min32 || ab > max32 -> error "overflow"
                 | otherwise                -> fromIntegral ab
  where min32 = -0x80000000 :: Int64
        max32 =  0x7fffffff
{-# INLINE mul32 #-}
infixl 7 `mul32`
-}