{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE EmptyCase             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE Safe                  #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
-- | Length-indexed random access list.
--
-- See <http://www.staff.science.uu.nl/~swier004/publications/2019-jfp-submission.pdf>
module Data.RAVec (
    -- * Random access list
    RAVec (..),

    -- * Construction
    empty,
    singleton,
    cons,
    withCons,
    head,
    last,

    -- * Conversion
    toList,
    toNonEmpty,
    fromList,
    reifyList,
    reifyNonEmpty,

    -- * Indexing
    (!),
    tabulate,

    -- * Folds
    foldMap,
    foldMap1,
    ifoldMap,
    ifoldMap1,
    foldr,
    ifoldr,

    -- * Special folds
    null,

    -- * Mapping
    map,
    imap,
    traverse,
    itraverse,
#ifdef MIN_VERSION_semigroupoids
    traverse1,
    itraverse1,
#endif

    -- * Zipping
    zipWith,
    izipWith,

    -- * Universe
    universe,
    repeat,

    -- * QuickCheck
    liftArbitrary,
    liftShrink,
    )  where

import Prelude
       (Bool (..), Eq (..), Functor (..), Int, Maybe (..), Ord (..), Show, ($),
       (.))

import Control.Applicative (Applicative (..), (<$>))
import Control.DeepSeq     (NFData (..))
import Data.Bin            (Bin (..))
import Data.Bin.Pos        (Pos (..))
import Data.Hashable       (Hashable (..))
import Data.List.NonEmpty  (NonEmpty (..))
import Data.Monoid         (Monoid (..))
import Data.Semigroup      (Semigroup (..))
import Data.Type.Bin       (SBin (..), SBinI (..), SBinPI (..))
import Data.Typeable       (Typeable)

import qualified Data.RAVec.NonEmpty as NE
import qualified Data.Type.Bin       as B

import qualified Data.Foldable    as I (Foldable (..))
import qualified Data.Traversable as I (Traversable (..))
import qualified Test.QuickCheck  as QC

import qualified Data.Foldable.WithIndex    as WI (FoldableWithIndex (..))
import qualified Data.Functor.WithIndex     as WI (FunctorWithIndex (..))
import qualified Data.Traversable.WithIndex as WI (TraversableWithIndex (..))

#ifdef MIN_VERSION_distributive
import qualified Data.Distributive as I (Distributive (..))

#ifdef MIN_VERSION_adjunctions
import qualified Data.Functor.Rep as I (Representable (..))
#endif
#endif

#ifdef MIN_VERSION_semigroupoids
import Data.Functor.Apply (Apply (..))

import qualified Data.Semigroup.Foldable    as I (Foldable1 (..))
import qualified Data.Semigroup.Traversable as I (Traversable1 (..))
#endif

import Data.RAVec.NonEmpty (NERAVec (..))
import TrustworthyCompat

-- $setup
-- >>> :set -XScopedTypeVariables -XDataKinds
-- >>> import Prelude (print, Char, Bounded (..), Maybe (..), (.), ($), Eq (..))
-- >>> import Data.List (sort)
-- >>> import Data.Wrd (Wrd (..))
-- >>> import Data.Bin.Pos (Pos (..), top, pop)
-- >>> import Data.BinP.PosP (PosP (..), PosP' (..))
-- >>> import Data.List.NonEmpty (NonEmpty (..))
-- >>> import qualified Data.Bin.Pos as P
-- >>> import qualified Data.Type.Bin as B

-------------------------------------------------------------------------------
-- Random access vec
-------------------------------------------------------------------------------

-- | Length indexed random access lists.
data RAVec (b :: Bin) a where
    Empty    :: RAVec 'BZ a
    NonEmpty :: NERAVec b a -> RAVec ('BP b) a
  deriving (Typeable)

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

deriving instance Eq a   => Eq   (RAVec b a)
deriving instance Show a => Show (RAVec b a)

instance Ord a => Ord (RAVec b a) where
    compare :: RAVec b a -> RAVec b a -> Ordering
compare RAVec b a
xs RAVec b a
ys = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RAVec b a -> [a]
forall (b :: Bin) a. RAVec b a -> [a]
toList RAVec b a
xs) (RAVec b a -> [a]
forall (b :: Bin) a. RAVec b a -> [a]
toList RAVec b a
ys)

instance Functor (RAVec b) where
    fmap :: (a -> b) -> RAVec b a -> RAVec b b
fmap = (a -> b) -> RAVec b a -> RAVec b b
forall a b (n :: Bin). (a -> b) -> RAVec n a -> RAVec n b
map

instance I.Foldable (RAVec b) where
    foldMap :: (a -> m) -> RAVec b a -> m
foldMap    = (a -> m) -> RAVec b a -> m
forall m a (n :: Bin). Monoid m => (a -> m) -> RAVec n a -> m
foldMap
    foldr :: (a -> b -> b) -> b -> RAVec b a -> b
foldr      = (a -> b -> b) -> b -> RAVec b a -> b
forall a b (n :: Bin). (a -> b -> b) -> b -> RAVec n a -> b
foldr

#if MIN_VERSION_base(4,8,0)
    null :: RAVec b a -> Bool
null = RAVec b a -> Bool
forall (b :: Bin) a. RAVec b a -> Bool
null
#endif

instance I.Traversable (RAVec b) where
    traverse :: (a -> f b) -> RAVec b a -> f (RAVec b b)
traverse = (a -> f b) -> RAVec b a -> f (RAVec b b)
forall (f :: * -> *) a b (n :: Bin).
Applicative f =>
(a -> f b) -> RAVec n a -> f (RAVec n b)
traverse

-- | @since 0.2
instance WI.FunctorWithIndex (Pos n) (RAVec n) where
    imap :: (Pos n -> a -> b) -> RAVec n a -> RAVec n b
imap = (Pos n -> a -> b) -> RAVec n a -> RAVec n b
forall (n :: Bin) a b. (Pos n -> a -> b) -> RAVec n a -> RAVec n b
imap

-- | @since 0.2
instance WI.FoldableWithIndex (Pos n) (RAVec n) where
    ifoldMap :: (Pos n -> a -> m) -> RAVec n a -> m
ifoldMap = (Pos n -> a -> m) -> RAVec n a -> m
forall m (b :: Bin) a.
Monoid m =>
(Pos b -> a -> m) -> RAVec b a -> m
ifoldMap
    ifoldr :: (Pos n -> a -> b -> b) -> b -> RAVec n a -> b
ifoldr   = (Pos n -> a -> b -> b) -> b -> RAVec n a -> b
forall (n :: Bin) a b.
(Pos n -> a -> b -> b) -> b -> RAVec n a -> b
ifoldr

-- | @since 0.2
instance WI.TraversableWithIndex (Pos n) (RAVec n) where
    itraverse :: (Pos n -> a -> f b) -> RAVec n a -> f (RAVec n b)
itraverse = (Pos n -> a -> f b) -> RAVec n a -> f (RAVec n b)
forall (f :: * -> *) (n :: Bin) a b.
Applicative f =>
(Pos n -> a -> f b) -> RAVec n a -> f (RAVec n b)
itraverse

#ifdef MIN_VERSION_semigroupoids
instance b ~ 'BP n => I.Foldable1 (RAVec b) where
    foldMap1 :: (a -> m) -> RAVec b a -> m
foldMap1   = (a -> m) -> RAVec b a -> m
forall m a (b :: BinP).
Semigroup m =>
(a -> m) -> RAVec ('BP b) a -> m
foldMap1
    toNonEmpty :: RAVec b a -> NonEmpty a
toNonEmpty = RAVec b a -> NonEmpty a
forall (b :: BinP) a. RAVec ('BP b) a -> NonEmpty a
toNonEmpty

instance b ~ 'BP n => I.Traversable1 (RAVec b) where
    traverse1 :: (a -> f b) -> RAVec b a -> f (RAVec b b)
traverse1 = (a -> f b) -> RAVec b a -> f (RAVec b b)
forall (f :: * -> *) a b (n :: BinP).
Apply f =>
(a -> f b) -> RAVec ('BP n) a -> f (RAVec ('BP n) b)
traverse1
#endif

instance NFData a => NFData (RAVec b a) where
    rnf :: RAVec b a -> ()
rnf RAVec b a
Empty          = ()
    rnf (NonEmpty NERAVec b a
ral) = NERAVec b a -> ()
forall a. NFData a => a -> ()
rnf NERAVec b a
ral

instance Hashable a => Hashable (RAVec b a) where
    hashWithSalt :: Int -> RAVec b a -> Int
hashWithSalt Int
salt = Int -> [a] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ([a] -> Int) -> (RAVec b a -> [a]) -> RAVec b a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAVec b a -> [a]
forall (b :: Bin) a. RAVec b a -> [a]
toList

instance SBinI b => Applicative (RAVec b) where
    pure :: a -> RAVec b a
pure   = a -> RAVec b a
forall (b :: Bin) a. SBinI b => a -> RAVec b a
repeat
    <*> :: RAVec b (a -> b) -> RAVec b a -> RAVec b b
(<*>)  = ((a -> b) -> a -> b) -> RAVec b (a -> b) -> RAVec b a -> RAVec b b
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
    RAVec b a
x <* :: RAVec b a -> RAVec b b -> RAVec b a
<* RAVec b b
_ = RAVec b a
x
    RAVec b a
_ *> :: RAVec b a -> RAVec b b -> RAVec b b
*> RAVec b b
x = RAVec b b
x
#if MIN_VERSION_base(4,10,0)
    liftA2 :: (a -> b -> c) -> RAVec b a -> RAVec b b -> RAVec b c
liftA2 = (a -> b -> c) -> RAVec b a -> RAVec b b -> RAVec b c
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith
#endif

-- TODO: Monad?

#ifdef MIN_VERSION_distributive
instance SBinI b => I.Distributive (RAVec b) where
    distribute :: f (RAVec b a) -> RAVec b (f a)
distribute f (RAVec b a)
f = (Pos b -> f a) -> RAVec b (f a)
forall (b :: Bin) a. SBinI b => (Pos b -> a) -> RAVec b a
tabulate (\Pos b
k -> (RAVec b a -> a) -> f (RAVec b a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RAVec b a -> Pos b -> a
forall (b :: Bin) a. RAVec b a -> Pos b -> a
! Pos b
k) f (RAVec b a)
f)

#ifdef MIN_VERSION_adjunctions
instance SBinI b => I.Representable (RAVec b) where
    type Rep (RAVec b) = Pos b
    index :: RAVec b a -> Rep (RAVec b) -> a
index    = (!)
    tabulate :: (Rep (RAVec b) -> a) -> RAVec b a
tabulate = (Rep (RAVec b) -> a) -> RAVec b a
forall (b :: Bin) a. SBinI b => (Pos b -> a) -> RAVec b a
tabulate

#endif
#endif

instance Semigroup a => Semigroup (RAVec b a) where
    <> :: RAVec b a -> RAVec b a -> RAVec b a
(<>) = (a -> a -> a) -> RAVec b a -> RAVec b a -> RAVec b a
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid a, SBinI b) => Monoid (RAVec b a) where
    mempty :: RAVec b a
mempty  = a -> RAVec b a
forall (b :: Bin) a. SBinI b => a -> RAVec b a
repeat a
forall a. Monoid a => a
mempty
    mappend :: RAVec b a -> RAVec b a -> RAVec b a
mappend = (a -> a -> a) -> RAVec b a -> RAVec b a -> RAVec b a
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

#ifdef MIN_VERSION_semigroupoids
instance Apply (RAVec b) where
    <.> :: RAVec b (a -> b) -> RAVec b a -> RAVec b b
(<.>) = ((a -> b) -> a -> b) -> RAVec b (a -> b) -> RAVec b a -> RAVec b b
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
    liftF2 :: (a -> b -> c) -> RAVec b a -> RAVec b b -> RAVec b c
liftF2 = (a -> b -> c) -> RAVec b a -> RAVec b b -> RAVec b c
forall a b c (n :: Bin).
(a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith
    RAVec b a
_ .> :: RAVec b a -> RAVec b b -> RAVec b b
.> RAVec b b
x = RAVec b b
x
    RAVec b a
x <. :: RAVec b a -> RAVec b b -> RAVec b a
<. RAVec b b
_ = RAVec b a
x
#endif

-- TODO: I.Bind?

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

empty :: RAVec B.Bin0 a
empty :: RAVec Bin0 a
empty = RAVec Bin0 a
forall a. RAVec Bin0 a
Empty

singleton :: a -> RAVec B.Bin1 a
singleton :: a -> RAVec Bin1 a
singleton = NERAVec BinP1 a -> RAVec Bin1 a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec BinP1 a -> RAVec Bin1 a)
-> (a -> NERAVec BinP1 a) -> a -> RAVec Bin1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NERAVec BinP1 a
forall a. a -> NERAVec BinP1 a
NE.singleton

-- | Cons an element in front of 'RAVec'.
--
-- >>> reifyList "xyz" (print . toList . cons 'a')
-- "axyz"
--
cons :: a -> RAVec b a -> RAVec (B.Succ b) a
cons :: a -> RAVec b a -> RAVec (Succ b) a
cons a
x RAVec b a
Empty         = a -> RAVec Bin1 a
forall a. a -> RAVec Bin1 a
singleton a
x
cons a
x (NonEmpty NERAVec b a
xs) = NERAVec (Succ b) a -> RAVec ('BP (Succ b)) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (a -> NERAVec b a -> NERAVec (Succ b) a
forall a (b :: BinP). a -> NERAVec b a -> NERAVec (Succ b) a
NE.cons a
x NERAVec b a
xs)

-- | Variant of 'cons' which computes the 'SBinI' dictionary at the same time.
withCons :: SBinI b => a -> RAVec b a -> (SBinPI (B.Succ' b) => RAVec (B.Succ b) a -> r) -> r
withCons :: a -> RAVec b a -> (SBinPI (Succ' b) => RAVec (Succ b) a -> r) -> r
withCons = SBin b
-> a
-> RAVec b a
-> (SBinPI (Succ' b) => RAVec (Succ b) a -> r)
-> r
forall (b :: Bin) a r.
SBin b
-> a
-> RAVec b a
-> (SBinPI (Succ' b) => RAVec (Succ b) a -> r)
-> r
go SBin b
forall (b :: Bin). SBinI b => SBin b
sbin where
    go :: SBin b -> a -> RAVec b a -> (SBinPI (B.Succ' b) => RAVec (B.Succ b) a -> r) -> r
    go :: SBin b
-> a
-> RAVec b a
-> (SBinPI (Succ' b) => RAVec (Succ b) a -> r)
-> r
go SBin b
SBZ a
x RAVec b a
Empty SBinPI (Succ' b) => RAVec (Succ b) a -> r
k         = SBinPI (Succ' b) => RAVec (Succ b) a -> r
RAVec (Succ b) a -> r
k (a -> RAVec Bin1 a
forall a. a -> RAVec Bin1 a
singleton a
x)
    go SBin b
SBP a
x (NonEmpty NERAVec b a
xs) SBinPI (Succ' b) => RAVec (Succ b) a -> r
k = a
-> NERAVec b a -> (SBinPI (Succ b) => NERAVec (Succ b) a -> r) -> r
forall (b :: BinP) a r.
SBinPI b =>
a
-> NERAVec b a -> (SBinPI (Succ b) => NERAVec (Succ b) a -> r) -> r
NE.withCons a
x NERAVec b a
xs ((SBinPI (Succ b) => NERAVec (Succ b) a -> r) -> r)
-> (SBinPI (Succ b) => NERAVec (Succ b) a -> r) -> r
forall a b. (a -> b) -> a -> b
$ SBinPI (Succ' b) => RAVec (Succ b) a -> r
RAVec ('BP (Succ b1)) a -> r
k (RAVec ('BP (Succ b1)) a -> r)
-> (NERAVec (Succ b1) a -> RAVec ('BP (Succ b1)) a)
-> NERAVec (Succ b1) a
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NERAVec (Succ b1) a -> RAVec ('BP (Succ b1)) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty

-- | The first element of a non-empty 'RAVec'.
--
-- >>> reifyNonEmpty ('x' :| "yz") head
-- 'x'
--
head :: RAVec ('BP b) a -> a
head :: RAVec ('BP b) a -> a
head (NonEmpty NERAVec b a
ral) = NERAVec b a -> a
forall (b :: BinP) a. NERAVec b a -> a
NE.head NERAVec b a
ral

-- | The last element of a non-empty 'RAVec'.
--
-- >>> reifyNonEmpty ('x' :| "yz") last
-- 'z'
--
last :: RAVec ('BP b) a -> a
last :: RAVec ('BP b) a -> a
last (NonEmpty NERAVec b a
ral) = NERAVec b a -> a
forall (b :: BinP) a. NERAVec b a -> a
NE.last NERAVec b a
ral

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

toList :: RAVec b a -> [a]
toList :: RAVec b a -> [a]
toList RAVec b a
Empty          = []
toList (NonEmpty NERAVec b a
ral) = NERAVec b a -> [a]
forall (b :: BinP) a. NERAVec b a -> [a]
NE.toList NERAVec b a
ral

toNonEmpty :: RAVec ('BP b) a -> NonEmpty a
toNonEmpty :: RAVec ('BP b) a -> NonEmpty a
toNonEmpty (NonEmpty NERAVec b a
ral) = NERAVec b a -> NonEmpty a
forall (b :: BinP) a. NERAVec b a -> NonEmpty a
NE.toNonEmpty NERAVec b a
ral

-- | Convert a list @[a]@ to @'RAVec' b a@.
-- Returns 'Nothing' if lengths don't match.
--
-- >>> fromList "foo" :: Maybe (RAVec B.Bin3 Char)
-- Just (NonEmpty (NE (Cons1 (Leaf 'f') (Last (Node (Leaf 'o') (Leaf 'o'))))))
--
-- >>> fromList "quux" :: Maybe (RAVec B.Bin3 Char)
-- Nothing
--
-- >>> fromList "xy" :: Maybe (RAVec B.Bin3 Char)
-- Nothing
--
fromList :: forall b a. SBinI b => [a] -> Maybe (RAVec b a)
fromList :: [a] -> Maybe (RAVec b a)
fromList [a]
xs = [a]
-> (forall (b :: Bin). SBinI b => RAVec b a -> Maybe (RAVec b a))
-> Maybe (RAVec b a)
forall a r.
[a] -> (forall (b :: Bin). SBinI b => RAVec b a -> r) -> r
reifyList [a]
xs forall (b :: Bin). SBinI b => RAVec b a -> Maybe (RAVec b a)
mk where
    mk :: forall c. SBinI c => RAVec c a -> Maybe (RAVec b a)
    mk :: RAVec c a -> Maybe (RAVec b a)
mk RAVec c a
ral = do
        (:~:) @Bin b c
Refl <- Maybe ((:~:) @Bin b c)
forall (a :: Bin) (b :: Bin).
(SBinI a, SBinI b) =>
Maybe ((:~:) @Bin a b)
B.eqBin :: Maybe (b :~: c)
        RAVec c a -> Maybe (RAVec c a)
forall a. a -> Maybe a
Just RAVec c a
ral

-- |
--
-- >>> reifyList "foo" print
-- NonEmpty (NE (Cons1 (Leaf 'f') (Last (Node (Leaf 'o') (Leaf 'o')))))
--
-- >>> reifyList "xyzzy" toList
-- "xyzzy"
reifyList :: [a] -> (forall b. SBinI b => RAVec b a -> r) -> r
reifyList :: [a] -> (forall (b :: Bin). SBinI b => RAVec b a -> r) -> r
reifyList []     forall (b :: Bin). SBinI b => RAVec b a -> r
k = RAVec Bin0 a -> r
forall (b :: Bin). SBinI b => RAVec b a -> r
k RAVec Bin0 a
forall a. RAVec Bin0 a
Empty
reifyList (a
x:[a]
xs) forall (b :: Bin). SBinI b => RAVec b a -> r
k = [a] -> (forall (b :: Bin). SBinI b => RAVec b a -> r) -> r
forall a r.
[a] -> (forall (b :: Bin). SBinI b => RAVec b a -> r) -> r
reifyList [a]
xs ((forall (b :: Bin). SBinI b => RAVec b a -> r) -> r)
-> (forall (b :: Bin). SBinI b => RAVec b a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \RAVec b a
ral -> a -> RAVec b a -> (SBinPI (Succ' b) => RAVec (Succ b) a -> r) -> r
forall (b :: Bin) a r.
SBinI b =>
a -> RAVec b a -> (SBinPI (Succ' b) => RAVec (Succ b) a -> r) -> r
withCons a
x RAVec b a
ral SBinPI (Succ' b) => RAVec (Succ b) a -> r
forall (b :: Bin). SBinI b => RAVec b a -> r
k

reifyNonEmpty :: NonEmpty a -> (forall b. SBinPI b => RAVec ('BP b) a -> r) -> r
reifyNonEmpty :: NonEmpty a
-> (forall (b :: BinP). SBinPI b => RAVec ('BP b) a -> r) -> r
reifyNonEmpty NonEmpty a
xs forall (b :: BinP). SBinPI b => RAVec ('BP b) a -> r
k = NonEmpty a
-> (forall (b :: BinP). SBinPI b => NERAVec b a -> r) -> r
forall a r.
NonEmpty a
-> (forall (b :: BinP). SBinPI b => NERAVec b a -> r) -> r
NE.reifyNonEmpty NonEmpty a
xs ((forall (b :: BinP). SBinPI b => NERAVec b a -> r) -> r)
-> (forall (b :: BinP). SBinPI b => NERAVec b a -> r) -> r
forall a b. (a -> b) -> a -> b
$ RAVec ('BP b) a -> r
forall (b :: BinP). SBinPI b => RAVec ('BP b) a -> r
k (RAVec ('BP b) a -> r)
-> (NERAVec b a -> RAVec ('BP b) a) -> NERAVec b a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NERAVec b a -> RAVec ('BP b) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty

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

-- | Indexing.
--
-- >>> let ral :: RAVec B.Bin4 Char; Just ral = fromList "abcd"
--
-- >>> ral ! minBound
-- 'a'
--
-- >>> ral ! maxBound
-- 'd'
--
-- >>> ral ! pop top
-- 'b'
--
(!) :: RAVec b a -> Pos b -> a
(!) RAVec b a
Empty        Pos b
p       = case Pos b
p of {}
(!) (NonEmpty NERAVec b a
b) (Pos PosP b1
i) = NERAVec b a
b NERAVec b a -> PosP b -> a
forall (b :: BinP) a. NERAVec b a -> PosP b -> a
NE.! PosP b
PosP b1
i

tabulate :: forall b a. SBinI b => (Pos b -> a) -> RAVec b a
tabulate :: (Pos b -> a) -> RAVec b a
tabulate Pos b -> a
f = case SBin b
forall (b :: Bin). SBinI b => SBin b
sbin :: SBin b of
    SBin b
SBZ -> RAVec b a
forall a. RAVec Bin0 a
Empty
    SBin b
SBP -> NERAVec b1 a -> RAVec ('BP b1) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((PosP b1 -> a) -> NERAVec b1 a
forall (b :: BinP) a. SBinPI b => (PosP b -> a) -> NERAVec b a
NE.tabulate (Pos b -> a
f (Pos b -> a) -> (PosP b1 -> Pos b) -> PosP b1 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b1 -> Pos b
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos))

-------------------------------------------------------------------------------
-- Folds
-------------------------------------------------------------------------------

foldMap :: Monoid m => (a -> m) -> RAVec n a -> m
foldMap :: (a -> m) -> RAVec n a -> m
foldMap a -> m
_ RAVec n a
Empty        = m
forall a. Monoid a => a
mempty
foldMap a -> m
f (NonEmpty NERAVec b a
r) = (a -> m) -> NERAVec b a -> m
forall m a (b :: BinP). Monoid m => (a -> m) -> NERAVec b a -> m
NE.foldMap a -> m
f NERAVec b a
r

ifoldMap :: Monoid m => (Pos b -> a -> m) -> RAVec b a -> m
ifoldMap :: (Pos b -> a -> m) -> RAVec b a -> m
ifoldMap Pos b -> a -> m
_ RAVec b a
Empty        = m
forall a. Monoid a => a
mempty
ifoldMap Pos b -> a -> m
f (NonEmpty NERAVec b a
r) = (PosP b -> a -> m) -> NERAVec b a -> m
forall m (b :: BinP) a.
Monoid m =>
(PosP b -> a -> m) -> NERAVec b a -> m
NE.ifoldMap (Pos b -> a -> m
f (Pos b -> a -> m) -> (PosP b -> Pos b) -> PosP b -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos b
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec b a
r

foldMap1 :: Semigroup m => (a -> m) -> RAVec ('BP b) a -> m
foldMap1 :: (a -> m) -> RAVec ('BP b) a -> m
foldMap1 a -> m
f (NonEmpty NERAVec b a
r) = (a -> m) -> NERAVec b a -> m
forall m a (b :: BinP). Semigroup m => (a -> m) -> NERAVec b a -> m
NE.foldMap1 a -> m
f NERAVec b a
r

ifoldMap1 :: Semigroup m => (Pos ('BP b) -> a -> m) -> RAVec ('BP b) a -> m
ifoldMap1 :: (Pos ('BP b) -> a -> m) -> RAVec ('BP b) a -> m
ifoldMap1 Pos ('BP b) -> a -> m
f (NonEmpty NERAVec b a
r) = (PosP b -> a -> m) -> NERAVec b a -> m
forall m (b :: BinP) a.
Semigroup m =>
(PosP b -> a -> m) -> NERAVec b a -> m
NE.ifoldMap1 (Pos ('BP b) -> a -> m
f (Pos ('BP b) -> a -> m)
-> (PosP b -> Pos ('BP b)) -> PosP b -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos ('BP b)
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec b a
NERAVec b a
r

foldr :: (a -> b -> b) -> b -> RAVec n a -> b
foldr :: (a -> b -> b) -> b -> RAVec n a -> b
foldr a -> b -> b
_ b
z RAVec n a
Empty          = b
z
foldr a -> b -> b
f b
z (NonEmpty NERAVec b a
ral) = (a -> b -> b) -> b -> NERAVec b a -> b
forall a b (m :: BinP). (a -> b -> b) -> b -> NERAVec m a -> b
NE.foldr a -> b -> b
f b
z NERAVec b a
ral

ifoldr :: (Pos n -> a -> b -> b) -> b -> RAVec n a -> b
ifoldr :: (Pos n -> a -> b -> b) -> b -> RAVec n a -> b
ifoldr Pos n -> a -> b -> b
_ b
z RAVec n a
Empty          = b
z
ifoldr Pos n -> a -> b -> b
f b
z (NonEmpty NERAVec b a
ral) = (PosP b -> a -> b -> b) -> b -> NERAVec b a -> b
forall (m :: BinP) a b.
(PosP m -> a -> b -> b) -> b -> NERAVec m a -> b
NE.ifoldr (Pos n -> a -> b -> b
f (Pos n -> a -> b -> b)
-> (PosP b -> Pos n) -> PosP b -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos n
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) b
z NERAVec b a
ral

null :: RAVec n a -> Bool
null :: RAVec n a -> Bool
null RAVec n a
Empty        = Bool
True
null (NonEmpty NERAVec b a
_) = Bool
False

-------------------------------------------------------------------------------
-- Special folds
-------------------------------------------------------------------------------

-- TBW

-------------------------------------------------------------------------------
-- Mapping
-------------------------------------------------------------------------------

map :: (a -> b) -> RAVec n a -> RAVec n b
map :: (a -> b) -> RAVec n a -> RAVec n b
map a -> b
_ RAVec n a
Empty        = RAVec n b
forall a. RAVec Bin0 a
Empty
map a -> b
f (NonEmpty NERAVec b a
r) = NERAVec b b -> RAVec ('BP b) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((a -> b) -> NERAVec b a -> NERAVec b b
forall a b (m :: BinP). (a -> b) -> NERAVec m a -> NERAVec m b
NE.map a -> b
f NERAVec b a
r)

imap :: (Pos n -> a -> b) -> RAVec n a -> RAVec n b
imap :: (Pos n -> a -> b) -> RAVec n a -> RAVec n b
imap Pos n -> a -> b
_ RAVec n a
Empty = RAVec n b
forall a. RAVec Bin0 a
Empty
imap Pos n -> a -> b
f (NonEmpty NERAVec b a
r) = NERAVec b b -> RAVec ('BP b) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((PosP b -> a -> b) -> NERAVec b a -> NERAVec b b
forall (m :: BinP) a b.
(PosP m -> a -> b) -> NERAVec m a -> NERAVec m b
NE.imap (Pos n -> a -> b
f (Pos n -> a -> b) -> (PosP b -> Pos n) -> PosP b -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos n
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec b a
r)

traverse :: Applicative f => (a -> f b) -> RAVec n a -> f (RAVec n b)
traverse :: (a -> f b) -> RAVec n a -> f (RAVec n b)
traverse a -> f b
_ RAVec n a
Empty          = RAVec Bin0 b -> f (RAVec Bin0 b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RAVec Bin0 b
forall a. RAVec Bin0 a
empty
traverse a -> f b
f (NonEmpty NERAVec b a
ral) = NERAVec b b -> RAVec ('BP b) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec b b -> RAVec ('BP b) b)
-> f (NERAVec b b) -> f (RAVec ('BP b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> NERAVec b a -> f (NERAVec b b)
forall (f :: * -> *) a b (m :: BinP).
Applicative f =>
(a -> f b) -> NERAVec m a -> f (NERAVec m b)
NE.traverse a -> f b
f NERAVec b a
ral

itraverse :: Applicative f => (Pos n -> a -> f b) -> RAVec n a -> f (RAVec n b)
itraverse :: (Pos n -> a -> f b) -> RAVec n a -> f (RAVec n b)
itraverse Pos n -> a -> f b
_ RAVec n a
Empty        = RAVec Bin0 b -> f (RAVec Bin0 b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RAVec Bin0 b
forall a. RAVec Bin0 a
Empty
itraverse Pos n -> a -> f b
f (NonEmpty NERAVec b a
r) = NERAVec b b -> RAVec ('BP b) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec b b -> RAVec ('BP b) b)
-> f (NERAVec b b) -> f (RAVec ('BP b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PosP b -> a -> f b) -> NERAVec b a -> f (NERAVec b b)
forall (f :: * -> *) (m :: BinP) a b.
Applicative f =>
(PosP m -> a -> f b) -> NERAVec m a -> f (NERAVec m b)
NE.itraverse (Pos n -> a -> f b
f (Pos n -> a -> f b) -> (PosP b -> Pos n) -> PosP b -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos n
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec b a
r

#ifdef MIN_VERSION_semigroupoids
traverse1 :: Apply f => (a -> f b) -> RAVec ('BP n) a -> f (RAVec ('BP n) b)
traverse1 :: (a -> f b) -> RAVec ('BP n) a -> f (RAVec ('BP n) b)
traverse1 a -> f b
f (NonEmpty NERAVec b a
r) = NERAVec b b -> RAVec ('BP b) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec b b -> RAVec ('BP b) b)
-> f (NERAVec b b) -> f (RAVec ('BP b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> NERAVec b a -> f (NERAVec b b)
forall (f :: * -> *) a b (m :: BinP).
Apply f =>
(a -> f b) -> NERAVec m a -> f (NERAVec m b)
NE.traverse1 a -> f b
f NERAVec b a
r

itraverse1 :: Apply f => (Pos ('BP n) -> a -> f b) -> RAVec ('BP n) a -> f (RAVec ('BP n) b)
itraverse1 :: (Pos ('BP n) -> a -> f b) -> RAVec ('BP n) a -> f (RAVec ('BP n) b)
itraverse1 Pos ('BP n) -> a -> f b
f (NonEmpty NERAVec b a
r) = NERAVec n b -> RAVec ('BP n) b
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec n b -> RAVec ('BP n) b)
-> f (NERAVec n b) -> f (RAVec ('BP n) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PosP n -> a -> f b) -> NERAVec n a -> f (NERAVec n b)
forall (f :: * -> *) (m :: BinP) a b.
Apply f =>
(PosP m -> a -> f b) -> NERAVec m a -> f (NERAVec m b)
NE.itraverse1 (Pos ('BP n) -> a -> f b
f (Pos ('BP n) -> a -> f b)
-> (PosP n -> Pos ('BP n)) -> PosP n -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP n -> Pos ('BP n)
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec n a
NERAVec b a
r
#endif

-------------------------------------------------------------------------------
-- Zipping
-------------------------------------------------------------------------------

-- | Zip two 'RAVec's with a function.
zipWith :: (a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith :: (a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
zipWith a -> b -> c
_ RAVec n a
Empty         RAVec n b
Empty         = RAVec n c
forall a. RAVec Bin0 a
Empty
zipWith a -> b -> c
f (NonEmpty NERAVec b a
xs) (NonEmpty NERAVec b b
ys) = NERAVec b c -> RAVec ('BP b) c
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((a -> b -> c) -> NERAVec b a -> NERAVec b b -> NERAVec b c
forall a b c (m :: BinP).
(a -> b -> c) -> NERAVec m a -> NERAVec m b -> NERAVec m c
NE.zipWith a -> b -> c
f NERAVec b a
xs NERAVec b b
NERAVec b b
ys)

-- | Zip two 'RAVec's with a function which also takes 'Pos' index.
izipWith :: (Pos n -> a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
izipWith :: (Pos n -> a -> b -> c) -> RAVec n a -> RAVec n b -> RAVec n c
izipWith Pos n -> a -> b -> c
_ RAVec n a
Empty         RAVec n b
Empty         = RAVec n c
forall a. RAVec Bin0 a
Empty
izipWith Pos n -> a -> b -> c
f (NonEmpty NERAVec b a
xs) (NonEmpty NERAVec b b
ys) = NERAVec b c -> RAVec ('BP b) c
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((PosP b -> a -> b -> c)
-> NERAVec b a -> NERAVec b b -> NERAVec b c
forall (m :: BinP) a b c.
(PosP m -> a -> b -> c)
-> NERAVec m a -> NERAVec m b -> NERAVec m c
NE.izipWith (Pos n -> a -> b -> c
f (Pos n -> a -> b -> c)
-> (PosP b -> Pos n) -> PosP b -> a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosP b -> Pos n
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos) NERAVec b a
xs NERAVec b b
NERAVec b b
ys)

-- | Repeat a value.
--
-- >>> repeat 'x' :: RAVec B.Bin5 Char
-- NonEmpty (NE (Cons1 (Leaf 'x') (Cons0 (Last (Node (Node (Leaf 'x') (Leaf 'x')) (Node (Leaf 'x') (Leaf 'x')))))))
--
repeat :: forall b a. SBinI b => a -> RAVec b a
repeat :: a -> RAVec b a
repeat a
x = case SBin b
forall (b :: Bin). SBinI b => SBin b
sbin :: SBin b of
    SBin b
SBZ -> RAVec b a
forall a. RAVec Bin0 a
Empty
    SBin b
SBP -> NERAVec b1 a -> RAVec ('BP b1) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (a -> NERAVec b1 a
forall (b :: BinP) a. SBinPI b => a -> NERAVec b a
NE.repeat a
x)

-------------------------------------------------------------------------------
-- Universe
-------------------------------------------------------------------------------

-- |
--
-- >>> universe :: RAVec B.Bin2 (Pos B.Bin2)
-- NonEmpty (NE (Cons0 (Last (Node (Leaf 0) (Leaf 1)))))
--
-- >>> let u = universe :: RAVec B.Bin3 (Pos B.Bin3)
-- >>> u
-- NonEmpty (NE (Cons1 (Leaf 0) (Last (Node (Leaf 1) (Leaf 2)))))
--
-- >>> P.explicitShow $ u ! Pos (PosP (Here WE))
-- "Pos (PosP (Here WE))"
--
-- >>> let u' = universe :: RAVec B.Bin5 (Pos B.Bin5)
--
-- >>> toList u' == sort (toList u')
-- True
--
universe :: forall b. SBinI b => RAVec b (Pos b)
universe :: RAVec b (Pos b)
universe = case SBin b
forall (b :: Bin). SBinI b => SBin b
sbin :: SBin b of
    SBin b
SBZ -> RAVec b (Pos b)
forall a. RAVec Bin0 a
Empty
    SBin b
SBP -> NERAVec b1 (Pos ('BP b1)) -> RAVec ('BP b1) (Pos ('BP b1))
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty ((PosP b1 -> Pos ('BP b1))
-> NERAVec b1 (PosP b1) -> NERAVec b1 (Pos ('BP b1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PosP b1 -> Pos ('BP b1)
forall (b1 :: BinP). PosP b1 -> Pos ('BP b1)
Pos NERAVec b1 (PosP b1)
forall (b :: BinP). SBinPI b => NERAVec b (PosP b)
NE.universe)

-------------------------------------------------------------------------------
-- QuickCheck
-------------------------------------------------------------------------------

liftArbitrary :: B.SBinI b => QC.Gen a -> QC.Gen (RAVec b a)
liftArbitrary :: Gen a -> Gen (RAVec b a)
liftArbitrary = Gen a -> Gen (RAVec b a)
forall (b :: Bin) a. SBinI b => Gen a -> Gen (RAVec b a)
liftArbitrary

liftShrink :: (a -> [a]) -> RAVec b a -> [RAVec b a]
liftShrink :: (a -> [a]) -> RAVec b a -> [RAVec b a]
liftShrink a -> [a]
_   RAVec b a
Empty        = []
liftShrink a -> [a]
shr (NonEmpty NERAVec b a
r) = NERAVec b a -> RAVec ('BP b) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty (NERAVec b a -> RAVec ('BP b) a)
-> [NERAVec b a] -> [RAVec ('BP b) a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> [a]) -> NERAVec b a -> [NERAVec b a]
forall a (b :: BinP). (a -> [a]) -> NERAVec b a -> [NERAVec b a]
NE.liftShrink a -> [a]
shr NERAVec b a
r

instance B.SBinI b => QC.Arbitrary1 (RAVec b) where
    liftArbitrary :: Gen a -> Gen (RAVec b a)
liftArbitrary = Gen a -> Gen (RAVec b a)
forall (b :: Bin) a. SBinI b => Gen a -> Gen (RAVec b a)
liftArbitrary
    liftShrink :: (a -> [a]) -> RAVec b a -> [RAVec b a]
liftShrink    = (a -> [a]) -> RAVec b a -> [RAVec b a]
forall a (b :: Bin). (a -> [a]) -> RAVec b a -> [RAVec b a]
liftShrink

instance (B.SBinI b, QC.Arbitrary a) => QC.Arbitrary (RAVec b a) where
    arbitrary :: Gen (RAVec b a)
arbitrary = Gen (RAVec b a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
QC.arbitrary1
    shrink :: RAVec b a -> [RAVec b a]
shrink    = RAVec b a -> [RAVec b a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
QC.shrink1

instance QC.CoArbitrary a => QC.CoArbitrary (RAVec b a) where
    coarbitrary :: RAVec b a -> Gen b -> Gen b
coarbitrary RAVec b a
Empty        = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
0 :: Int)
    coarbitrary (NonEmpty NERAVec b a
r) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NERAVec b a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary NERAVec b a
r

instance (B.SBinI b, QC.Function a) => QC.Function (RAVec b a) where
    function :: (RAVec b a -> b) -> RAVec b a :-> b
function = case SBin b
forall (b :: Bin). SBinI b => SBin b
B.sbin :: B.SBin b of
        SBin b
SBZ -> (RAVec Bin0 a -> ())
-> (() -> RAVec Bin0 a)
-> (RAVec Bin0 a -> b)
-> RAVec Bin0 a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\RAVec Bin0 a
Empty -> ())       (\() -> RAVec Bin0 a
forall a. RAVec Bin0 a
Empty)
        SBin b
SBP -> (RAVec ('BP b1) a -> NERAVec b1 a)
-> (NERAVec b1 a -> RAVec ('BP b1) a)
-> (RAVec ('BP b1) a -> b)
-> RAVec ('BP b1) a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\(NonEmpty NERAVec b a
r) -> NERAVec b1 a
NERAVec b a
r) NERAVec b1 a -> RAVec ('BP b1) a
forall (b :: BinP) a. NERAVec b a -> RAVec ('BP b) a
NonEmpty