{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Json.Arrow
  ( Parser
  , type (~>)
  -- * Run Parser
  , run
  -- * Primitive Parsers
  , object
  , array
  , string
  , strings
  , number
  , boolean
  , null
  -- ** Object Members
  , Members(..)
  , member
  , memberOpt
  , foldMembers
  -- ** Array Elements
  , Elements
  , foldl'
  , map
  -- * Primitive Combinators
  , fail
  , failZero
  -- * Trivial Combinators
  , withObject
  , withArray
  , fromNull
  , int
  , word16
  , word64
  -- * Conversion
  , liftMaybe
  ) where

import Prelude hiding (id, (.), fail, map, null)

import Control.Arrow ((>>>))
import Control.Arrow (Arrow(..))
import Control.Arrow (ArrowZero(..),ArrowPlus(..),ArrowChoice(..),ArrowApply(..))
import Control.Category (Category(..))
import Control.Monad.ST (runST)
import Control.Monad.Trans.Except (ExceptT(ExceptT),runExceptT)
import Data.List (find)
import Data.Number.Scientific (Scientific)
import Data.Primitive (SmallArray)
import Data.Primitive.Unlifted.Array (UnliftedArray)
import Data.Profunctor (Profunctor(..))
import Data.Text.Short (ShortText)
import Data.Word (Word16,Word64)
import Json (Value(Object,Array,String,Number), Member(Member))
import Json.Context (Context(..))
import Json.Errors (Errors)
import Json.Error (Error(..))

import qualified Data.Number.Scientific as SCI
import qualified Data.Primitive.Contiguous as Arr
import qualified Json
import qualified Json.Errors as Errors

newtype Parser a b = P
  { forall a b.
Parser a b -> Context -> a -> Either Errors (Context, b)
unParser :: Context -- ^ reverse list of json keys & indices that have been entered
             -> a -- ^ value to parse
             -> Either Errors (Context, b)
  }
type a ~> b = Parser a b

run :: (a ~> b) -> a -> Either Errors b
run :: forall a b. (a ~> b) -> a -> Either Errors b
run (P Context -> a -> Either Errors (Context, b)
p) a
x = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> a -> Either Errors (Context, b)
p Context
Top a
x

object :: Value ~> Members
object :: Value ~> Members
object = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Object SmallArray Member
membs -> forall a b. b -> Either a b
Right (Context
ctx, SmallArray Member -> Members
Members SmallArray Member
membs)
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected object" Context
ctx))

array :: Value ~> Elements
array :: Value ~> Elements
array = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Array SmallArray Value
membs -> forall a b. b -> Either a b
Right (Context
ctx, SmallArray Value -> Elements
Elements SmallArray Value
membs)
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected array" Context
ctx))

string :: Value ~> ShortText
string :: Value ~> ShortText
string = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  String ShortText
str -> forall a b. b -> Either a b
Right (Context
ctx, ShortText
str)
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected string" Context
ctx))

-- | Parse an array of strings. For example:
--
-- > ["hello","world"]
--
-- Failure context includes the index of non-string value if any values in
-- the array are not strings.
strings :: Value ~> UnliftedArray ShortText
strings :: Value ~> UnliftedArray ShortText
strings = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Array SmallArray Value
membs -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    UnliftedArray ShortText
xs <- forall (m :: * -> *) (arr1 :: * -> *) a (arr2 :: * -> *) b.
(PrimMonad m, Contiguous arr1, Element arr1 a, Contiguous arr2,
 Element arr2 b) =>
(Int -> a -> m b) -> arr1 a -> m (arr2 b)
Arr.itraverseP
      (\Int
ix Value
e -> case Value
e of
        String ShortText
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortText
s
        Value
_ -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected string" (Int -> Context -> Context
Index Int
ix Context
ctx)))))
      ) SmallArray Value
membs
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context
ctx, UnliftedArray ShortText
xs)
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected array" Context
ctx))

number :: Value ~> Scientific
number :: Value ~> Scientific
number = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Number Scientific
n -> forall a b. b -> Either a b
Right (Context
ctx, Scientific
n)
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected number" Context
ctx))

boolean :: Value ~> Bool
boolean :: Value ~> Bool
boolean = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Value
Json.True -> forall a b. b -> Either a b
Right (Context
ctx, Bool
True)
  Value
Json.False -> forall a b. b -> Either a b
Right (Context
ctx, Bool
False)
  Value
_  -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected boolean" Context
ctx))

null :: Value ~> ()
null :: Value ~> ()
null = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Value
v -> case Value
v of
  Value
Json.Null -> forall a b. b -> Either a b
Right (Context
ctx, ())
  Value
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"expected null" Context
ctx))

