{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.RAList.Internal (
    RAList (..),
    -- * Showing
    explicitShow,
    explicitShowsPrec,
    -- * Construction
    empty,
    singleton,
    cons,
    -- * Indexing
    (!),
    (!?),
    length,
    null,
    -- * Conversions
    toList,
    fromList,
    -- * Folding
    ifoldMap,
    -- * Mapping
    adjust,
    map,
    imap,
    itraverse,
    ) where

import Prelude
       (Bool (..), Eq, Functor (..), Int, Maybe (..), Ord (..), Show (..),
       ShowS, String, showParen, showString, ($), (.))

import Control.Applicative (Applicative (..), (<$>))
import Control.DeepSeq     (NFData (..))
import Control.Exception   (ArrayException (IndexOutOfBounds), throw)
import Data.Hashable       (Hashable (..))
import Data.List.NonEmpty  (NonEmpty (..))
import Data.Monoid         (Monoid (..))
import Data.Semigroup      (Semigroup (..))

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

import qualified Data.RAList.NonEmpty.Internal as NE

-- $setup
-- >>> import Data.Char (toUpper)

-------------------------------------------------------------------------------
-- Type
-------------------------------------------------------------------------------

-- | Random access list.
data RAList a
    = Empty
    | NonEmpty (NE.NERAList a)
  deriving (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, 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, 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
I.Traversable)

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

-- |
--
-- >>> I.length $ fromList $ ['a' .. 'z']
-- 26
--
instance I.Foldable RAList where
    foldMap :: (a -> m) -> RAList a -> m
foldMap a -> m
_ RAList a
Empty = m
forall a. Monoid a => a
mempty
    foldMap a -> m
f (NonEmpty NERAList a
xs) = (a -> m) -> NERAList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
I.foldMap a -> m
f NERAList a
xs

#if MIN_VERSION_base(4,8,0)
    length :: RAList a -> Int
length = RAList a -> Int
forall a. RAList a -> Int
length
    null :: RAList a -> Bool
null   = RAList a -> Bool
forall a. RAList a -> Bool
null
#endif

instance NFData a => NFData (RAList a) where
    rnf :: RAList a -> ()
rnf RAList a
Empty         = ()
    rnf (NonEmpty NERAList a
xs) = NERAList a -> ()
forall a. NFData a => a -> ()
rnf NERAList a
xs

instance Hashable a => Hashable (RAList a) where
    hashWithSalt :: Int -> RAList a -> Int
hashWithSalt Int
salt RAList a
Empty        = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int
0 :: Int)
    hashWithSalt Int
salt (NonEmpty NERAList a
r) = Int -> NERAList a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt NERAList a
r


-- |
--
-- >>> fromList "abc" <> fromList "xyz"
-- fromList "abcxyz"
--
instance Semigroup (RAList a) where
    RAList a
Empty       <> :: RAList a -> RAList a -> RAList a
<> RAList a
ys          = RAList a
ys
    RAList a
xs          <> RAList a
Empty       = RAList a
xs
    NonEmpty NERAList a
xs <> NonEmpty NERAList a
ys = NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (NERAList a
xs NERAList a -> NERAList a -> NERAList a
forall a. Semigroup a => a -> a -> a
<> NERAList a
ys)

instance Monoid (RAList a) where
    mempty :: RAList a
mempty  = RAList a
forall a. RAList a
Empty
    mappend :: RAList a -> RAList a -> RAList a
mappend = RAList a -> RAList a -> RAList a
forall a. Semigroup a => a -> a -> a
(<>)

-- TODO: Applicative, Monad

#ifdef MIN_VERSION_semigroupoids
-- Apply, Bind
#endif

-------------------------------------------------------------------------------
-- Showing
-------------------------------------------------------------------------------

instance Show a => Show (RAList a) where
    showsPrec :: Int -> RAList a -> ShowS
showsPrec Int
d RAList a
xs = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (RAList a -> [a]
forall a. RAList a -> [a]
toList RAList a
xs)

explicitShow :: Show a => RAList a -> String
explicitShow :: RAList a -> String
explicitShow RAList a
xs = Int -> RAList a -> ShowS
forall a. Show a => Int -> RAList a -> ShowS
explicitShowsPrec Int
0 RAList a
xs String
""

