{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies      #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module    :  Lens.Micro.Aeson.Internal
-- Copyright :  (c) Colin Woodbury 2015, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012
-- License   :  BSD3
-- Maintainer:  Colin Woodbury <colingw@gmail.com>
--
-- These are stolen from `Lens.Micro.Platform` to avoid its dependencies.
-- They're altered to be specific to the Aeson context.
-- Creating instances for `microlens` typeclasses is generally warned
-- against, hence these instances are hidden here.

module Lens.Micro.Aeson.Internal where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Aeson (Value(..))
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

-- | Can only index into the contents of an `Object`,
-- which is a `HashMap`.
instance Ixed Value where
  ix :: Index Value -> Traversal' Value (IxValue Value)
ix i :: Index Value
i f :: IxValue Value -> f (IxValue Value)
f (Object o :: 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 Index Object
Index Value
i IxValue Object -> f (IxValue Object)
IxValue Value -> f (IxValue Value)
f Object
o
  ix _ _ v :: 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

-- | Straight-forward implementation.
instance Ixed (HashMap Text Value) where
  ix :: Index Object -> Traversal' Object (IxValue Object)
ix k :: Index Object
k f :: IxValue Object -> f (IxValue Object)
f m :: Object
m = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
Index Object
k Object
m of
    Just v :: Value
v  -> (\v' :: Value
v' -> Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
Index Object
k Value
v' Object
m) (Value -> Object) -> f Value -> f Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue Object -> f (IxValue Object)
f Value
IxValue Object
v
    Nothing -> Object -> f Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
m
  {-# INLINE ix #-}

type instance Index   (V.Vector a) = Int

type instance IxValue (V.Vector a) = a

-- | Also straight-forward. Only applicable for non-zero length `Vector`s.
instance Ixed (V.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix i :: Index (Vector a)
i f :: IxValue (Vector a) -> f (IxValue (Vector a))
f v :: Vector a
v
    | 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
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 #-}