{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.RAVec.NonEmpty.Lens (
    -- * Indexing
    ix, ix',
    ) where

import Control.Applicative ((<$>))
import Data.BinP.PosP      (PosP (..), PosP' (..))
import Prelude ()

import qualified Control.Lens       as L
import qualified Data.RAVec.Tree.Lens as Tree

import Data.RAVec.NonEmpty

-- $setup
-- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))
-- >>> import Prelude
-- >>> import qualified Data.Type.Bin as B

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

ix :: PosP b -> L.Lens' (NERAVec b a) a
ix :: forall (b :: BinP) a. PosP b -> Lens' (NERAVec b a) a
ix (PosP PosP' 'Z b
i) a -> f a
f (NE NERAVec' 'Z b a
xs) = NERAVec' 'Z b a -> NERAVec b a
forall (b :: BinP) a. NERAVec' 'Z b a -> NERAVec b a
NE (NERAVec' 'Z b a -> NERAVec b a)
-> f (NERAVec' 'Z b a) -> f (NERAVec b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosP' 'Z b -> Lens' (NERAVec' 'Z b a) a
forall (n :: Nat) (b :: BinP) a.
PosP' n b -> Lens' (NERAVec' n b a) a
ix' PosP' 'Z b
i a -> f a
f NERAVec' 'Z b a
xs

ix' :: PosP' n b -> L.Lens' (NERAVec' n b a) a
ix' :: forall (n :: Nat) (b :: BinP) a.
PosP' n b -> Lens' (NERAVec' n b a) a
ix' (AtEnd Wrd n
i)  a -> f a
f (Last  Tree n a
t)   = Tree n a -> NERAVec' n b a
Tree n a -> NERAVec' n 'BE a
forall (n :: Nat) a. Tree n a -> NERAVec' n 'BE a
Last (Tree n a -> NERAVec' n b a) -> f (Tree n a) -> f (NERAVec' n b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrd n -> Lens' (Tree n a) a
forall (n :: Nat) a. Wrd n -> Lens' (Tree n a) a
Tree.ix Wrd n
i a -> f a
f Tree n a
t
ix' (There0 PosP' ('S n) b1
i) a -> f a
f (Cons0   NERAVec' ('S n) b1 a
r) = NERAVec' ('S n) b1 a -> NERAVec' n b a
NERAVec' ('S n) b1 a -> NERAVec' n ('B0 b1) a
forall (n :: Nat) (b1 :: BinP) a.
NERAVec' ('S n) b1 a -> NERAVec' n ('B0 b1) a
Cons0 (NERAVec' ('S n) b1 a -> NERAVec' n b a)
-> f (NERAVec' ('S n) b1 a) -> f (NERAVec' n b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosP' ('S n) b1 -> Lens' (NERAVec' ('S n) b1 a) a
forall (n :: Nat) (b :: BinP) a.
PosP' n b -> Lens' (NERAVec' n b a) a
ix' PosP' ('S n) b1
i a -> f a
f NERAVec' ('S n) b1 a
NERAVec' ('S n) b1 a
r
ix' (There1 PosP' ('S n) b1
i) a -> f a
f (Cons1 Tree n a
t NERAVec' ('S n) b1 a
r) = (Tree n a
t Tree n a -> NERAVec' ('S n) b1 a -> NERAVec' n ('B1 b1) a
forall (n :: Nat) a (b1 :: BinP).
Tree n a -> NERAVec' ('S n) b1 a -> NERAVec' n ('B1 b1) a
`Cons1`) (NERAVec' ('S n) b1 a -> NERAVec' n b a)
-> f (NERAVec' ('S n) b1 a) -> f (NERAVec' n b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosP' ('S n) b1 -> Lens' (NERAVec' ('S n) b1 a) a
forall (n :: Nat) (b :: BinP) a.
PosP' n b -> Lens' (NERAVec' n b a) a
ix' PosP' ('S n) b1
i a -> f a
f NERAVec' ('S n) b1 a
NERAVec' ('S n) b1 a
r
ix' (Here Wrd n
i)   a -> f a
f (Cons1 Tree n a
t NERAVec' ('S n) b1 a
r) = (Tree n a -> NERAVec' ('S n) b1 a -> NERAVec' n ('B1 b1) a
forall (n :: Nat) a (b1 :: BinP).
Tree n a -> NERAVec' ('S n) b1 a -> NERAVec' n ('B1 b1) a
`Cons1` NERAVec' ('S n) b1 a
r) (Tree n a -> NERAVec' n b a) -> f (Tree n a) -> f (NERAVec' n b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrd n -> Lens' (Tree n a) a
forall (n :: Nat) a. Wrd n -> Lens' (Tree n a) a
Tree.ix Wrd n
i a -> f a
f Tree n a
t

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

instance L.Each (NERAVec n a) (NERAVec n b) a b where
    each :: Traversal (NERAVec n a) (NERAVec n b) a b
each = (a -> f b) -> NERAVec n a -> f (NERAVec n b)
forall (f :: * -> *) a b (m :: BinP).
Applicative f =>
(a -> f b) -> NERAVec m a -> f (NERAVec m b)
traverse

instance L.Each (NERAVec' n m a) (NERAVec' n m b) a b where
    each :: Traversal (NERAVec' n m a) (NERAVec' n m b) a b
each = (a -> f b) -> NERAVec' n m a -> f (NERAVec' n m b)
forall (f :: * -> *) a b (n :: Nat) (m :: BinP).
Applicative f =>
(a -> f b) -> NERAVec' n m a -> f (NERAVec' n m b)
traverse'

type instance L.Index   (NERAVec b a) = PosP b
type instance L.IxValue (NERAVec b a) = a

type instance L.Index   (NERAVec' n b a) = PosP' n b
type instance L.IxValue (NERAVec' n b a) = a

instance L.Ixed (NERAVec b a) where
    ix :: Index (NERAVec b a)
-> Traversal' (NERAVec b a) (IxValue (NERAVec b a))
ix Index (NERAVec b a)
i = PosP b -> Lens' (NERAVec b a) a
forall (b :: BinP) a. PosP b -> Lens' (NERAVec b a) a
ix PosP b
Index (NERAVec b a)
i

instance L.Ixed (NERAVec' n b a) where
    ix :: Index (NERAVec' n b a)
-> Traversal' (NERAVec' n b a) (IxValue (NERAVec' n b a))
ix Index (NERAVec' n b a)
i = PosP' n b -> Lens' (NERAVec' n b a) a
forall (n :: Nat) (b :: BinP) a.
PosP' n b -> Lens' (NERAVec' n b a) a
ix' PosP' n b
Index (NERAVec' n b a)
i