newtype Members = Members { Members -> SmallArray Member
unMembers :: SmallArray Member }

member :: ShortText -> Members ~> Value
member :: ShortText -> Members ~> Value
member ShortText
k = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Members
xs -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Member -> Bool
keyEq (Members -> SmallArray Member
unMembers Members
xs) of
  Just Member{Value
value :: Member -> Value
value :: Value
value} -> forall a b. b -> Either a b
Right (ShortText -> Context -> Context
Key ShortText
k Context
ctx, Value
value)
  Maybe Member
Nothing -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error (ShortText
"key not found: " forall a. Semigroup a => a -> a -> a
<> ShortText
k) Context
ctx))
  where
  keyEq :: Member -> Bool
keyEq Member{ShortText
key :: Member -> ShortText
key :: ShortText
key} = ShortText
k forall a. Eq a => a -> a -> Bool
== ShortText
key

-- | An optional member. Returns Nothing if the value is missing.
memberOpt :: ShortText -> Members ~> Maybe Value
memberOpt :: ShortText -> Members ~> Maybe Value
memberOpt ShortText
k = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Members
xs -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Member -> Bool
keyEq (Members -> SmallArray Member
unMembers Members
xs) of
  Just Member{Value
value :: Value
value :: Member -> Value
value} -> forall a b. b -> Either a b
Right (ShortText -> Context -> Context
Key ShortText
k Context
ctx, forall a. a -> Maybe a
Just Value
value)
  Maybe Member
Nothing -> forall a b. b -> Either a b
Right (Context
ctx, forall a. Maybe a
Nothing)
  where
  keyEq :: Member -> Bool
keyEq Member{ShortText
key :: ShortText
key :: Member -> ShortText
key} = ShortText
k forall a. Eq a => a -> a -> Bool
== ShortText
key

foldMembers :: a -> (a -> Member ~> a) -> Members ~> a
foldMembers :: forall a. a -> (a -> Member ~> a) -> Members ~> a
foldMembers a
z0 a -> Member ~> a
f = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Members
membs ->
  let xs :: SmallArray Member
xs = Members -> SmallArray Member
unMembers Members
membs
      loop :: a -> Int -> Either Errors (Context, a)
loop !a
z !Int
i =
        if Int
i forall a. Ord a => a -> a -> Bool
< forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
Arr.size SmallArray Member
xs
        then
          let x :: Member
x@Member{ShortText
key :: ShortText
key :: Member -> ShortText
key} = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Arr.index SmallArray Member
xs Int
i
           in case forall a b.
Parser a b -> Context -> a -> Either Errors (Context, b)
unParser (a -> Member ~> a
f a
z) (ShortText -> Context -> Context
Key ShortText
key Context
ctx) Member
x of
                Right (Context
_, a
z') -> a -> Int -> Either Errors (Context, a)
loop a
z' (Int
i forall a. Num a => a -> a -> a
+ Int
1)
                Left Errors
err -> forall a b. a -> Either a b
Left Errors
err
        else forall a b. b -> Either a b
Right (Context
ctx, a
z)
   in a -> Int -> Either Errors (Context, a)
loop a
z0 Int
0

newtype Elements = Elements { Elements -> SmallArray Value
unElements :: SmallArray Value }

foldl' :: a -> (a -> Value ~> a) -> Elements ~> a
foldl' :: forall a. a -> (a -> Value ~> a) -> Elements ~> a
foldl' a
z0 a -> Value ~> a
f = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx Elements
elems ->
  let xs :: SmallArray Value
xs = Elements -> SmallArray Value
unElements Elements
elems
      loop :: a -> Int -> Either Errors (Context, a)
loop !a
z !Int
i =
        if Int
i forall a. Ord a => a -> a -> Bool
< forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
Arr.size SmallArray Value
xs
        then case forall a b.
Parser a b -> Context -> a -> Either Errors (Context, b)
unParser (a -> Value ~> a
f a
z) (Int -> Context -> Context
Index Int
i Context
ctx) (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Arr.index SmallArray Value
xs Int
i) of
          Right (Context
_, a
z') -> a -> Int -> Either Errors (Context, a)
loop a
z' (Int
i forall a. Num a => a -> a -> a
+ Int
1)
          Left Errors
err -> forall a b. a -> Either a b
Left Errors
err
        else forall a b. b -> Either a b
Right (Context
ctx, a
z)
   in a -> Int -> Either Errors (Context, a)
loop a
z0 Int
0

map :: (Value ~> a) -> Elements ~> SmallArray a
map :: forall a. (Value ~> a) -> Elements ~> SmallArray a
map (P Context -> Value -> Either Errors (Context, a)
p) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx (Elements SmallArray Value
xs) -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let !len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray Value
xs
  Mutable SmallArray (PrimState (ST s)) a
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
Arr.new Int
len
  let loop :: Int -> ST s (Either Errors ())
