{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Hermes.Decoder.Internal
( DecoderM(..)
, DecoderPrimM(..)
, HermesEnv(..)
, HermesException(..)
, DocumentError(..)
, Path(..)
, Decoder(..)
, asks
, local
, decodeEither
, decodeEitherIO
, mkHermesEnv
, mkHermesEnv_
, withHermesEnv
, withHermesEnv_
, typePrefix
, handleErrorCode
, parseByteString
, parseByteStringIO
, liftIO
, withRunInIO
) where
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(..))
import Control.Exception (Exception, catch, throwIO, try)
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT(..))
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Foreign.C as F
import qualified Foreign.ForeignPtr as F
import GHC.Generics (Generic)
import qualified System.IO.Unsafe as Unsafe
import Data.Hermes.SIMDJSON.Bindings (getDocumentValueImpl, getErrorMessageImpl)
import Data.Hermes.SIMDJSON.Types
( Document(..)
, Parser(..)
, SIMDDocument
, SIMDErrorCode(..)
, SIMDParser
, Value(..)
)
import Data.Hermes.SIMDJSON.Wrapper
newtype DecoderM a = DecoderM { forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM :: ReaderT HermesEnv IO a }
deriving newtype (forall a b. a -> DecoderM b -> DecoderM a
forall a b. (a -> b) -> DecoderM a -> DecoderM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DecoderM b -> DecoderM a
$c<$ :: forall a b. a -> DecoderM b -> DecoderM a
fmap :: forall a b. (a -> b) -> DecoderM a -> DecoderM b
$cfmap :: forall a b. (a -> b) -> DecoderM a -> DecoderM b
Functor, Functor DecoderM
forall a. a -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM b
forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DecoderM a -> DecoderM b -> DecoderM a
$c<* :: forall a b. DecoderM a -> DecoderM b -> DecoderM a
*> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
$c*> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
liftA2 :: forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DecoderM a -> DecoderM b -> DecoderM c
<*> :: forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
$c<*> :: forall a b. DecoderM (a -> b) -> DecoderM a -> DecoderM b
pure :: forall a. a -> DecoderM a
$cpure :: forall a. a -> DecoderM a
Applicative, Applicative DecoderM
forall a. a -> DecoderM a
forall a b. DecoderM a -> DecoderM b -> DecoderM b
forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DecoderM a
$creturn :: forall a. a -> DecoderM a
>> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
$c>> :: forall a b. DecoderM a -> DecoderM b -> DecoderM b
>>= :: forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
$c>>= :: forall a b. DecoderM a -> (a -> DecoderM b) -> DecoderM b
Monad)
instance Alternative DecoderM where
empty :: forall a. DecoderM a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unspecified error"
{-# INLINE (<|>) #-}
DecoderM a
ad <|> :: forall a. DecoderM a -> DecoderM a -> DecoderM a
<|> DecoderM a
bd = forall b. ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. DecoderM a -> IO a
u -> forall a. DecoderM a -> IO a
u DecoderM a
ad forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(HermesException
_err :: HermesException) -> forall a. DecoderM a -> IO a
u DecoderM a
bd)
instance MonadFail DecoderM where
{-# INLINE fail #-}
fail :: forall a. String -> DecoderM a
fail = forall a. Text -> DecoderM a
throwHermes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
newtype DecoderPrimM a = DecoderPrimM { forall a. DecoderPrimM a -> DecoderM a
runDecoderPrimM :: DecoderM a }
deriving newtype (forall a b. a -> DecoderPrimM b -> DecoderPrimM a
forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DecoderPrimM b -> DecoderPrimM a
$c<$ :: forall a b. a -> DecoderPrimM b -> DecoderPrimM a
fmap :: forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
$cfmap :: forall a b. (a -> b) -> DecoderPrimM a -> DecoderPrimM b
Functor, Functor DecoderPrimM
forall a. a -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
$c<* :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM a
*> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
$c*> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
liftA2 :: forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM c
<*> :: forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
$c<*> :: forall a b.
DecoderPrimM (a -> b) -> DecoderPrimM a -> DecoderPrimM b
pure :: forall a. a -> DecoderPrimM a
$cpure :: forall a. a -> DecoderPrimM a
Applicative, Applicative DecoderPrimM
forall a. a -> DecoderPrimM a
forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DecoderPrimM a
$creturn :: forall a. a -> DecoderPrimM a
>> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
$c>> :: forall a b. DecoderPrimM a -> DecoderPrimM b -> DecoderPrimM b
>>= :: forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
$c>>= :: forall a b.
DecoderPrimM a -> (a -> DecoderPrimM b) -> DecoderPrimM b
Monad)
instance PrimMonad DecoderPrimM where
type PrimState DecoderPrimM = PrimState (ReaderT HermesEnv IO)
primitive :: forall a.
(State# (PrimState DecoderPrimM)
-> (# State# (PrimState DecoderPrimM), a #))
-> DecoderPrimM a
primitive = forall a. DecoderM a -> DecoderPrimM a
DecoderPrimM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
{-# INLINE primitive #-}
data HermesEnv =
HermesEnv
{ HermesEnv -> ForeignPtr SIMDParser
hParser :: !(F.ForeignPtr SIMDParser)
, HermesEnv -> ForeignPtr SIMDDocument
hDocument :: !(F.ForeignPtr SIMDDocument)
, HermesEnv -> [Path]
hPath :: ![Path]
} deriving (HermesEnv -> HermesEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HermesEnv -> HermesEnv -> Bool
$c/= :: HermesEnv -> HermesEnv -> Bool
== :: HermesEnv -> HermesEnv -> Bool
$c== :: HermesEnv -> HermesEnv -> Bool
Eq, forall x. Rep HermesEnv x -> HermesEnv
forall x. HermesEnv -> Rep HermesEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HermesEnv x -> HermesEnv
$cfrom :: forall x. HermesEnv -> Rep HermesEnv x
Generic)
instance NFData HermesEnv where
rnf :: HermesEnv -> ()
rnf HermesEnv{[Path]
ForeignPtr SIMDDocument
ForeignPtr SIMDParser
hPath :: [Path]
hDocument :: ForeignPtr SIMDDocument
hParser :: ForeignPtr SIMDParser
hPath :: HermesEnv -> [Path]
hDocument :: HermesEnv -> ForeignPtr SIMDDocument
hParser :: HermesEnv -> ForeignPtr SIMDParser
..} = forall a. NFData a => a -> ()
rnf [Path]
hPath seq :: forall a b. a -> b -> b
`seq` ()
data Path =
Key !Text
| Idx !Int
| Pointer !Text
deriving (Path -> Path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic)
instance NFData Path
newtype Decoder a = Decoder { forall a. Decoder a -> Value -> DecoderM a
runDecoder :: Value -> DecoderM a }
instance Functor Decoder where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f Decoder a
d = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
d Value
val
instance Applicative Decoder where
{-# INLINE pure #-}
pure :: forall a. a -> Decoder a
pure a
a = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE (<*>) #-}
(Decoder Value -> DecoderM (a -> b)
f) <*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
<*> (Decoder Value -> DecoderM a
e) = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM (a -> b)
f Value
val forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> DecoderM a
e Value
val
instance Monad Decoder where
{-# INLINE return #-}
return :: forall a. a -> Decoder a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
(Decoder Value -> DecoderM a
d) >>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
>>= a -> Decoder b
f = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> do
a
x <- Value -> DecoderM a
d Value
val
forall a. Decoder a -> Value -> DecoderM a
runDecoder (a -> Decoder b
f a
x) Value
val
instance Alternative Decoder where
{-# INLINE (<|>) #-}
(Decoder Value -> DecoderM a
a) <|> :: forall a. Decoder a -> Decoder a -> Decoder a
<|> (Decoder Value -> DecoderM a
b) = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
val -> Value -> DecoderM a
a Value
val forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> DecoderM a
b Value
val
{-# INLINE empty #-}
empty :: forall a. Decoder a
empty = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty
instance MonadFail Decoder where
{-# INLINE fail #-}
fail :: forall a. String -> Decoder a
fail String
e = forall a. (Value -> DecoderM a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
decodeEither :: Decoder a -> BS.ByteString -> Either HermesException a
decodeEither :: forall a. Decoder a -> ByteString -> Either HermesException a
decodeEither Decoder a
d ByteString
bs = forall a. IO a -> a
Unsafe.unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. Decoder a -> ByteString -> IO a
decodeEitherIO Decoder a
d ByteString
bs
{-# NOINLINE decodeEither #-}
decodeEitherIO :: Decoder a -> BS.ByteString -> IO a
decodeEitherIO :: forall a. Decoder a -> ByteString -> IO a
decodeEitherIO Decoder a
d ByteString
bs = forall a. (HermesEnv -> IO a) -> IO a
withHermesEnv_ forall a b. (a -> b) -> a -> b
$ \HermesEnv
hEnv -> forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs
parseByteString :: HermesEnv -> Decoder a -> BS.ByteString -> Either HermesException a
parseByteString :: forall a.
HermesEnv -> Decoder a -> ByteString -> Either HermesException a
parseByteString HermesEnv
hEnv Decoder a
d ByteString
bs = forall a. IO a -> a
Unsafe.unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs
{-# NOINLINE parseByteString #-}
parseByteStringIO :: HermesEnv -> Decoder a -> BS.ByteString -> IO a
parseByteStringIO :: forall a. HermesEnv -> Decoder a -> ByteString -> IO a
parseByteStringIO HermesEnv
hEnv Decoder a
d ByteString
bs =
forall a. (Value -> IO a) -> IO a
allocaValue forall a b. (a -> b) -> a -> b
$ \Value
valPtr ->
forall a. ByteString -> (InputBuffer -> IO a) -> IO a
withInputBuffer ByteString
bs forall a b. (a -> b) -> a -> b
$ \InputBuffer
inputPtr -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr (HermesEnv -> ForeignPtr SIMDParser
hParser HermesEnv
hEnv) forall a b. (a -> b) -> a -> b
$ \Ptr SIMDParser
parserPtr ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr (HermesEnv -> ForeignPtr SIMDDocument
hDocument HermesEnv
hEnv) forall a b. (a -> b) -> a -> b
$ \Ptr SIMDDocument
docPtr -> do
CInt
err <- Parser -> InputBuffer -> Document -> Value -> IO CInt
getDocumentValueImpl (Ptr SIMDParser -> Parser
Parser Ptr SIMDParser
parserPtr) InputBuffer
inputPtr (Ptr SIMDDocument -> Document
Document Ptr SIMDDocument
docPtr) Value
valPtr
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HermesEnv
hEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM forall a b. (a -> b) -> a -> b
$ do
Text -> CInt -> DecoderM ()
handleErrorCode Text
"" CInt
err
forall a. Decoder a -> Value -> DecoderM a
runDecoder Decoder a
d Value
valPtr
mkHermesEnv :: Maybe Int -> IO HermesEnv
mkHermesEnv :: Maybe Int -> IO HermesEnv
mkHermesEnv Maybe Int
mCapacity = do
ForeignPtr SIMDParser
parser <- Maybe Int -> IO (ForeignPtr SIMDParser)
mkSIMDParser Maybe Int
mCapacity
ForeignPtr SIMDDocument
document <- IO (ForeignPtr SIMDDocument)
mkSIMDDocument
forall (f :: * -> *) a. Applicative f => a -> f a
pure HermesEnv
{ hParser :: ForeignPtr SIMDParser
hParser = ForeignPtr SIMDParser
parser
, hDocument :: ForeignPtr SIMDDocument
hDocument = ForeignPtr SIMDDocument
document
, hPath :: [Path]
hPath = []
}
mkHermesEnv_ :: IO HermesEnv
mkHermesEnv_ :: IO HermesEnv
mkHermesEnv_ = Maybe Int -> IO HermesEnv
mkHermesEnv forall a. Maybe a
Nothing
withHermesEnv :: Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv :: forall a. Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv Maybe Int
mCapacity HermesEnv -> IO a
f = Maybe Int -> IO HermesEnv
mkHermesEnv Maybe Int
mCapacity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HermesEnv -> IO a
f
withHermesEnv_ :: (HermesEnv -> IO a) -> IO a
withHermesEnv_ :: forall a. (HermesEnv -> IO a) -> IO a
withHermesEnv_ = forall a. Maybe Int -> (HermesEnv -> IO a) -> IO a
withHermesEnv forall a. Maybe a
Nothing
data HermesException =
SIMDException !DocumentError
| InternalException !DocumentError
deriving stock (HermesException -> HermesException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HermesException -> HermesException -> Bool
$c/= :: HermesException -> HermesException -> Bool
== :: HermesException -> HermesException -> Bool
$c== :: HermesException -> HermesException -> Bool
Eq, Int -> HermesException -> ShowS
[HermesException] -> ShowS
HermesException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HermesException] -> ShowS
$cshowList :: [HermesException] -> ShowS
show :: HermesException -> String
$cshow :: HermesException -> String
showsPrec :: Int -> HermesException -> ShowS
$cshowsPrec :: Int -> HermesException -> ShowS
Show, forall x. Rep HermesException x -> HermesException
forall x. HermesException -> Rep HermesException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HermesException x -> HermesException
$cfrom :: forall x. HermesException -> Rep HermesException x
Generic)
instance Exception HermesException
instance NFData HermesException
data DocumentError =
DocumentError
{ DocumentError -> Text
path :: !Text
, DocumentError -> Text
errorMsg :: !Text
}
deriving stock (DocumentError -> DocumentError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentError -> DocumentError -> Bool
$c/= :: DocumentError -> DocumentError -> Bool
== :: DocumentError -> DocumentError -> Bool
$c== :: DocumentError -> DocumentError -> Bool
Eq, Int -> DocumentError -> ShowS
[DocumentError] -> ShowS
DocumentError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentError] -> ShowS
$cshowList :: [DocumentError] -> ShowS
show :: DocumentError -> String
$cshow :: DocumentError -> String
showsPrec :: Int -> DocumentError -> ShowS
$cshowsPrec :: Int -> DocumentError -> ShowS
Show, forall x. Rep DocumentError x -> DocumentError
forall x. DocumentError -> Rep DocumentError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DocumentError x -> DocumentError
$cfrom :: forall x. DocumentError -> Rep DocumentError x
Generic)
instance NFData DocumentError
typePrefix :: Text -> Text
typePrefix :: Text -> Text
typePrefix Text
typ = Text
"Error while getting value of type " forall a. Semigroup a => a -> a -> a
<> Text
typ forall a. Semigroup a => a -> a -> a
<> Text
". "
{-# INLINE typePrefix #-}
throwSIMD :: Text -> DecoderM a
throwSIMD :: forall a. Text -> DecoderM a
throwSIMD Text
msg = do
Text
pth <- [Path] -> Text
formatPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> [Path]
hPath
forall a. IO a -> DecoderM a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentError -> HermesException
SIMDException forall a b. (a -> b) -> a -> b
$ Text -> Text -> DocumentError
DocumentError Text
pth Text
msg
throwHermes :: Text -> DecoderM a
throwHermes :: forall a. Text -> DecoderM a
throwHermes Text
msg = do
Text
pth <- [Path] -> Text
formatPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> [Path]
hPath
forall a. IO a -> DecoderM a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentError -> HermesException
InternalException forall a b. (a -> b) -> a -> b
$ Text -> Text -> DocumentError
DocumentError Text
pth Text
msg
formatPath :: [Path] -> Text
formatPath :: [Path] -> Text
formatPath [Path]
dl =
case [Path]
els of
[] -> Text
""
[Path]
xs -> [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path -> Text
escapeKey [Path]
xs
where
els :: [Path]
els = forall a. [a] -> [a]
reverse [Path]
dl
escapeKey :: Path -> Text
escapeKey (Key Text
txt) = Text
"/" forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
txt
escapeKey (Idx Int
int) = Text
"/" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
int)
escapeKey (Pointer Text
p) = Text
p
escChar :: Char -> Text
escChar Char
'/' = Text
"~1"
escChar Char
'~' = Text
"~0"
escChar Char
x = Char -> Text
T.singleton Char
x
handleErrorCode :: Text -> F.CInt -> DecoderM ()
handleErrorCode :: Text -> CInt -> DecoderM ()
handleErrorCode Text
pre CInt
errInt = do
let errCode :: SIMDErrorCode
errCode = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
errInt
if SIMDErrorCode
errCode forall a. Eq a => a -> a -> Bool
== SIMDErrorCode
SUCCESS
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else do
String
errStr <- forall a. IO a -> DecoderM a
liftIO forall a b. (a -> b) -> a -> b
$ CString -> IO String
F.peekCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> IO CString
getErrorMessageImpl CInt
errInt
forall a. Text -> DecoderM a
throwSIMD forall a b. (a -> b) -> a -> b
$ Text
pre forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
errStr
{-# INLINE handleErrorCode #-}
withRunInIO :: ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO :: forall b. ((forall a. DecoderM a -> IO a) -> IO b) -> DecoderM b
withRunInIO (forall a. DecoderM a -> IO a) -> IO b
inner =
forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \HermesEnv
r ->
(forall a. DecoderM a -> IO a) -> IO b
inner (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HermesEnv
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecoderM a -> ReaderT HermesEnv IO a
runDecoderM)
{-# INLINE withRunInIO #-}
liftIO :: IO a -> DecoderM a
liftIO :: forall a. IO a -> DecoderM a
liftIO = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
{-# INLINE liftIO #-}
asks :: (HermesEnv -> a) -> DecoderM a
asks :: forall a. (HermesEnv -> a) -> DecoderM a
asks HermesEnv -> a
f = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. HermesEnv -> a
f
{-# INLINE asks #-}
local :: (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local :: forall a. (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local HermesEnv -> HermesEnv
f (DecoderM ReaderT HermesEnv IO a
m) = forall a. ReaderT HermesEnv IO a -> DecoderM a
DecoderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT HermesEnv IO a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. HermesEnv -> HermesEnv
f
{-# INLINE local #-}