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

import Prelude (Int, Functor (..))

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

import Data.RAList

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

ix :: Int -> L.AffineTraversal' (RAList a) a
ix :: Int -> AffineTraversal' (RAList a) a
ix Int
i = AffineTraversalVL (RAList a) (RAList a) a a
-> AffineTraversal' (RAList a) a
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
L.atraversalVL (Int -> (forall r. r -> f r) -> LensLikeVL' f (RAList a) a
forall (f :: * -> *) a.
Functor f =>
Int -> (forall x. x -> f x) -> LensLikeVL' f (RAList a) a
ixVL Int
i)

ixVL :: forall f a. Functor f => Int -> (forall x. x -> f x) -> NE.LensLikeVL' f (RAList a) a
ixVL :: Int -> (forall x. x -> f x) -> LensLikeVL' f (RAList a) a
ixVL Int
_ forall x. x -> f x
point a -> f a
_ RAList a
Empty        = RAList a -> f (RAList a)
forall x. x -> f x
point RAList a
forall a. RAList a
Empty
ixVL Int
i forall x. x -> f x
point a -> f a
f (NonEmpty NERAList a
x) = (NERAList a -> RAList a) -> f (NERAList a) -> f (RAList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (Int -> (forall x. x -> f x) -> LensLikeVL' f (NERAList a) a
forall (f :: * -> *) a.
Functor f =>
Int -> (forall x. x -> f x) -> LensLikeVL' f (NERAList a) a
NE.ixVL Int
i forall x. x -> f x
point a -> f a
f NERAList a
x)

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

#if !MIN_VERSION_optics_core(0,4,0)
instance L.FunctorWithIndex Int RAList where
    imap = imap

instance L.FoldableWithIndex Int RAList where
    ifoldMap = ifoldMap

instance L.TraversableWithIndex Int RAList where
    itraverse = itraverse
#endif

instance L.Each Int (RAList a) (RAList b) a b

type instance L.Index (RAList a)   = Int
type instance L.IxValue (RAList a) = a

instance L.Ixed (RAList a) where
    ix :: Index (RAList a)
-> Optic' (IxKind (RAList a)) NoIx (RAList a) (IxValue (RAList a))
ix = Index (RAList a)
-> Optic' (IxKind (RAList a)) NoIx (RAList a) (IxValue (RAList a))
forall a. Int -> AffineTraversal' (RAList a) a
ix