{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
module Data.RAList.NonEmpty.Optics.Internal where

import Control.Applicative ((<$>))
import Prelude
       (Functor (..), Int, Num (..), Ord (..), div, otherwise)

import qualified Data.RAList.Tree as Tr

import Data.RAList.NonEmpty

type LensLikeVL f s t a b = (a -> f b) -> s -> f t
type LensLikeVL' f s a = LensLikeVL f s s a a

ixVL :: forall f a. Functor f => Int -> (forall x. x -> f x) -> LensLikeVL' f (NERAList a) a
ixVL :: Int -> (forall x. x -> f x) -> LensLikeVL' f (NERAList a) a
ixVL Int
i0 forall x. x -> f x
point a -> f a
f (NE NERAList' Leaf a
xs) = NERAList' Leaf a -> NERAList a
forall a. NERAList' Leaf a -> NERAList a
NE (NERAList' Leaf a -> NERAList a)
-> f (NERAList' Leaf a) -> f (NERAList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> NERAList' Leaf a -> f (NERAList' Leaf a)
forall (t :: * -> *).
TreeIx t =>
Int -> Int -> NERAList' t a -> f (NERAList' t a)
go Int
1 Int
i0 NERAList' Leaf a
xs where
    go :: forall t. TreeIx t => Int -> Int -> NERAList' t a -> f (NERAList' t a)
    go :: Int -> Int -> NERAList' t a -> f (NERAList' t a)
go Int
s Int
i (Last  t a
t)   = t a -> NERAList' t a
forall (f :: * -> *) a. f a -> NERAList' f a
Last (t a -> NERAList' t a) -> f (t a) -> f (NERAList' t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(TreeIx t, Functor f) =>
Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
treeIx Int
s Int
i forall x. x -> f x
point a -> f a
f t a
t
    go Int
s Int
i (Cons0   NERAList' (Node t) a
r) = NERAList' (Node t) a -> NERAList' t a
forall (f :: * -> *) a. NERAList' (Node f) a -> NERAList' f a
Cons0 (NERAList' (Node t) a -> NERAList' t a)
-> f (NERAList' (Node t) a) -> f (NERAList' t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> NERAList' (Node t) a -> f (NERAList' (Node t) a)
forall (t :: * -> *).
TreeIx t =>
Int -> Int -> NERAList' t a -> f (NERAList' t a)
go (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
i NERAList' (Node t) a
r
    go Int
s Int
i (Cons1 t a
t NERAList' (Node t) a
r)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s     = (t a -> NERAList' (Node t) a -> NERAList' t a
forall (f :: * -> *) a.
f a -> NERAList' (Node f) a -> NERAList' f a
`Cons1` NERAList' (Node t) a
r) (t a -> NERAList' t a) -> f (t a) -> f (NERAList' t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(TreeIx t, Functor f) =>
Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
treeIx Int
s Int
i forall x. x -> f x
point a -> f a
f t a
t
        | Bool
otherwise = (t a
t t a -> NERAList' (Node t) a -> NERAList' t a
forall (f :: * -> *) a.
f a -> NERAList' (Node f) a -> NERAList' f a
`Cons1`) (NERAList' (Node t) a -> NERAList' t a)
-> f (NERAList' (Node t) a) -> f (NERAList' t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> NERAList' (Node t) a -> f (NERAList' (Node t) a)
forall (t :: * -> *).
TreeIx t =>
Int -> Int -> NERAList' t a -> f (NERAList' t a)
go (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) NERAList' (Node t) a
r

class TreeIx t where
    treeIx :: Functor f => Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)

instance TreeIx Tr.Leaf where
    treeIx :: Int
-> Int
-> (forall x. x -> f x)
-> (a -> f a)
-> Leaf a
-> f (Leaf a)
treeIx Int
_ Int
0 forall x. x -> f x
_     a -> f a
f (Tr.Lf a
x) = a -> Leaf a
forall a. a -> Leaf a
Tr.Lf (a -> Leaf a) -> f a -> f (Leaf a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x
    treeIx Int
_ Int
_ forall x. x -> f x
point a -> f a
_ Leaf a
leaf      = Leaf a -> f (Leaf a)
forall x. x -> f x
point Leaf a
leaf

instance TreeIx t => TreeIx (Tr.Node t) where
    treeIx :: Int
-> Int
-> (forall x. x -> f x)
-> (a -> f a)
-> Node t a
-> f (Node t a)
treeIx Int
s Int
i forall x. x -> f x
point a -> f a
f node :: Node t a
node@(Tr.Nd t a
x t a
y)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s2    = (t a -> t a -> Node t a
forall (f :: * -> *) a. f a -> f a -> Node f a
`Tr.Nd` t a
y) (t a -> Node t a) -> f (t a) -> f (Node t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(TreeIx t, Functor f) =>
Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
treeIx Int
s2 Int
i        forall x. x -> f x
point a -> f a
f t a
x
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s     = (t a
x t a -> t a -> Node t a
forall (f :: * -> *) a. f a -> f a -> Node f a
`Tr.Nd`) (t a -> Node t a) -> f (t a) -> f (Node t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(TreeIx t, Functor f) =>
Int -> Int -> (forall x. x -> f x) -> (a -> f a) -> t a -> f (t a)
treeIx Int
s2 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s2) forall x. x -> f x
point a -> f a
f t a
x
        | Bool
otherwise = Node t a -> f (Node t a)
forall x. x -> f x
point Node t a
node
      where
        s2 :: Int
s2 = Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2