{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Lens.Micro.Aeson.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Aeson (Value(..))
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import Data.HashMap.Lazy as HashMap
import Data.Text (Text)
import Data.Vector as V
import Lens.Micro.Internal
type instance Index Value = Text
type instance IxValue Value = Value
instance Ixed Value where
ix :: Index Value -> Traversal' Value (IxValue Value)
ix Index Value
i IxValue Value -> f (IxValue Value)
f (Object Object
o) = Object -> Value
Object (Object -> Value) -> f Object -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index Object
-> (IxValue Object -> f (IxValue Object)) -> Object -> f Object
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Key
Key.fromText Text
Index Value
i) IxValue Value -> f (IxValue Value)
IxValue Object -> f (IxValue Object)
f Object
o
ix Index Value
_ IxValue Value -> f (IxValue Value)
_ Value
v = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
{-# INLINE ix #-}
type instance Index (HashMap Text Value) = Text
type instance IxValue (HashMap Text Value) = Value
instance Ixed (HashMap Text Value) where
ix :: Index (HashMap Text Value)
-> Traversal' (HashMap Text Value) (IxValue (HashMap Text Value))
ix Index (HashMap Text Value)
k IxValue (HashMap Text Value) -> f (IxValue (HashMap Text Value))
f HashMap Text Value
m = case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
Index (HashMap Text Value)
k HashMap Text Value
m of
Just Value
v -> (\Value
v' -> Text -> Value -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
Index (HashMap Text Value)
k Value
v' HashMap Text Value
m) (Value -> HashMap Text Value) -> f Value -> f (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (HashMap Text Value) -> f (IxValue (HashMap Text Value))
f Value
IxValue (HashMap Text Value)
v
Maybe Value
Nothing -> HashMap Text Value -> f (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
m
{-# INLINE ix #-}
type instance Index (V.Vector a) = Int
type instance IxValue (V.Vector a) = a
instance Ixed (V.Vector a) where
ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
| Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (Vector a)
i Bool -> Bool -> Bool
&& Int
Index (Vector a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v = (\a
a -> Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
Index (Vector a)
i, a
a)]) (a -> Vector a) -> f a -> f (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
Index (Vector a)
i)
| Bool
otherwise = Vector a -> f (Vector a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
{-# INLINE ix #-}
type instance Index (KM.KeyMap v) = Key.Key
type instance IxValue (KM.KeyMap v) = v
instance Ixed (KM.KeyMap v) where
ix :: Index (KeyMap v) -> Traversal' (KeyMap v) (IxValue (KeyMap v))
ix Index (KeyMap v)
i IxValue (KeyMap v) -> f (IxValue (KeyMap v))
f KeyMap v
m = case Key -> KeyMap v -> Maybe v
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
Index (KeyMap v)
i KeyMap v
m of
Maybe v
Nothing -> KeyMap v -> f (KeyMap v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap v
m
Just v
v -> (\v
v' -> Key -> v -> KeyMap v -> KeyMap v
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
Index (KeyMap v)
i v
v' KeyMap v
m) (v -> KeyMap v) -> f v -> f (KeyMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (KeyMap v) -> f (IxValue (KeyMap v))
f v
IxValue (KeyMap v)
v
instance At (KM.KeyMap v) where
at :: Index (KeyMap v) -> Lens' (KeyMap v) (Maybe (IxValue (KeyMap v)))
at Index (KeyMap v)
k Maybe (IxValue (KeyMap v)) -> f (Maybe (IxValue (KeyMap v)))
f = (Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
forall (f :: * -> *) v.
Functor f =>
(Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
KM.alterF Maybe v -> f (Maybe v)
Maybe (IxValue (KeyMap v)) -> f (Maybe (IxValue (KeyMap v)))
f Key
Index (KeyMap v)
k
instance Each (KM.KeyMap a) (KM.KeyMap b) a b where
each :: (a -> f b) -> KeyMap a -> f (KeyMap b)
each = (a -> f b) -> KeyMap a -> f (KeyMap b)
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
{-# INLINE each #-}