{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Lens.Micro.Aeson
(
AsNumber(..)
, _Integral
, nonNull
, AsValue(..)
, key, members
, nth, values
, AsJSON(..)
) where
import Data.Aeson
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as Strict
import Data.ByteString.Lazy.Char8 as Lazy
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import Data.Text as Text
import qualified Data.Text.Encoding as StrictText
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import Data.Vector (Vector)
import qualified Data.Vector as V
import Lens.Micro
import Lens.Micro.Aeson.Internal ()
import Prelude
#if !MIN_VERSION_aeson(2,2,0)
import Data.Aeson.Parser (value)
import Data.Attoparsec.ByteString.Lazy (maybeResult, parse)
#endif
class AsNumber t where
_Number :: Traversal' t Scientific
default _Number :: AsValue t => Traversal' t Scientific
_Number = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Traversal' t Scientific
_Number
{-# INLINE _Number #-}
_Double :: Traversal' t Double
_Double = forall t. AsNumber t => Traversal' t Scientific
_Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (forall a b. a -> b -> a
const forall a b. (Real a, Fractional b) => a -> b
realToFrac)
{-# INLINE _Double #-}
_Integer :: Traversal' t Integer
_Integer = forall t. AsNumber t => Traversal' t Scientific
_Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. a -> b -> a
const forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE _Integer #-}
instance AsNumber Value where
_Number :: Traversal' Value Scientific
_Number Scientific -> f Scientific
f (Number Scientific
n) = Scientific -> Value
Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> f Scientific
f Scientific
n
_Number Scientific -> f Scientific
_ Value
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _Number #-}
instance AsNumber Scientific where
_Number :: Traversal' Scientific Scientific
_Number = forall a. a -> a
id
{-# INLINE _Number #-}
instance AsNumber Strict.ByteString
instance AsNumber Lazy.ByteString
instance AsNumber Text
instance AsNumber LazyText.Text
instance AsNumber String
_Integral :: (AsNumber t, Integral a) => Traversal' t a
_Integral :: forall t a. (AsNumber t, Integral a) => Traversal' t a
_Integral = forall t. AsNumber t => Traversal' t Scientific
_Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. a -> b -> a
const forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE _Integral #-}
nonNull :: Traversal' Value Value
nonNull :: Traversal' Value Value
nonNull Value -> f Value
_ Value
Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
nonNull Value -> f Value
f Value
v = forall t. AsValue t => Traversal' t Value
_Value Value -> f Value
f Value
v
{-# INLINE nonNull #-}
class AsNumber t => AsValue t where
_Value :: Traversal' t Value
_String :: Traversal' t Text
_String = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}.
Applicative f =>
(Text -> f Text) -> Value -> f Value
trav
where trav :: (Text -> f Text) -> Value -> f Value
trav Text -> f Text
f (String Text
s) = Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
s
trav Text -> f Text
_ Value
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _String #-}
_Bool :: Traversal' t Bool
_Bool = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}.
Applicative f =>
(Bool -> f Bool) -> Value -> f Value
trav
where trav :: (Bool -> f Bool) -> Value -> f Value
trav Bool -> f Bool
f (Bool Bool
b) = Bool -> Value
Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
b
trav Bool -> f Bool
_ Value
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _Bool #-}
_Null :: Traversal' t ()
_Null = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(() -> f b) -> Value -> f Value
trav
where trav :: (() -> f b) -> Value -> f Value
trav () -> f b
f Value
Null = Value
Null forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> f b
f ()
trav () -> f b
_ Value
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _Null #-}
_Object :: Traversal' t (KM.KeyMap Value)
_Object = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. \KeyMap Value -> f (KeyMap Value)
f Value
v -> case Value
v of Object KeyMap Value
o -> KeyMap Value -> Value
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value -> f (KeyMap Value)
f KeyMap Value
o; Value
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _Object #-}
_Array :: Traversal' t (Vector Value)
_Array = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Vector Value -> f (Vector Value)
f Value
v -> case Value
v of Array Vector Value
a -> Vector Value -> Value
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Value -> f (Vector Value)
f Vector Value
a; Value
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _Array #-}
instance AsValue Value where
_Value :: Traversal' Value Value
_Value = forall a. a -> a
id
{-# INLINE _Value #-}
instance AsValue Strict.ByteString where
_Value :: Traversal' ByteString Value
_Value = forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _Value #-}
instance AsValue Lazy.ByteString where
_Value :: Traversal' ByteString Value
_Value = forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _Value #-}
instance AsValue String where
_Value :: Traversal' String Value
_Value = Lens' String ByteString
strictUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _Value #-}
instance AsValue Text where
_Value :: Traversal' Text Value
_Value = Lens' Text ByteString
strictTextUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _Value #-}
instance AsValue LazyText.Text where
_Value :: Traversal' Text Value
_Value = Lens' Text ByteString
lazyTextUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _Value #-}
key :: AsValue t => Key -> Traversal' t Value
key :: forall t. AsValue t => Key -> Traversal' t Value
key Key
i = forall t. AsValue t => Traversal' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
i
{-# INLINE key #-}
members :: AsValue t => Traversal' t Value
members :: forall t. AsValue t => Traversal' t Value
members = forall t. AsValue t => Traversal' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE members #-}
nth :: AsValue t => Int -> Traversal' t Value
nth :: forall t. AsValue t => Int -> Traversal' t Value
nth Int
i = forall t. AsValue t => Traversal' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {a}.
Applicative f =>
(a -> f a) -> Vector a -> f (Vector a)
vectorIxI
where
vectorIxI :: (a -> f a) -> Vector a -> f (Vector a)
vectorIxI a -> f a
f Vector a
a
| Int
0 forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Vector a
a = a -> f a
f (Vector a
a forall a. Vector a -> Int -> a
V.! Int
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v -> Vector a
a forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
i, a
v)]
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
a
{-# INLINE nth #-}
values :: AsValue t => Traversal' t Value
values :: forall t. AsValue t => Traversal' t Value
values = forall t. AsValue t => Traversal' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE values #-}
strictUtf8 :: Lens' String Strict.ByteString
strictUtf8 :: Lens' String ByteString
strictUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens String -> Text
Text.pack (forall a b. a -> b -> a
const Text -> String
Text.unpack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Text ByteString
strictTextUtf8
lazyUtf8 :: Lens' Strict.ByteString Lazy.ByteString
lazyUtf8 :: Lens' ByteString ByteString
lazyUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ByteString -> ByteString
Lazy.fromStrict (forall a b. a -> b -> a
const ByteString -> ByteString
Lazy.toStrict)
strictTextUtf8 :: Lens' Text.Text Strict.ByteString
strictTextUtf8 :: Lens' Text ByteString
strictTextUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Text -> ByteString
StrictText.encodeUtf8 (forall a b. a -> b -> a
const ByteString -> Text
StrictText.decodeUtf8)
lazyTextUtf8 :: Lens' LazyText.Text Lazy.ByteString
lazyTextUtf8 :: Lens' Text ByteString
lazyTextUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Text -> ByteString
LazyText.encodeUtf8 (forall a b. a -> b -> a
const ByteString -> Text
LazyText.decodeUtf8)
class AsJSON t where
_JSON :: (FromJSON a, ToJSON a) => Traversal' t a
instance AsJSON Strict.ByteString where
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' ByteString a
_JSON = Lens' ByteString ByteString
lazyUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _JSON #-}
instance AsJSON Lazy.ByteString where
#if MIN_VERSION_aeson(2,2,0)
_JSON f b = maybe (pure b) (fmap encode . f) (decode b)
#else
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' ByteString a
_JSON a -> f a
f ByteString
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f) Maybe a
v
where v :: Maybe a
v = forall r. Result r -> Maybe r
maybeResult (forall a. Parser a -> ByteString -> Result a
parse Parser Value
value ByteString
b) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
x -> case forall a. FromJSON a => Value -> Result a
fromJSON Value
x of
Success a
x' -> forall a. a -> Maybe a
Just a
x'
Result a
_ -> forall a. Maybe a
Nothing
#endif
{-# INLINE _JSON #-}
instance AsJSON String where
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' String a
_JSON = Lens' String ByteString
strictUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _JSON #-}
instance AsJSON Text where
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' Text a
_JSON = Lens' Text ByteString
strictTextUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _JSON #-}
instance AsJSON LazyText.Text where
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' Text a
_JSON = Lens' Text ByteString
lazyTextUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
{-# INLINE _JSON #-}
instance AsJSON Value where
_JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' Value a
_JSON a -> f a
f Value
v = case forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
Success a
v' -> forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
v'
Result a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE _JSON #-}