loop !Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Int
len
        then case Context -> Value -> Either Errors (Context, a)
p (Int -> Context -> Context
Index Int
i Context
ctx) (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Arr.index SmallArray Value
xs Int
i) of
          Right (Context
_, a
y) -> do
            forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
Arr.write Mutable SmallArray (PrimState (ST s)) a
dst Int
i a
y
            Int -> ST s (Either Errors ())
loop (Int
i forall a. Num a => a -> a -> a
+ Int
1)
          Left Errors
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errors
err
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
  Int -> ST s (Either Errors ())
loop Int
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right ()
_ -> do
      SmallArray a
ys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
Arr.unsafeFreeze Mutable SmallArray (PrimState (ST s)) a
dst
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Context
ctx, SmallArray a
ys)
    Left Errors
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errors
err

instance Functor (Parser a) where
  fmap :: forall a b. (a -> b) -> Parser a a -> Parser a b
fmap a -> b
f (P Context -> a -> Either Errors (Context, a)
p) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> case Context -> a -> Either Errors (Context, a)
p Context
ctx a
x of
    Right (Context
ctx', a
y) -> forall a b. b -> Either a b
Right (Context
ctx', a -> b
f a
y)
    Left Errors
err -> forall a b. a -> Either a b
Left Errors
err

instance Profunctor Parser where
  dimap :: forall a b c d. (a -> b) -> (c -> d) -> Parser b c -> Parser a d
dimap a -> b
g c -> d
f (P Context -> b -> Either Errors (Context, c)
p) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> case Context -> b -> Either Errors (Context, c)
p Context
ctx (a -> b
g a
x) of
    Right (Context
ctx', c
y) -> forall a b. b -> Either a b
Right (Context
ctx', c -> d
f c
y)
    Left Errors
err -> forall a b. a -> Either a b
Left Errors
err

instance Applicative (Parser a) where
  pure :: forall a. a -> Parser a a
pure a
x = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
_ -> forall a b. b -> Either a b
Right (Context
ctx, a
x)
  (P Context -> a -> Either Errors (Context, a -> b)
p) <*> :: forall a b. Parser a (a -> b) -> Parser a a -> Parser a b
<*> (P Context -> a -> Either Errors (Context, a)
q) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> case (Context -> a -> Either Errors (Context, a -> b)
p Context
ctx a
x, Context -> a -> Either Errors (Context, a)
q Context
ctx a
x) of
    (Right (Context
_, a -> b
f), Right (Context
_, a
y)) -> forall a b. b -> Either a b
Right (Context
ctx, a -> b
f a
y)
    (Left Errors
err, Either Errors (Context, a)
_) -> forall a b. a -> Either a b
Left Errors
err
    (Either Errors (Context, a -> b)
_, Left Errors
err) -> forall a b. a -> Either a b
Left Errors
err

instance Category Parser where
  id :: forall a. Parser a a
id = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> forall a b. b -> Either a b
Right (Context
ctx, a
x)
  (P Context -> b -> Either Errors (Context, c)
q) . :: forall b c a. Parser b c -> Parser a b -> Parser a c
. (P Context -> a -> Either Errors (Context, b)
p) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> case Context -> a -> Either Errors (Context, b)
p Context
ctx a
x of
    Right (Context
ctx', b
y) -> Context -> b -> Either Errors (Context, c)
q Context
ctx' b
y
    Left Errors
err -> forall a b. a -> Either a b
Left Errors
err

instance Arrow Parser where
  arr :: forall b c. (b -> c) -> Parser b c
