{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.RAVec.Optics (
    -- * Indexing
    ix,
    ) where

import Control.Applicative        ((<$>))
import Data.Bin.Pos               (Pos (..))
import Data.RAVec.NonEmpty.Optics ()
import Prelude                    (Functor)

import qualified Data.RAVec.NonEmpty.Optics.Internal as NE
import qualified Optics.Core                         as L

import Data.RAVec

-- $setup
-- >>> import Optics.Core (set)
-- >>> import Prelude
-- >>> import qualified Data.Type.Bin as B
-- >>> import Data.RAVec

-------------------------------------------------------------------------------
-- Indexing
-------------------------------------------------------------------------------

-- | Index lens.
--
-- >>> let Just ral = fromList "xyz" :: Maybe (RAVec B.Bin3 Char)
-- >>> set (ix maxBound) 'Z' ral
-- NonEmpty (NE (Cons1 (Leaf 'x') (Last (Node (Leaf 'y') (Leaf 'Z')))))
ix :: Pos b -> L.Lens' (RAVec b a) a
ix :: Pos b -> Lens' (RAVec b a) a
ix Pos b
i = LensVL (RAVec b a) (RAVec b a) a a -> Lens' (RAVec b a) a
forall s t a b. LensVL s t a b -> Lens s t a b
L.lensVL (Pos b -> LensLikeVL' f (RAVec b a) a
forall (f :: * -> *) (b :: Bin) a.
Functor f =>
Pos b -> LensLikeVL' f (RAVec b a) a
ixVL Pos b
i)

ixVL :: Functor f => Pos b -> NE.LensLikeVL' f (RAVec b a) a
ixVL :: Pos b -> LensLikeVL' f (RAVec b a) a
ixVL (Pos PosP b1
n) a -> f a
f (NonEmpty NERAVec b1 a
x) = NERAVec b1 a -> RAVec ('BP b1) a
forall (b1 :: BinP) a. NERAVec b1 a -> RAVec ('BP b1) a
NonEmpty (NERAVec b1 a -> RAVec ('BP b1) a)
-> f (NERAVec b1 a) -> f (RAVec ('BP b1) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosP b1 -> LensLikeVL' f (NERAVec b1 a) a
forall (f :: * -> *) (b :: BinP) a.
Functor f =>
PosP b -> LensLikeVL' f (NERAVec b a) a
NE.ixVL PosP b1
n a -> f a
f NERAVec b1 a
NERAVec b1 a
x

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

#if !MIN_VERSION_optics_core(0,4,0)
instance L.FunctorWithIndex (Pos b) (RAVec b) where
    imap = imap

instance L.FoldableWithIndex (Pos b) (RAVec b) where
    ifoldMap = ifoldMap
    ifoldr   = ifoldr

instance L.TraversableWithIndex (Pos b) (RAVec b) where
    itraverse = itraverse
#endif

instance L.Each (Pos n) (RAVec n a) (RAVec n b) a b where

type instance L.Index   (RAVec n a) = Pos n
type instance L.IxValue (RAVec n a) = a

instance L.Ixed (RAVec b a) where
    type IxKind (RAVec b a) = L.A_Lens
    ix :: Index (RAVec b a)
-> Optic'
     (IxKind (RAVec b a)) NoIx (RAVec b a) (IxValue (RAVec b a))
ix = Index (RAVec b a)
-> Optic'
     (IxKind (RAVec b a)) NoIx (RAVec b a) (IxValue (RAVec b a))
forall (b :: Bin) a. Pos b -> Lens' (RAVec b a) a
ix