{-# LANGUAGE RankNTypes, DerivingVia, DeriveTraversable, PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE BangPatterns,UndecidableInstances,MultiParamTypeClasses #-}
{-# LANGUAGE MonadComprehensions,RoleAnnotations, QuantifiedConstraints #-}
{-# LANGUAGE Trustworthy, MagicHash#-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.RAList.Co(
  --module RA
  RAList(Cons,Nil,RCons,(:|),(:.))

  -- * lookups
  , lookup
  , lookupM
  , lookupWithDefault
  , (!!)
  , lookupCC

  -- * function form of constructing  and destructing
  ,cons
  ,uncons
  --,traverse
  --,foldr
  --,foldl
  --,foldl'

-- * zipping
  ,zip
  ,zipWith
  ,unzip

  --
-- * Extracting sublists
   , take
   , drop
   , replicate
   , splitAt

  -- * from traverse and foldable and ilk
  ,foldl'
  ,foldr
  ,traverse
  ,mapM
  ,mapM_

  ,unfoldr

  -- * indexed folds etc
  ,ifoldMap
  ,imap
  ,itraverse
  ,ifoldl'
  ,ifoldr
  ,imapM

-- * filter and friends
 , filter
 , partition
 , mapMaybe
 , catMaybes
 , wither

-- * foldable cousins

 ,elem
 ,length
 ,wLength


-- * The \"@generic@\" operations
-- | The prefix \`@generic@\' indicates an overloaded function that
-- is a generalized version of a "Prelude" function.

   , genericLength
   , genericTake
   , genericDrop
   , genericSplitAt
   , genericIndex
   , genericReplicate

-- * Update
   , update
   , adjust
-- * Append
  ,(++)
-- * list conversion
, fromList
, toList

  ) where



import Data.Word
--import qualified Prelude as P
import Prelude hiding (
    (++), head, last, tail, init, null, length, map, reverse,
    foldl, foldl1, foldr, foldr1, concat, concatMap,
    and, or, any, all, sum, product, maximum, minimum, take,
    drop, elem, splitAt, notElem, lookup, replicate, (!!), filter,
    zip, zipWith, unzip
    )
import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex

-- this is used to ... flip around the indexing
--- need to check that i'm doing it correctly of course
import Control.Applicative.Backwards

import Data.RAList.Internal
-- provides indexing applicative

--import qualfieData.RAList  as RA hiding (
--    (!!)
--   ,lookupWithDefault
--   ,lookupM
--   ,lookup
--   , lookupCC )
import  qualified Data.RAList as QRA
import qualified Control.Monad.Fail as MF
import Data.Foldable
import Data.Traversable()
import GHC.Exts (IsList)
import Control.Monad.Zip
import Data.Coerce
import GHC.Generics(Generic,Generic1)

import Control.Applicative(Applicative(liftA2))

import Data.Type.Coercion

import Unsafe.Coerce

import Control.DeepSeq

infixl 9  !!
infixr 5  `cons`, ++

-- | Cons pattern, à la ':' for list, prefix
infixr 5 `Cons`
pattern Cons :: forall a. a -> RAList a -> RAList a
pattern $bCons :: a -> RAList a -> RAList a
$mCons :: forall r a. RAList a -> (a -> RAList a -> r) -> (Void# -> r) -> r
Cons x  xs <- (uncons -> Just (x,  xs ) )
    where Cons a
x RAList a
xs =  (a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
cons a
x  RAList a
xs)


-- | the '[]' analogue
pattern Nil :: forall a . RAList a
pattern $bNil :: RAList a
$mNil :: forall r a. RAList a -> (Void# -> r) -> (Void# -> r) -> r
Nil = CoIndex QRA.Nil

{-# COMPLETE Cons, Nil #-}
-- | just 'Cons' but flipped arguments
infixl 5 `RCons`
pattern RCons :: forall a. RAList a -> a -> RAList a
pattern $bRCons :: RAList a -> a -> RAList a
$mRCons :: forall r a. RAList a -> (RAList a -> a -> r) -> (Void# -> r) -> r
RCons xs x = Cons x xs

{-# COMPLETE RCons, Nil #-}

-- | infix 'Cons', aka : , but for RAlist
infixr 5 :|
pattern (:|) :: forall a. a -> RAList a -> RAList a
pattern x $b:| :: a -> RAList a -> RAList a
$m:| :: forall r a. RAList a -> (a -> RAList a -> r) -> (Void# -> r) -> r
:| xs = Cons x xs
{-# COMPLETE (:|), Nil #-}

-- | infix 'RCons', aka flipped :
infixl 5 :.
pattern (:.) :: forall a. RAList a -> a -> RAList a
pattern xs $b:. :: RAList a -> a -> RAList a
$m:. :: forall r a. RAList a -> (RAList a -> a -> r) -> (Void# -> r) -> r
:. x = Cons x xs
{-# COMPLETE (:.), Nil #-}


-- | friendly list to RAList conversion
fromList :: [a] -> RAList a
fromList :: [a] -> RAList a
fromList = (a -> RAList a -> RAList a) -> RAList a -> [a] -> RAList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons RAList a
forall a. RAList a
Nil




-- | This type (@'RAList' a@) indexes back to front, i.e. for nonempty lists @l@ : head of l == (l @'!!' ('genericLength'@ l - 1 ))@
-- and @last l == l '!!' 0 @.   RAList also has a logarithmic complexity 'drop' operation, and different semantics for 'zip' and related operations
--
--
-- for complete pattern matching, you can use any pair of:
--
-- -  ':|' , 'Nil'
--
-- -  ':.' , 'Nil'
--
-- - 'Cons' , 'Nil'
--
-- - 'RCons' , 'Nil'
--
-- The Reversed order pattern synonyms are provided
-- to enable certain codes to match pen/paper notation for ordered variable environments
newtype RAList a = CoIndex {RAList a -> RAList a
reindex :: QRA.RAList a }
    deriving stock (Functor RAList
Foldable RAList
Functor RAList
-> Foldable RAList
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RAList a -> f (RAList b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RAList (f a) -> f (RAList a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RAList a -> m (RAList b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RAList (m a) -> m (RAList a))
-> Traversable RAList
(a -> f b) -> RAList a -> f (RAList b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RAList (m a) -> m (RAList a)
forall (f :: * -> *) a.
Applicative f =>
RAList (f a) -> f (RAList a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RAList a -> m (RAList b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RAList a -> f (RAList b)
sequence :: RAList (m a) -> m (RAList a)
$csequence :: forall (m :: * -> *) a. Monad m => RAList (m a) -> m (RAList a)
mapM :: (a -> m b) -> RAList a -> m (RAList b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RAList a -> m (RAList b)
sequenceA :: RAList (f a) -> f (RAList a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RAList (f a) -> f (RAList a)
traverse :: (a -> f b) -> RAList a -> f (RAList b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RAList a -> f (RAList b)
$cp2Traversable :: Foldable RAList
$cp1Traversable :: Functor RAList
Traversable)
    --- should think about direction of traversal
    deriving (a -> RAList a -> Bool
RAList m -> m
RAList a -> [a]
RAList a -> Bool
RAList a -> Int
RAList a -> a
RAList a -> a
RAList a -> a
RAList a -> a
(a -> m) -> RAList a -> m
(a -> m) -> RAList a -> m
(a -> b -> b) -> b -> RAList a -> b
(a -> b -> b) -> b -> RAList a -> b
(b -> a -> b) -> b -> RAList a -> b
(b -> a -> b) -> b -> RAList a -> b
(a -> a -> a) -> RAList a -> a
(a -> a -> a) -> RAList a -> a
(forall m. Monoid m => RAList m -> m)
-> (forall m a. Monoid m => (a -> m) -> RAList a -> m)
-> (forall m a. Monoid m => (a -> m) -> RAList a -> m)
-> (forall a b. (a -> b -> b) -> b -> RAList a -> b)
-> (forall a b. (a -> b -> b) -> b -> RAList a -> b)
-> (forall b a. (b -> a -> b) -> b -> RAList a -> b)
-> (forall b a. (b -> a -> b) -> b -> RAList a -> b)
-> (forall a. (a -> a -> a) -> RAList a -> a)
-> (forall a. (a -> a -> a) -> RAList a -> a)
-> (forall a. RAList a -> [a])
-> (forall a. RAList a -> Bool)
-> (forall a. RAList a -> Int)
-> (forall a. Eq a => a -> RAList a -> Bool)
-> (forall a. Ord a => RAList a -> a)
-> (forall a. Ord a => RAList a -> a)
-> (forall a. Num a => RAList a -> a)
-> (forall a. Num a => RAList a -> a)
-> Foldable RAList
forall a. Eq a => a -> RAList a -> Bool
forall a. Num a => RAList a -> a
forall a. Ord a => RAList a -> a
forall m. Monoid m => RAList m -> m
forall a. RAList a -> Bool
forall a. RAList a -> Int
forall a. RAList a -> [a]
forall a. (a -> a -> a) -> RAList a -> a
forall m a. Monoid m => (a -> m) -> RAList a -> m
forall b a. (b -> a -> b) -> b -> RAList a -> b
forall a b. (a -> b -> b) -> b -> RAList a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: RAList a -> a
$cproduct :: forall a. Num a => RAList a -> a
sum :: RAList a -> a
$csum :: forall a. Num a => RAList a -> a
minimum :: RAList a -> a
$cminimum :: forall a. Ord a => RAList a -> a
maximum :: RAList a -> a
$cmaximum :: forall a. Ord a => RAList a -> a
elem :: a -> RAList a -> Bool
$celem :: forall a. Eq a => a -> RAList a -> Bool
length :: RAList a -> Int
$clength :: forall a. RAList a -> Int
null :: RAList a -> Bool
$cnull :: forall a. RAList a -> Bool
toList :: RAList a -> [a]
$ctoList :: forall a. RAList a -> [a]
foldl1 :: (a -> a -> a) -> RAList a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RAList a -> a
foldr1 :: (a -> a -> a) -> RAList a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> RAList a -> a
foldl' :: (b -> a -> b) -> b -> RAList a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RAList a -> b
foldl :: (b -> a -> b) -> b -> RAList a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RAList a -> b
foldr' :: (a -> b -> b) -> b -> RAList a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RAList a -> b
foldr :: (a -> b -> b) -> b -> RAList a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> RAList a -> b
foldMap' :: (a -> m) -> RAList a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RAList a -> m
foldMap :: (a -> m) -> RAList a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RAList a -> m
fold :: RAList m -> m
$cfold :: forall m. Monoid m => RAList m -> m
Foldable,a -> RAList b -> RAList a
(a -> b) -> RAList a -> RAList b
(forall a b. (a -> b) -> RAList a -> RAList b)
-> (forall a b. a -> RAList b -> RAList a) -> Functor RAList
forall a b. a -> RAList b -> RAList a
forall a b. (a -> b) -> RAList a -> RAList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RAList b -> RAList a
$c<$ :: forall a b. a -> RAList b -> RAList a
fmap :: (a -> b) -> RAList a -> RAList b
$cfmap :: forall a b. (a -> b) -> RAList a -> RAList b
Functor,Rep1 RAList a -> RAList a
RAList a -> Rep1 RAList a
(forall a. RAList a -> Rep1 RAList a)
-> (forall a. Rep1 RAList a -> RAList a) -> Generic1 RAList
forall a. Rep1 RAList a -> RAList a
forall a. RAList a -> Rep1 RAList a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
to1 :: Rep1 RAList a -> RAList a
$cto1 :: forall a. Rep1 RAList a -> RAList a
from1 :: RAList a -> Rep1 RAList a
$cfrom1 :: forall a. RAList a -> Rep1 RAList a
Generic1,(a -> ()) -> RAList a -> ()
(forall a. (a -> ()) -> RAList a -> ()) -> NFData1 RAList
forall a. (a -> ()) -> RAList a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> RAList a -> ()
$cliftRnf :: forall a. (a -> ()) -> RAList a -> ()
NFData1) via QRA.RAList
    deriving (Semigroup (RAList a)
RAList a
Semigroup (RAList a)
-> RAList a
-> (RAList a -> RAList a -> RAList a)
-> ([RAList a] -> RAList a)
-> Monoid (RAList a)
[RAList a] -> RAList a
RAList a -> RAList a -> RAList a
forall a. Semigroup (RAList a)
forall a. RAList a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [RAList a] -> RAList a
forall a. RAList a -> RAList a -> RAList a
mconcat :: [RAList a] -> RAList a
$cmconcat :: forall a. [RAList a] -> RAList a
mappend :: RAList a -> RAList a -> RAList a
$cmappend :: forall a. RAList a -> RAList a -> RAList a
mempty :: RAList a
$cmempty :: forall a. RAList a
$cp1Monoid :: forall a. Semigroup (RAList a)
Monoid,b -> RAList a -> RAList a
NonEmpty (RAList a) -> RAList a
RAList a -> RAList a -> RAList a
(RAList a -> RAList a -> RAList a)
-> (NonEmpty (RAList a) -> RAList a)
-> (forall b. Integral b => b -> RAList a -> RAList a)
-> Semigroup (RAList a)
forall b. Integral b => b -> RAList a -> RAList a
forall a. NonEmpty (RAList a) -> RAList a
forall a. RAList a -> RAList a -> RAList a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> RAList a -> RAList a
stimes :: b -> RAList a -> RAList a
$cstimes :: forall a b. Integral b => b -> RAList a -> RAList a
sconcat :: NonEmpty (RAList a) -> RAList a
$csconcat :: forall a. NonEmpty (RAList a) -> RAList a
<> :: RAList a -> RAList a -> RAList a
$c<> :: forall a. RAList a -> RAList a -> RAList a
Semigroup,RAList a -> RAList a -> Bool
(RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> Bool) -> Eq (RAList a)
forall a. Eq a => RAList a -> RAList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RAList a -> RAList a -> Bool
$c/= :: forall a. Eq a => RAList a -> RAList a -> Bool
== :: RAList a -> RAList a -> Bool
$c== :: forall a. Eq a => RAList a -> RAList a -> Bool
Eq,Eq (RAList a)
Eq (RAList a)
-> (RAList a -> RAList a -> Ordering)
-> (RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> RAList a)
-> (RAList a -> RAList a -> RAList a)
-> Ord (RAList a)
RAList a -> RAList a -> Bool
RAList a -> RAList a -> Ordering
RAList a -> RAList a -> RAList a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (RAList a)
forall a. Ord a => RAList a -> RAList a -> Bool
forall a. Ord a => RAList a -> RAList a -> Ordering
forall a. Ord a => RAList a -> RAList a -> RAList a
min :: RAList a -> RAList a -> RAList a
$cmin :: forall a. Ord a => RAList a -> RAList a -> RAList a
max :: RAList a -> RAList a -> RAList a
$cmax :: forall a. Ord a => RAList a -> RAList a -> RAList a
>= :: RAList a -> RAList a -> Bool
$c>= :: forall a. Ord a => RAList a -> RAList a -> Bool
> :: RAList a -> RAList a -> Bool
$c> :: forall a. Ord a => RAList a -> RAList a -> Bool
<= :: RAList a -> RAList a -> Bool
$c<= :: forall a. Ord a => RAList a -> RAList a -> Bool
< :: RAList a -> RAList a -> Bool
$c< :: forall a. Ord a => RAList a -> RAList a -> Bool
compare :: RAList a -> RAList a -> Ordering
$ccompare :: forall a. Ord a => RAList a -> RAList a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RAList a)
Ord,Int -> RAList a -> ShowS
[RAList a] -> ShowS
RAList a -> String
(Int -> RAList a -> ShowS)
-> (RAList a -> String) -> ([RAList a] -> ShowS) -> Show (RAList a)
forall a. Show a => Int -> RAList a -> ShowS
forall a. Show a => [RAList a] -> ShowS
forall a. Show a => RAList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RAList a] -> ShowS
$cshowList :: forall a. Show a => [RAList a] -> ShowS
show :: RAList a -> String
$cshow :: forall a. Show a => RAList a -> String
showsPrec :: Int -> RAList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RAList a -> ShowS
Show,Int -> [Item (RAList a)] -> RAList a
[Item (RAList a)] -> RAList a
RAList a -> [Item (RAList a)]
([Item (RAList a)] -> RAList a)
-> (Int -> [Item (RAList a)] -> RAList a)
-> (RAList a -> [Item (RAList a)])
-> IsList (RAList a)
forall a. Int -> [Item (RAList a)] -> RAList a
forall a. [Item (RAList a)] -> RAList a
forall a. RAList a -> [Item (RAList a)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
toList :: RAList a -> [Item (RAList a)]
$ctoList :: forall a. RAList a -> [Item (RAList a)]
fromListN :: Int -> [Item (RAList a)] -> RAList a
$cfromListN :: forall a. Int -> [Item (RAList a)] -> RAList a
fromList :: [Item (RAList a)] -> RAList a
$cfromList :: forall a. [Item (RAList a)] -> RAList a
IsList,Rep (RAList a) x -> RAList a
RAList a -> Rep (RAList a) x
(forall x. RAList a -> Rep (RAList a) x)
-> (forall x. Rep (RAList a) x -> RAList a) -> Generic (RAList a)
forall x. Rep (RAList a) x -> RAList a
forall x. RAList a -> Rep (RAList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RAList a) x -> RAList a
forall a x. RAList a -> Rep (RAList a) x
to :: Rep (RAList a) x -> RAList a
$cto :: forall a x. Rep (RAList a) x -> RAList a
from :: RAList a -> Rep (RAList a) x
$cfrom :: forall a x. RAList a -> Rep (RAList a) x
Generic,RAList a -> ()
(RAList a -> ()) -> NFData (RAList a)
forall a. NFData a => RAList a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RAList a -> ()
$crnf :: forall a. NFData a => RAList a -> ()
NFData) via QRA.RAList a

type role RAList representational

--- > itraverse (\ix _val -> Id.Identity ix) $ ([(),(),(),()]:: Co.RAList ())
--- Identity (fromList [3,2,1,0])
--- but should this be done right to left or left to right??
instance   TraversableWithIndex Word64 RAList where
  {-# INLINE itraverse #-}
  itraverse :: (Word64 -> a -> f b) -> RAList a -> f (RAList b)
itraverse = \ Word64 -> a -> f b
f RAList a
s -> (Word64, f (RAList b)) -> f (RAList b)
forall a b. (a, b) -> b
snd ((Word64, f (RAList b)) -> f (RAList b))
-> (Word64, f (RAList b)) -> f (RAList b)
forall a b. (a -> b) -> a -> b
$ Indexing f (RAList b) -> Word64 -> (Word64, f (RAList b))
forall (f :: * -> *) a. Indexing f a -> Word64 -> (Word64, f a)
runIndexing
                ( Backwards (Indexing f) (RAList b) -> Indexing f (RAList b)
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (Indexing f) (RAList b) -> Indexing f (RAList b))
-> Backwards (Indexing f) (RAList b) -> Indexing f (RAList b)
forall a b. (a -> b) -> a -> b
$  (a -> Backwards (Indexing f) b)
-> RAList a -> Backwards (Indexing f) (RAList b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> Indexing f b -> Backwards (Indexing f) b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Indexing f b -> Backwards (Indexing f) b)
-> Indexing f b -> Backwards (Indexing f) b
forall a b. (a -> b) -> a -> b
$ (Word64 -> (Word64, f b)) -> Indexing f b
forall (f :: * -> *) a. (Word64 -> (Word64, f a)) -> Indexing f a
Indexing (\Word64
i -> Word64
i Word64 -> (Word64, f b) -> (Word64, f b)
`seq` (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word64 -> a -> f b
f Word64
i a
a))) RAList a
s) Word64
0
-- TODO; benchmark this vs counting downn from the start



instance   FoldableWithIndex Word64 RAList where
instance   FunctorWithIndex Word64 RAList where


instance Applicative RAList where
    {-# INLINE pure #-}
    pure :: a -> RAList a
pure = \a
x -> a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons a
x RAList a
forall a. RAList a
Nil
    {-# INLINE (<*>) #-}
    RAList (a -> b)
fs <*> :: RAList (a -> b) -> RAList a -> RAList b
<*> RAList a
xs = [a -> b
f a
x | a -> b
f <- RAList (a -> b)
fs, a
x <- RAList a
xs]
    {-# INLINE liftA2 #-}
    liftA2 :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
liftA2 a -> b -> c
f RAList a
xs RAList b
ys = [a -> b -> c
f a
x b
y | a
x <- RAList a
xs, b
y <- RAList b
ys]
    {-# INLINE (*>) #-}
    RAList a
xs *> :: RAList a -> RAList b -> RAList b
*> RAList b
ys  = [b
y | a
_ <- RAList a
xs, b
y <- RAList b
ys]

instance Monad RAList where
    return :: a -> RAList a
return = a -> RAList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: RAList a -> (a -> RAList b) -> RAList b
(>>=) = (\RAList a
ls a -> RAList b
f -> RAList b -> RAList b
forall a. RAList a -> RAList a
CoIndex (RAList b -> RAList b) -> RAList b -> RAList b
forall a b. (a -> b) -> a -> b
$ (a -> RAList b) -> RAList a -> RAList b
forall a b. (a -> RAList b) -> RAList a -> RAList b
QRA.concatMap (\ a
x -> RAList b -> RAList b
coerce (RAList b -> RAList b) -> RAList b -> RAList b
forall a b. (a -> b) -> a -> b
$ a -> RAList b
f a
x)   (RAList a -> RAList b) -> RAList a -> RAList b
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
ls   )



--- QUESTION --- am i wrong for using the Ziplist applicative with my monads?


{-



if we have <*> === zipWith ($)
that means we need to have the monad be the DIAGONLIZATION rather than concat map



we need  ap === <*>

ap                :: (Monad m) => m (a -> b) -> m a -> m b
ap m1 m2          = do { x1 <- m1; x2 <- m2; return (x1 x2) }
-- Since many Applicative instances define (<*>) = ap, we
-- cannot define ap = (<*>)
-}
instance MonadZip RAList where
  mzipWith :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
mzipWith = (a -> b -> c) -> RAList a -> RAList b -> RAList c
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith
  munzip :: RAList (a, b) -> (RAList a, RAList b)
munzip = RAList (a, b) -> (RAList a, RAList b)
forall a b. RAList (a, b) -> (RAList a, RAList b)
unzip

-- | implementation underlying smart constructor used by pattern synonyms
cons :: a -> RAList a -> RAList a
cons :: a -> RAList a -> RAList a
cons a
x (CoIndex RAList a
xs) = RAList a -> RAList a
forall a. RAList a -> RAList a
CoIndex (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$  a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
QRA.cons a
x RAList a
xs


-- | how matching is implemented
uncons :: RAList a -> Maybe (a, RAList a)
uncons :: RAList a -> Maybe (a, RAList a)
uncons (CoIndex RAList a
xs) = case RAList a -> Maybe (a, RAList a)
forall a. RAList a -> Maybe (a, RAList a)
QRA.uncons RAList a
xs of
                            Maybe (a, RAList a)
Nothing -> Maybe (a, RAList a)
forall a. Maybe a
Nothing
                            Just(a
h,RAList a
rest) -> (a, RAList a) -> Maybe (a, RAList a)
forall a. a -> Maybe a
Just (a
h,RAList a -> RAList a
forall a. RAList a -> RAList a
CoIndex RAList a
rest)


-- double check what the complexity is
-- | @'drop' i l@ drops the first @i@ elments, @O(log i)@  complexity,
drop :: Word64 -> RAList a -> RAList a
drop :: Word64 -> RAList a -> RAList a
drop = \ Word64
ix (CoIndex RAList a
ls)-> RAList a -> RAList a
forall a. RAList a -> RAList a
CoIndex (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
QRA.drop Word64
ix RAList a
ls

-- | @'take' i l@, keeps the first @i@ elements, @O(i)@ complexity
take :: Word64 -> RAList a -> RAList a
take :: Word64 -> RAList a -> RAList a
take = \Word64
ix (CoIndex RAList a
ls ) -> RAList a -> RAList a
forall a. RAList a -> RAList a
CoIndex (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
QRA.take Word64
ix RAList a
ls

--- being lazy? yes :)
-- | performs both drop and take
splitAt :: Word64 -> RAList a -> (RAList a, RAList a )
splitAt :: Word64 -> RAList a -> (RAList a, RAList a)
splitAt = Word64 -> RAList a -> (RAList a, RAList a)
forall n a. Integral n => n -> RAList a -> (RAList a, RAList a)
genericSplitAt


-- | @'replicate' n a @ makes a RAList with n values of a
replicate :: Word64 -> a -> RAList a
replicate :: Word64 -> a -> RAList a
replicate = Word64 -> a -> RAList a
forall n a. Integral n => n -> a -> RAList a
genericReplicate

-- | list zip,
zip :: RAList a -> RAList b -> RAList (a, b)
zip :: RAList a -> RAList b -> RAList (a, b)
zip = (a -> b -> (a, b)) -> RAList a -> RAList b -> RAList (a, b)
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith (,)

{-# INLINE unzip #-}
-- adapted from List definition in base
-- not perfectly certain about  being lazy on the *rest*
-- but lets leave it for now... though i think my cons
-- algorithm precludes it from actually being properly lazy
-- TODO : mess with foldr' vs foldr and ~ vs ! for as and bs from unzip definition
unzip :: RAList (a,b) -> (RAList a,RAList b)
unzip :: RAList (a, b) -> (RAList a, RAList b)
unzip    =  ((a, b) -> (RAList a, RAList b) -> (RAList a, RAList b))
-> (RAList a, RAList b) -> RAList (a, b) -> (RAList a, RAList b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\(a
a,b
b) (!RAList a
as,!RAList b
bs) -> (a
aa -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
:| RAList a
as,b
bb -> RAList b -> RAList b
forall a. a -> RAList a -> RAList a
:|RAList b
bs)) (RAList a
forall a. RAList a
Nil,RAList b
forall a. RAList a
Nil)

--unzip    =  foldr (\(a,b) ~(as,bs) -> (a:| as,b:|bs)) (Nil,Nil)

--- this zipWith has better efficiency  than the opposite one
-- in the case of differing  length RALists, because we can drop from the front
-- efficiently but not from the back!
-- we need to do this flip around
--- this semantic arise from counting the indexing from the rear in this module
zipWith :: (a -> b -> c ) -> RAList a -> RAList b -> RAList c
zipWith :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith = \a -> b -> c
f (CoIndex RAList a
as) (CoIndex RAList b
bs) ->
              let
                !alen :: Word64
alen = RAList a -> Word64
forall a. RAList a -> Word64
QRA.wLength RAList a
as
                !blen :: Word64
blen = RAList b -> Word64
forall a. RAList a -> Word64
QRA.wLength RAList b
bs
                in
                  case Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
alen Word64
blen of
                    Ordering
EQ -> RAList c -> RAList c
forall a. RAList a -> RAList a
CoIndex (RAList c -> RAList c) -> RAList c -> RAList c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> RAList a -> RAList b -> RAList c
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
QRA.zipWith a -> b -> c
f  RAList a
as RAList b
bs
                    Ordering
GT {- alen > blen  -}->
                      RAList c -> RAList c
forall a. RAList a -> RAList a
CoIndex (RAList c -> RAList c) -> RAList c -> RAList c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> RAList a -> RAList b -> RAList c
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
QRA.zipWith a -> b -> c
f  (Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
QRA.drop (Word64
alen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
blen) RAList a
as)
                                               RAList b
bs
                    Ordering
LT {- alen < blen -} ->
                      RAList c -> RAList c
forall a. RAList a -> RAList a
CoIndex (RAList c -> RAList c) -> RAList c -> RAList c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> RAList a -> RAList b -> RAList c
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
QRA.zipWith a -> b -> c
f RAList a
as
                                              (Word64 -> RAList b -> RAList b
forall a. Word64 -> RAList a -> RAList a
QRA.drop (Word64
blen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
alen ) RAList b
bs)
{-# INLINE (!!) #-}
(!!) :: RAList a -> Word64 -> a
RAList a
rls  !! :: RAList a -> Word64 -> a
!! Word64
n |  Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word64
0 = String -> a
forall a. HasCallStack => String -> a
error String
"Data.RAList.Flip.!!: negative index"
                        | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= (RAList a -> Word64
forall a. RAList a -> Word64
wLength  RAList a
rls)  = String -> a
forall a. HasCallStack => String -> a
error String
"Data.RAList.Flip.!!: index too large"
                        | Bool
otherwise =  RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
rls RAList a -> Word64 -> a
forall a. RAList a -> Word64 -> a
QRA.!! ((RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
rls)  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n )
{-# INLINE lookupWithDefault #-}
lookupWithDefault :: forall t. t -> Word64 -> RAList t -> t
lookupWithDefault :: t -> Word64 -> RAList t -> t
lookupWithDefault = \ t
def Word64
ix RAList t
tree -> t -> Word64 -> RAList t -> t
forall t. t -> Word64 -> RAList t -> t
QRA.lookupWithDefault t
def ((RAList t -> Word64
forall a. RAList a -> Word64
wLength RAList t
tree) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
ix ) (RAList t -> t) -> RAList t -> t
forall a b. (a -> b) -> a -> b
$ RAList t -> RAList t
forall a. RAList a -> RAList a
reindex RAList t
tree


{-# INLINE lookupM #-}
lookupM :: forall a m . MF.MonadFail m =>  Word64 -> RAList a ->  m a
lookupM :: Word64 -> RAList a -> m a
lookupM = \ Word64
ix RAList a
tree ->  RAList a -> Word64 -> m a
forall a (m :: * -> *). MonadFail m => RAList a -> Word64 -> m a
QRA.lookupM  (RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
tree) ((RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
tree)  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
ix)

{-# INLINE lookup #-}
lookup :: forall a. RAList a -> Word64 ->  Maybe a
lookup :: RAList a -> Word64 -> Maybe a
lookup =  \ (CoIndex RAList a
tree) Word64
ix -> RAList a -> Word64 -> Maybe a
forall a. RAList a -> Word64 -> Maybe a
QRA.lookup  RAList a
tree  ((RAList a -> Word64
forall a. RAList a -> Word64
QRA.wLength RAList a
tree) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
ix )

{-# INLINE lookupCC #-}
lookupCC :: RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC :: RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC = \  RAList a
tree Word64
ix a -> r
f String -> r
g ->  RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
QRA.lookupCC (RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
tree) ((RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
tree) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
ix ) a -> r
f String -> r
g

{-# INLINE wLength #-}
wLength:: RAList a -> Word64
wLength :: RAList a -> Word64
wLength = \ (CoIndex RAList a
ls) -> RAList a -> Word64
forall a. RAList a -> Word64
QRA.wLength RAList a
ls

(++) :: RAList a -> RAList a -> RAList a
++ :: RAList a -> RAList a -> RAList a
(++) = RAList a -> RAList a -> RAList a
forall a. Semigroup a => a -> a -> a
(<>)



partition :: (a->Bool) -> RAList a -> (RAList a, RAList a)
partition :: (a -> Bool) -> RAList a -> (RAList a, RAList a)
partition = \ a -> Bool
f  RAList a
ls -> (case  (a -> Bool) -> RAList a -> (RAList a, RAList a)
forall a. (a -> Bool) -> RAList a -> (RAList a, RAList a)
QRA.partition a -> Bool
f (RAList a -> (RAList a, RAList a))
-> RAList a -> (RAList a, RAList a)
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
coerce RAList a
ls of (RAList a
la, RAList a
lb ) -> (RAList a -> RAList a
coerce RAList a
la , RAList a -> RAList a
coerce RAList a
lb)   )

filter :: forall a . (a -> Bool) -> RAList a -> RAList a
filter :: (a -> Bool) -> RAList a -> RAList a
filter = \ a -> Bool
f RAList a
ls ->  RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> RAList a -> RAList a
forall a. (a -> Bool) -> RAList a -> RAList a
QRA.filter a -> Bool
f (RAList a -> RAList a
coerce RAList a
ls )


catMaybes :: RAList (Maybe a) -> RAList a
catMaybes :: RAList (Maybe a) -> RAList a
catMaybes = \RAList (Maybe a)
ls -> RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ (RAList (Maybe a) -> RAList a
forall a. RAList (Maybe a) -> RAList a
QRA.catMaybes (RAList (Maybe a) -> RAList a) -> RAList (Maybe a) -> RAList a
forall a b. (a -> b) -> a -> b
$ (forall a. RAList (Maybe a) -> RAList (Maybe a)
coerce ::  RAList (Maybe a) -> QRA.RAList (Maybe a)) RAList (Maybe a)
ls)


wither :: forall a b f . (Applicative f) =>
        (a -> f (Maybe b)) -> RAList a -> f (RAList b)
wither :: (a -> f (Maybe b)) -> RAList a -> f (RAList b)
wither = \a -> f (Maybe b)
f RAList a
la ->    Coercion (f (RAList b)) (f (RAList b))
-> f (RAList b) -> f (RAList b)
forall a b. Coercion a b -> a -> b
coerceWith Coercion (f (RAList b)) (f (RAList b))
forall a b (f :: * -> *).
(Coercible a b, Functor f) =>
Coercion (f a) (f b)
coerceThroughFunctor     (f (RAList b) -> f (RAList b)) -> f (RAList b) -> f (RAList b)
forall a b. (a -> b) -> a -> b
$ (a -> f (Maybe b)) -> RAList a -> f (RAList b)
forall a b (f :: * -> *).
Applicative f =>
(a -> f (Maybe b)) -> RAList a -> f (RAList b)
QRA.wither a -> f (Maybe b)
f (RAList a -> f (RAList b)) -> RAList a -> f (RAList b)
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
coerce RAList a
la
---
-- applicatives / functors can be coerced under, i have spoken
{-
for context, i otherwise need to do the following :
wither :: forall a b f . (Applicative f, (forall c d .  Coercible c d => Coercible (f c) (f d))  ) =>
        (a -> f (Maybe b)) -> RAList a -> f (RAList b)
wither = \f la ->    coerce     $ QRA.wither f $ coerce la
-}
{-#INLINE coerceThroughFunctor #-}
coerceThroughFunctor :: forall a b f.  (Coercible a b, Functor f) => (Coercion (f a) (f b))
coerceThroughFunctor :: Coercion (f a) (f b)
coerceThroughFunctor = (Coercion a b -> Coercion (f a) (f b)
forall a b. a -> b
unsafeCoerce (Coercion a b
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion :: Coercion a b  )) :: (Coercion (f a) (f b))

---

mapMaybe :: forall a b .  (a -> Maybe b) -> RAList a -> RAList b
mapMaybe :: (a -> Maybe b) -> RAList a -> RAList b
mapMaybe =  \a -> Maybe b
f RAList a
la ->    RAList b -> RAList b
coerce     (RAList b -> RAList b) -> RAList b -> RAList b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> RAList a -> RAList b
forall a b. (a -> Maybe b) -> RAList a -> RAList b
QRA.mapMaybe a -> Maybe b
f (RAList a -> RAList b) -> RAList a -> RAList b
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
coerce RAList a
la

genericLength :: forall a w . Integral w =>RAList a -> w
genericLength :: RAList a -> w
genericLength RAList a
x = RAList a -> w
forall w a. Integral w => RAList a -> w
QRA.genericLength (RAList a -> w) -> RAList a -> w
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
x

genericTake :: forall a n .  Integral n => n -> RAList a -> RAList a
genericTake :: n -> RAList a -> RAList a
genericTake n
i RAList a
x = RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ n -> RAList a -> RAList a
forall n a. Integral n => n -> RAList a -> RAList a
QRA.genericTake n
i (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$  (RAList a -> RAList a
coerce :: RAList a -> QRA.RAList a)  RAList a
x

genericDrop :: Integral n => n -> RAList a -> RAList a
genericDrop :: n -> RAList a -> RAList a
genericDrop  n
i RAList a
x  = RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$  n -> RAList a -> RAList a
forall n a. Integral n => n -> RAList a -> RAList a
QRA.genericDrop  n
i (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ (forall a. RAList a -> RAList a
coerce :: RAList a -> QRA.RAList a) RAList a
x

genericSplitAt :: Integral n => n  -> RAList a -> (RAList a, RAList a)
genericSplitAt :: n -> RAList a -> (RAList a, RAList a)
genericSplitAt n
i RAList a
x =  case n -> RAList a -> (RAList a, RAList a)
forall n a. Integral n => n -> RAList a -> (RAList a, RAList a)
QRA.genericSplitAt n
i (RAList a -> (RAList a, RAList a))
-> RAList a -> (RAList a, RAList a)
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
x of (RAList a
a,RAList a
b) -> (RAList a -> RAList a
coerce RAList a
a, RAList a -> RAList a
coerce RAList a
b)

genericIndex :: Integral n => RAList a -> n -> a
genericIndex :: RAList a -> n -> a
genericIndex  RAList a
x n
i  = RAList a -> n -> a
forall n a. Integral n => RAList a -> n -> a
QRA.genericIndex (RAList a -> RAList a
forall a. RAList a -> RAList a
reindex RAList a
x) n
i

genericReplicate :: Integral n => n -> a -> RAList a
genericReplicate :: n -> a -> RAList a
genericReplicate n
i a
v = RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ n -> a -> RAList a
forall n a. Integral n => n -> a -> RAList a
genericReplicate n
i a
v


update ::  Word64 -> a -> RAList a -> RAList a
update :: Word64 -> a -> RAList a -> RAList a
update Word64
i a
v RAList a
l = (a -> a) -> Word64 -> RAList a -> RAList a
forall a. (a -> a) -> Word64 -> RAList a -> RAList a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
v) Word64
i RAList a
l


adjust :: forall a . (a->a) -> Word64 -> RAList a -> RAList a
adjust :: (a -> a) -> Word64 -> RAList a -> RAList a
adjust a -> a
f Word64
i RAList a
l =  RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Word64 -> RAList a -> RAList a
forall a. (a -> a) -> Word64 -> RAList a -> RAList a
adjust a -> a
f Word64
i (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ RAList a -> RAList a
coerce RAList a
l


unfoldr :: (b -> Maybe (a, b)) -> b -> RAList a
unfoldr :: (b -> Maybe (a, b)) -> b -> RAList a
unfoldr b -> Maybe (a, b)
f b
init = RAList a -> RAList a
coerce (RAList a -> RAList a) -> RAList a -> RAList a
forall a b. (a -> b) -> a -> b
$ (b -> Maybe (a, b)) -> b -> RAList a
forall b a. (b -> Maybe (a, b)) -> b -> RAList a
QRA.unfoldr b -> Maybe (a, b)
f b
init