{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Copyright:  (c) 2021 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer:  Kowainik <xrom.xkov@gmail.com>
Stability:   Stable
Portability: Portable

The main 'Slist' data types and instances. Provides smart constructors and a few
basic functions.
-}
module Slist.Type
    ( Slist (..)
      -- ** Smart constructors
    , slist
    , infiniteSlist
    , one
      -- * Basic functions
    , len
    , size
    , isEmpty
    , cons
    , map
    ) where

import Control.Applicative (Alternative (empty, (<|>)), liftA2)
#if ( __GLASGOW_HASKELL__ == 802 )
import Data.Semigroup (Semigroup (..))
#endif
import Prelude hiding (map)

import Slist.Size (Size (..))

import qualified Data.Foldable as F (Foldable (..))
import qualified GHC.Exts as L (IsList (..))
import qualified Prelude as P


{- | Data type that represents sized list.
Size can be both finite or infinite, it is established using
'Size' data type.
-}
data Slist a = Slist
    { Slist a -> [a]
sList :: [a]
    , Slist a -> Size
sSize :: Size
    } deriving stock (Int -> Slist a -> ShowS
[Slist a] -> ShowS
Slist a -> String
(Int -> Slist a -> ShowS)
-> (Slist a -> String) -> ([Slist a] -> ShowS) -> Show (Slist a)
forall a. Show a => Int -> Slist a -> ShowS
forall a. Show a => [Slist a] -> ShowS
forall a. Show a => Slist a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slist a] -> ShowS
$cshowList :: forall a. Show a => [Slist a] -> ShowS
show :: Slist a -> String
$cshow :: forall a. Show a => Slist a -> String
showsPrec :: Int -> Slist a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Slist a -> ShowS
Show, ReadPrec [Slist a]
ReadPrec (Slist a)
Int -> ReadS (Slist a)
ReadS [Slist a]
(Int -> ReadS (Slist a))
-> ReadS [Slist a]
-> ReadPrec (Slist a)
-> ReadPrec [Slist a]
-> Read (Slist a)
forall a. Read a => ReadPrec [Slist a]
forall a. Read a => ReadPrec (Slist a)
forall a. Read a => Int -> ReadS (Slist a)
forall a. Read a => ReadS [Slist a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Slist a]
$creadListPrec :: forall a. Read a => ReadPrec [Slist a]
readPrec :: ReadPrec (Slist a)
$creadPrec :: forall a. Read a => ReadPrec (Slist a)
readList :: ReadS [Slist a]
$creadList :: forall a. Read a => ReadS [Slist a]
readsPrec :: Int -> ReadS (Slist a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Slist a)
Read)