explicitShowsPrec :: Show a => Int -> RAList a -> ShowS
explicitShowsPrec :: Int -> RAList a -> ShowS
explicitShowsPrec Int
_ RAList a
Empty         = String -> ShowS
showString String
"Empty"
explicitShowsPrec Int
d (NonEmpty NERAList a
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NonEmpty " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NERAList a -> ShowS
forall a. Show a => Int -> NERAList a -> ShowS
NE.explicitShowsPrec Int
11 NERAList a
xs

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

-- | Empty 'RAList'.
--
-- >>> empty :: RAList Int
-- fromList []
--
empty :: RAList a
empty :: RAList a
empty = RAList a
forall a. RAList a
Empty

-- | Single element 'RAList'.
singleton :: a -> RAList a
singleton :: a -> RAList a
singleton = NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (NERAList a -> RAList a) -> (a -> NERAList a) -> a -> RAList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NERAList a
forall a. a -> NERAList a
NE.singleton

-- | 'cons' for non-empty rals.
cons :: a -> RAList a -> RAList a
cons :: a -> RAList a -> RAList a
cons a
x RAList a
Empty         = a -> RAList a
forall a. a -> RAList a
singleton a
x
cons a
x (NonEmpty NERAList a
xs) = NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (a -> NERAList a -> NERAList a
forall a. a -> NERAList a -> NERAList a
NE.cons a
x NERAList a
xs)

toList :: RAList a -> [a]
toList :: RAList a -> [a]
toList RAList a
Empty         = []
toList (NonEmpty NERAList a
xs) = (a -> [a] -> [a]) -> [a] -> NERAList a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
I.foldr (:) [] NERAList a
xs

-- |
--
-- >>> fromList ['a' .. 'f']
-- fromList "abcdef"
--
-- >>> explicitShow $ fromList ['a' .. 'f']
-- "NonEmpty (NE (Cons0 (Cons1 (Nd (Lf 'a') (Lf 'b')) (Last (Nd (Nd (Lf 'c') (Lf 'd')) (Nd (Lf 'e') (Lf 'f')))))))"
--
fromList :: [a] -> RAList a
fromList :: [a] -> RAList a
fromList []     = RAList a
forall a. RAList a
Empty
fromList (a
x:[a]
xs) = NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (NonEmpty a -> NERAList a
forall a. NonEmpty a -> NERAList a
NE.fromNonEmpty (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs))

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

-- | List index.
--
--- >>> fromList ['a'..'f'] ! 0
-- 'a'
--
-- >>> fromList ['a'..'f'] ! 5
-- 'f'
--
-- >>> fromList ['a'..'f'] ! 6
-- *** Exception: array index out of range: RAList
-- ...
--
(!) :: RAList a -> Int -> a
(!) RAList a
Empty         Int
_ = ArrayException -> a
forall a e. Exception e => e -> a
throw (ArrayException -> a) -> ArrayException -> a
forall a b. (a -> b) -> a -> b
$ String -> ArrayException
IndexOutOfBounds String
"RAList"
(!) (NonEmpty NERAList a
xs) Int
i = NERAList a
xs NERAList a -> Int -> a
forall a. NERAList a -> Int -> a
NE.! Int
i

-- | safe list index.
--
-- >>> fromList ['a'..'f'] !? 0
-- Just 'a'
--
-- >>> fromList ['a'..'f'] !? 5
-- Just 'f'
--
-- >>> fromList ['a'..'f'] !? 6
-- Nothing
--
(!?) :: RAList a -> Int -> Maybe a
RAList a
Empty       !? :: RAList a -> Int -> Maybe a
!? Int
_ = Maybe a
forall a. Maybe a
Nothing
NonEmpty NERAList a
xs !? Int
i = NERAList a
xs NERAList a -> Int -> Maybe a
forall a. NERAList a -> Int -> Maybe a
NE.!? Int
i

length :: RAList a -> Int
length :: RAList a -> Int
length RAList a
Empty         = Int
0
length (NonEmpty NERAList a
xs) = NERAList a -> Int
forall a. NERAList a -> Int
NE.length NERAList a
xs

null :: RAList a -> Bool
null :: RAList a -> Bool
null RAList a
Empty        = Bool
True
null (NonEmpty NERAList a
_) = Bool
False

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

ifoldMap :: Monoid m => (Int -> a -> m) -> RAList a -> m
ifoldMap :: (Int -> a -> m) -> RAList a -> m
ifoldMap Int -> a -> m
_ RAList a
Empty        = m
forall a. Monoid a => a
mempty
ifoldMap Int -> a -> m
f (NonEmpty NERAList a
r) = (Int -> a -> m) -> NERAList a -> m
forall m a. Monoid m => (Int -> a -> m) -> NERAList a -> m
NE.ifoldMap Int -> a -> m
f NERAList a
r

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

-- |
-- >>> map toUpper (fromList ['a'..'f'])
-- fromList "ABCDEF"
--
map :: (a -> b) -> RAList a -> RAList b
map :: (a -> b) -> RAList a -> RAList b
map = (a -> b) -> RAList a -> RAList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- |
--
-- >>> imap (,) $ fromList ['a' .. 'f']
-- fromList [(0,'a'),(1,'b'),(2,'c'),(3,'d'),(4,'e'),(5,'f')]
imap :: (Int -> a -> b) -> RAList a -> RAList b
imap :: (Int -> a -> b) -> RAList a -> RAList b
imap Int -> a -> b
f RAList a
xs = I (RAList b) -> RAList b
forall a. I a -> a
unI ((Int -> a -> I b) -> RAList a -> I (RAList b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> RAList a -> f (RAList b)
itraverse (\Int
i a
x -> b -> I b
forall a. a -> I a
I (Int -> a -> b
f Int
i a
x)) RAList a
xs)

itraverse :: forall f a b. Applicative f => (Int -> a -> f b) -> RAList a -> f (RAList b)
itraverse :: (Int -> a -> f b) -> RAList a -> f (RAList b)
itraverse Int -> a -> f b
_ RAList a
Empty         = RAList b -> f (RAList b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RAList b
forall a. RAList a
Empty
itraverse Int -> a -> f b
f (NonEmpty NERAList a
xs) = NERAList b -> RAList b
forall a. NERAList a -> RAList a
NonEmpty (NERAList b -> RAList b) -> f (NERAList b) -> f (RAList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> NERAList a -> f (NERAList b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> NERAList a -> f (NERAList b)
NE.itraverse Int -> a -> f b
f NERAList a
xs

-- | Adjust a value in the list.
--
-- >>> adjust 3 toUpper $ fromList "bcdef"
-- fromList "bcdEf"
--
-- If index is out of bounds, the list is returned unmodified.
--
-- >>> adjust 10 toUpper $ fromList "bcdef"
-- fromList "bcdef"
--
-- >>> adjust (-1) toUpper $ fromList "bcdef"
-- fromList "bcdef"
--
adjust :: forall a. Int -> (a -> a) -> RAList a -> RAList a
adjust :: Int -> (a -> a) -> RAList a -> RAList a
adjust Int
_ a -> a
_ RAList a
Empty         = RAList a
forall a. RAList a
Empty
adjust Int
i a -> a
f (NonEmpty NERAList a
xs) = NERAList a -> RAList a
forall a. NERAList a -> RAList a
NonEmpty (Int -> (a -> a) -> NERAList a -> NERAList a
forall a. Int -> (a -> a) -> NERAList a -> NERAList a
NE.adjust Int
i a -> a
f NERAList a
xs)

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

instance QC.Arbitrary1 RAList where
    liftArbitrary :: Gen a -> Gen (RAList a)
liftArbitrary = ([a] -> RAList a) -> Gen [a] -> Gen (RAList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> RAList a
forall a. [a] -> RAList a
fromList (Gen [a] -> Gen (RAList a))
-> (Gen a -> Gen [a]) -> Gen a -> Gen (RAList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen a -> Gen [a]
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary
    liftShrink :: (a -> [a]) -> RAList a -> [RAList a]
liftShrink a -> [a]
shr = ([a] -> RAList a) -> [[a]] -> [RAList a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> RAList a
forall a. [a] -> RAList a
fromList ([[a]] -> [RAList a])
-> (RAList a -> [[a]]) -> RAList a -> [RAList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink a -> [a]
shr ([a] -> [[a]]) -> (RAList a -> [a]) -> RAList a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAList a -> [a]
forall a. RAList a -> [a]
toList

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

instance QC.CoArbitrary a => QC.CoArbitrary (RAList a) where
    coarbitrary :: RAList a -> Gen b -> Gen b
coarbitrary = [a] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary ([a] -> Gen b -> Gen b)
-> (RAList a -> [a]) -> RAList a -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAList a -> [a]
forall a. RAList a -> [a]
toList

instance QC.Function a => QC.Function (RAList a) where
    function :: (RAList a -> b) -> RAList a :-> b
function = (RAList a -> [a])
-> ([a] -> RAList a) -> (RAList a -> b) -> RAList a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap RAList a -> [a]
forall a. RAList a -> [a]
toList [a] -> RAList a
forall a. [a] -> RAList a
fromList

-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------

newtype I a = I a
unI :: I a -> a
unI :: I a -> a
unI (I a
a) = a
a

instance Functor I where
    fmap :: (a -> b) -> I a -> I b
fmap a -> b
f (I a
x) = b -> I b
forall a. a -> I a
I (a -> b
f a
x)

instance Applicative I where
    pure :: a -> I a
pure        = a -> I a
forall a. a -> I a
I
    I a -> b
f <*> :: I (a -> b) -> I a -> I b
<*> I a
x = b -> I b
forall a. a -> I a
I (a -> b
f a
x)
    I a
_ *> :: I a -> I b -> I b
*> I b
x      = I b
x
    I a
x <* :: I a -> I b -> I a
<* I b
_      = I a
x
#if MIN_VERSION_base(4,10,0)
    liftA2 :: (a -> b -> c) -> I a -> I b -> I c
liftA2 a -> b -> c
f (I a
x) (I b
y) = c -> I c
forall a. a -> I a
I (a -> b -> c
f a
x b
y)
#endif