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

import Prelude (Int)

import qualified Optics.Core as L

import Data.RAList.NonEmpty
import Data.RAList.NonEmpty.Optics.Internal

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

ix :: Int -> L.AffineTraversal' (NERAList a) a
ix :: Int -> AffineTraversal' (NERAList a) a
ix Int
i = AffineTraversalVL (NERAList a) (NERAList a) a a
-> AffineTraversal' (NERAList 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 (NERAList a) a
forall (f :: * -> *) a.
Functor f =>
Int -> (forall x. x -> f x) -> LensLikeVL' f (NERAList a) a
ixVL Int
i)

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

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

instance L.FoldableWithIndex Int NERAList where
    ifoldMap = ifoldMap

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

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

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

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