{- | Equality of sized lists is checked more efficiently
due to the fact that the check on the list sizes can be
done first for the constant time.
-}
instance (Eq a) => Eq (Slist a) where
    (Slist [a]
l1 Size
s1) == :: Slist a -> Slist a -> Bool
== (Slist [a]
l2 Size
s2) = Size
s1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
s2 Bool -> Bool -> Bool
&& [a]
l1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
l2
    {-# INLINE (==) #-}

-- | Lexicographical comparison of the lists.
instance (Ord a) => Ord (Slist a) where
    compare :: Slist a -> Slist a -> Ordering
compare (Slist [a]
l1 Size
_) (Slist [a]
l2 Size
_) = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
l1 [a]
l2
    {-# INLINE compare #-}

{- | List appending. Use '<>' for 'Slist' concatenation instead of
'L.++' operator that is common in ordinary list concatenations.
-}
instance Semigroup (Slist a) where
    (<>) :: Slist a -> Slist a -> Slist a
    (Slist [a]
l1 Size
s1) <> :: Slist a -> Slist a -> Slist a
<> (Slist [a]
l2 Size
s2) = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist ([a]
l1 [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
l2) (Size
s1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
s2)
    {-# INLINE (<>) #-}

instance Monoid (Slist a) where
    mempty :: Slist a
    mempty :: Slist a
mempty = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [] Size
0
    {-# INLINE mempty #-}

    mappend :: Slist a -> Slist a -> Slist a
    mappend :: Slist a -> Slist a -> Slist a
mappend = Slist a -> Slist a -> Slist a
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

    mconcat :: [Slist a] -> Slist a
    mconcat :: [Slist a] -> Slist a
mconcat [Slist a]
ls = let ([a]
l, Size
s) = (Slist a -> ([a], Size) -> ([a], Size))
-> ([a], Size) -> [Slist a] -> ([a], Size)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Slist a -> ([a], Size) -> ([a], Size)
f ([], Size
0) [Slist a]
ls in [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [a]
l Size
s
      where
        -- foldr :: (a -> ([a], Size) -> ([a], Size)) -> ([a], Size) -> [Slist a] -> ([a], Size)
        f :: Slist a -> ([a], Size) -> ([a], Size)
        f :: Slist a -> ([a], Size) -> ([a], Size)
f (Slist [a]
l Size
s) ([a]
xL, !Size
xS) = ([a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xL, Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
xS)
    {-# INLINE mconcat #-}

instance Functor Slist where
    fmap :: (a -> b) -> Slist a -> Slist b
    fmap :: (a -> b) -> Slist a -> Slist b
fmap = (a -> b) -> Slist a -> Slist b
forall a b. (a -> b) -> Slist a -> Slist b
map
    {-# INLINE fmap #-}

instance Applicative Slist where
    pure :: a -> Slist a
    pure :: a -> Slist a
pure = a -> Slist a
forall a. a -> Slist a
one
    {-# INLINE pure #-}

    (<*>) :: Slist (a -> b) -> Slist a -> Slist b
    Slist (a -> b)
fsl <*> :: Slist (a -> b) -> Slist a -> Slist b
<*> Slist a
sl = Slist :: forall a. [a] -> Size -> Slist a
Slist
        { sList :: [b]
sList = Slist (a -> b) -> [a -> b]
forall a. Slist a -> [a]
sList Slist (a -> b)
fsl [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Slist a -> [a]
forall a. Slist a -> [a]
sList Slist a
sl
        , sSize :: Size
sSize = Slist (a -> b) -> Size
forall a. Slist a -> Size
sSize Slist (a -> b)
fsl  Size -> Size -> Size
forall a. Num a => a -> a -> a
*  Slist a -> Size
forall a. Slist a -> Size
sSize Slist a
sl
        }
    {-# INLINE (<*>) #-}

    liftA2 :: (a -> b -> c) -> Slist a -> Slist b -> Slist c
    liftA2 :: (a -> b -> c) -> Slist a -> Slist b -> Slist c
liftA2 a -> b -> c
f Slist a
sla Slist b
slb = Slist :: forall a. [a] -> Size -> Slist a
Slist
        { sList :: [c]
sList = (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Slist a -> [a]
forall a. Slist a -> [a]
sList Slist a
sla) (Slist b -> [b]
forall a. Slist a -> [a]
sList Slist b
slb)
        , sSize :: Size
sSize = Slist a -> Size
forall a. Slist a -> Size
sSize Slist a
sla Size -> Size -> Size
forall a. Num a => a -> a -> a
* Slist b -> Size
forall a. Slist a -> Size
sSize Slist b
slb
        }
    {-# INLINE liftA2 #-}

instance Alternative Slist where
    empty :: Slist a
    empty :: Slist a
empty = Slist a
forall a. Monoid a => a
mempty
    {-# INLINE empty #-}

    (<|>) :: Slist a -> Slist a -> Slist a
    <|> :: Slist a -> Slist a -> Slist a
(<|>) = Slist a -> Slist a -> Slist a
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<|>) #-}

instance Monad Slist where
    return :: a -> Slist a
    return :: a -> Slist a
return = a -> Slist a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

    (>>=) :: Slist a -> (a -> Slist b) -> Slist b
    Slist a
sl >>= :: Slist a -> (a -> Slist b) -> Slist b
>>= a -> Slist b
f = [Slist b] -> Slist b
forall a. Monoid a => [a] -> a
mconcat ([Slist b] -> Slist b) -> [Slist b] -> Slist b
forall a b. (a -> b) -> a -> b
$ (a -> Slist b) -> [a] -> [Slist b]
forall a b. (a -> b) -> [a] -> [b]
P.map a -> Slist b
f ([a] -> [Slist b]) -> [a] -> [Slist b]
forall a b. (a -> b) -> a -> b
$ Slist a -> [a]
forall a. Slist a -> [a]
sList Slist a
sl
    {-# INLINE (>>=) #-}

{- | Efficient implementation of 'sum' and 'product' functions.
'length' returns 'Int's 'maxBound' on infinite lists.
-}
instance Foldable Slist where
    foldMap :: (Monoid m) => (a -> m) -> Slist a -> m
    foldMap :: (a -> m) -> Slist a -> m
foldMap a -> m
f = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> (Slist a -> [a]) -> Slist a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE foldMap #-}

    foldr :: (a -> b -> b) -> b -> Slist a -> b
    foldr :: (a -> b -> b) -> b -> Slist a -> b
foldr a -> b -> b
f b
b = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
b ([a] -> b) -> (Slist a -> [a]) -> Slist a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE foldr #-}

    -- | Is the element in the structure?
    elem :: (Eq a) => a -> Slist a -> Bool
    elem :: a -> Slist a -> Bool
elem a
a = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
a ([a] -> Bool) -> (Slist a -> [a]) -> Slist a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE elem #-}

    maximum :: (Ord a) => Slist a -> a
    maximum :: Slist a -> a
maximum = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> (Slist a -> [a]) -> Slist a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE maximum #-}

    minimum :: (Ord a) => Slist a -> a
    minimum :: Slist a -> a
minimum = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([a] -> a) -> (Slist a -> [a]) -> Slist a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE minimum #-}

    sum :: (Num a) => Slist a -> a
    sum :: Slist a -> a
sum = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 ([a] -> a) -> (Slist a -> [a]) -> Slist a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE sum #-}

    product :: (Num a) => Slist a -> a
    product :: Slist a -> a
product = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 ([a] -> a) -> (Slist a -> [a]) -> Slist a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE product #-}

    null :: Slist a -> Bool
    null :: Slist a -> Bool
null = Slist a -> Bool
forall a. Slist a -> Bool
isEmpty
    {-# INLINE null #-}

    length :: Slist a -> Int
    length :: Slist a -> Int
length = Slist a -> Int
forall a. Slist a -> Int
len
    {-# INLINE length #-}

    toList :: Slist a -> [a]
    toList :: Slist a -> [a]
toList = Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE toList #-}

instance Traversable Slist where
    traverse :: (Applicative f) => (a -> f b) -> Slist a -> f (Slist b)
    traverse :: (a -> f b) -> Slist a -> f (Slist b)
traverse a -> f b
f (Slist [a]
l Size
s) = ([b] -> Size -> Slist b
forall a. [a] -> Size -> Slist a
`Slist` Size
s) ([b] -> Slist b) -> f [b] -> f (Slist b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
l
    {-# INLINE traverse #-}

instance L.IsList (Slist a) where
    type (Item (Slist a)) = a
    fromList :: [a] -> Slist a
    fromList :: [a] -> Slist a
fromList = [a] -> Slist a
forall a. [a] -> Slist a
slist
    {-# INLINE fromList #-}

    toList :: Slist a -> [a]
    toList :: Slist a -> [a]
toList = Slist a -> [a]
forall a. Slist a -> [a]
sList
    {-# INLINE toList #-}

    fromListN :: Int -> [a] -> Slist a
    fromListN :: Int -> [a] -> Slist a
fromListN Int
n [a]
l = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [a]
l (Size -> Slist a) -> Size -> Slist a
forall a b. (a -> b) -> a -> b
$ Int -> Size
Size Int
n
    {-# INLINE fromListN #-}

{- | @O(n)@. Constructs 'Slist' from the given list.

>>> slist [1..5]
Slist {sList = [1,2,3,4,5], sSize = Size 5}

/Note:/ works with finite lists. Use 'infiniteSlist'
to construct infinite lists.
-}
slist :: [a] -> Slist a
slist :: [a] -> Slist a
slist [a]
l = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [a]
l (Int -> Size
Size (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)
{-# INLINE slist #-}

{- | @O(1)@. Constructs 'Slist' from the given list.

@
>> infiniteSlist [1..]
Slist {sList = [1..], sSize = Infinity}
@

/Note:/ works with infinite lists. Use 'slist'
to construct finite lists.
-}
infiniteSlist :: [a] -> Slist a
infiniteSlist :: [a] -> Slist a
infiniteSlist [a]
l = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [a]
l Size
Infinity
{-# INLINE infiniteSlist #-}

{- | @O(1)@. Creates 'Slist' with a single element.
The size of such 'Slist' is always equals to @Size 1@.

>>> one "and only"
Slist {sList = ["and only"], sSize = Size 1}

-}
one :: a -> Slist a
one :: a -> Slist a
one a
a = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist [a
a] Size
1
{-# INLINE one #-}

----------------------------------------------------------------------------
-- Basic functions
----------------------------------------------------------------------------


{- | @O(1)@. Returns the length of a structure as an 'Int'.
On infinite lists returns the 'Int's 'maxBound'.

>>> len $ one 42
1
>>> len $ slist [1..3]
3
>>> len $ infiniteSlist [1..]
9223372036854775807
-}
len :: Slist a -> Int
len :: Slist a -> Int
len Slist{[a]
Size
sSize :: Size
sList :: [a]
sSize :: forall a. Slist a -> Size
sList :: forall a. Slist a -> [a]
..} = case Size
sSize of
    Size
Infinity -> Int
forall a. Bounded a => a
maxBound
    Size Int
n   -> Int
n
{-# INLINE len #-}

{- | @O(1)@. Returns the 'Size' of the slist.

>>> size $ slist "Hello World!"
Size 12
>>> size $ infiniteSlist [1..]
Infinity
-}
size :: Slist a -> Size
size :: Slist a -> Size
size = Slist a -> Size
forall a. Slist a -> Size
sSize
{-# INLINE size #-}

{- | @O(1)@. Checks if 'Slist' is empty

>>> isEmpty mempty
True
>>> isEmpty $ slist []
True
>>> isEmpty $ slist "Not Empty"
False
-}
isEmpty :: Slist a -> Bool
isEmpty :: Slist a -> Bool
isEmpty = (Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0) (Size -> Bool) -> (Slist a -> Size) -> Slist a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slist a -> Size
forall a. Slist a -> Size
size
{-# INLINE isEmpty #-}

{- | @O(1)@. 'cons' is 'Slist' analogue to ':' for lists.
It adds the given element to the beginning of the list.

The following property is preserved:

@
  'size' ('cons' x xs) == 'size' xs + 1
@

Examples:

>>> cons 'a' $ one 'b'
Slist {sList = "ab", sSize = Size 2}

@
>> __'cons' 0 $ 'infiniteSlist' [1..]__
Slist {sList = [0..], sSize = 'Infinity'}
@
-}
cons :: a -> Slist a -> Slist a
cons :: a -> Slist a -> Slist a
cons a
x (Slist [a]
xs Size
s) = [a] -> Size -> Slist a
forall a. [a] -> Size -> Slist a
Slist (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) (Size -> Slist a) -> Size -> Slist a
forall a b. (a -> b) -> a -> b
$ Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1
{-# INLINE cons #-}


{- | @O(n)@. Applies the given function to each element of the slist.

> map f (slist [x1, x2, ..., xn])     == slist [f x1, f x2, ..., f xn]
> map f (infiniteSlist [x1, x2, ...]) == infiniteSlist [f x1, f x2, ...]

-}
map :: (a -> b) -> Slist a -> Slist b
map :: (a -> b) -> Slist a -> Slist b
map a -> b
f Slist{[a]
Size
sSize :: Size
sList :: [a]
sSize :: forall a. Slist a -> Size
sList :: forall a. Slist a -> [a]
..} = [b] -> Size -> Slist b
forall a. [a] -> Size -> Slist a
Slist ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
P.map a -> b
f [a]
sList) Size
sSize
{-# INLINE map #-}