arr b -> c
f = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx b
x -> forall a b. b -> Either a b
Right (Context
ctx, b -> c
f b
x)
  (P Context -> b -> Either Errors (Context, c)
p) *** :: forall b c b' c'.
Parser b c -> Parser b' c' -> Parser (b, b') (c, c')
*** (P Context -> b' -> Either Errors (Context, c')
q) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx (b
x, b'
y) -> case (Context -> b -> Either Errors (Context, c)
p Context
ctx b
x, Context -> b' -> Either Errors (Context, c')
q Context
ctx b'
y) of
    (Right (Context
_, c
x'), Right (Context
_, c'
y')) -> forall a b. b -> Either a b
Right (Context
ctx, (c
x', c'
y'))
    (Left Errors
err, Either Errors (Context, c')
_) -> forall a b. a -> Either a b
Left Errors
err
    (Either Errors (Context, c)
_, Left Errors
err) -> forall a b. a -> Either a b
Left Errors
err

instance ArrowZero Parser where
  zeroArrow :: forall b c. Parser b c
zeroArrow = forall b c. Parser b c
failZero

instance ArrowPlus Parser where
  (P Context -> b -> Either Errors (Context, c)
p) <+> :: forall b c. Parser b c -> Parser b c -> Parser b c
<+> (P Context -> b -> Either Errors (Context, c)
q) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx b
x -> case Context -> b -> Either Errors (Context, c)
p Context
ctx b
x of
    Right (Context, c)
success -> forall a b. b -> Either a b
Right (Context, c)
success
    Left Errors
errLeft -> case Context -> b -> Either Errors (Context, c)
q Context
ctx b
x of
      Right (Context, c)
success -> forall a b. b -> Either a b
Right (Context, c)
success
      Left Errors
errRight -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! (Errors
errLeft forall a. Semigroup a => a -> a -> a
<> Errors
errRight)

instance ArrowChoice Parser where
  (P Context -> b -> Either Errors (Context, c)
p) +++ :: forall b c b' c'.
Parser b c -> Parser b' c' -> Parser (Either b b') (Either c c')
+++ (P Context -> b' -> Either Errors (Context, c')
q) = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx -> \case
    Left b
x -> case Context -> b -> Either Errors (Context, c)
p Context
ctx b
x of
      Right (Context
ctx', c
y) -> forall a b. b -> Either a b
Right (Context
ctx', forall a b. a -> Either a b
Left c
y)
      Left Errors
err -> forall a b. a -> Either a b
Left Errors
err
    Right b'
x -> case Context -> b' -> Either Errors (Context, c')
q Context
ctx b'
x of
      Right (Context
ctx', c'
y) -> forall a b. b -> Either a b
Right (Context
ctx', forall a b. b -> Either a b
Right c'
y)
      Left Errors
err -> forall a b. a -> Either a b
Left Errors
err

instance ArrowApply Parser where
  app :: forall b c. Parser (Parser b c, b) c
app = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx (Parser b c
p, b
x) -> forall a b.
Parser a b -> Context -> a -> Either Errors (Context, b)
unParser Parser b c
p Context
ctx b
x

fail :: ShortText -> a ~> b
fail :: forall a b. ShortText -> a ~> b
fail ShortText
msg = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
msg Context
ctx))

failZero :: a ~> b
failZero :: forall b c. Parser b c
failZero = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
_ -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
"" Context
ctx))

liftMaybe ::
     ShortText -- ^ Message to display on decode error
  -> (a -> Maybe b) -- ^ Decode function
  -> a ~> b
liftMaybe :: forall a b. ShortText -> (a -> Maybe b) -> a ~> b
liftMaybe ShortText
msg a -> Maybe b
f = forall a b.
(Context -> a -> Either Errors (Context, b)) -> Parser a b
P forall a b. (a -> b) -> a -> b
$ \Context
ctx a
x -> case a -> Maybe b
f a
x of
  Just b
y -> forall a b. b -> Either a b
Right (Context
ctx, b
y)
  Maybe b
Nothing -> forall a b. a -> Either a b
Left (Error -> Errors
Errors.singleton (ShortText -> Context -> Error
Error ShortText
msg Context
ctx))

withObject :: (Members ~> a) -> Value ~> a
withObject :: forall a. (Members ~> a) -> Value ~> a
withObject Members ~> a
membParser = Value ~> Members
object forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Members ~> a
membParser

withArray :: (Value ~> a) -> Value ~> SmallArray a
withArray :: forall a. (Value ~> a) -> Value ~> SmallArray a
withArray Value ~> a
elemParser = Value ~> Elements
array forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. (Value ~> a) -> Elements ~> SmallArray a
map Value ~> a
elemParser

int :: Value ~> Int
int :: Value ~> Int
int = Value ~> Scientific
number forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. ShortText -> (a -> Maybe b) -> a ~> b
liftMaybe ShortText
"number too big" Scientific -> Maybe Int
SCI.toInt

word16 :: Value ~> Word16
word16 :: Value ~> Word16
word16 = Value ~> Scientific
number forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. ShortText -> (a -> Maybe b) -> a ~> b
liftMaybe ShortText
"number too big" Scientific -> Maybe Word16
SCI.toWord16

word64 :: Value ~> Word64
word64 :: Value ~> Word64
word64 = Value ~> Scientific
number forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. ShortText -> (a -> Maybe b) -> a ~> b
liftMaybe ShortText
"number too big" Scientific -> Maybe Word64
SCI.toWord64

fromNull :: a -> Value ~> a
fromNull :: forall a. a -> Value ~> a
fromNull a
z = Value ~> ()
null forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
z