{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      :  Pinch.Internal.FoldList
-- Copyright   :  (c) Abhinav Gupta 2015
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- Implements a representation of a list as a fold over it.
module Pinch.Internal.FoldList
    ( FoldList
    , map
    , replicate
    , replicateM
    , F.foldl'
    , F.foldr
    , F.toList
    , fromFoldable
    , fromMap
    , T.mapM
    , T.sequence
    ) where

import Prelude hiding (foldr, map, mapM, replicate, sequence)

import Control.DeepSeq (NFData (..))
import Data.Hashable   (Hashable (..))
import Data.List       (intercalate)
import Data.Typeable   (Typeable)

import qualified Control.Monad    as M
import qualified Data.Foldable    as F
import qualified Data.List        as L
import qualified Data.Traversable as T

-- | FoldList represents a list as a @foldl'@ traversal over it.
--
-- This allows us to avoid allocating new collections for an intermediate
-- representation of various data types that users provide.
newtype FoldList a = FoldList (forall r. (r -> a -> r) -> r -> r)
  deriving Typeable

-- | Builds a FoldList over pairs of items of a map.
fromMap
    :: (forall r. (r -> k -> v -> r) -> r -> m k v -> r)
    -- ^ @foldlWithKey@ provided by the map implementation.
    -> m k v
    -> FoldList (k, v)
fromMap :: (forall r. (r -> k -> v -> r) -> r -> m k v -> r)
-> m k v -> FoldList (k, v)
fromMap forall r. (r -> k -> v -> r) -> r -> m k v -> r
foldlWithKey m k v
m = (forall r. (r -> (k, v) -> r) -> r -> r) -> FoldList (k, v)
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList (\r -> (k, v) -> r
k r
r -> (r -> k -> v -> r) -> r -> m k v -> r
forall r. (r -> k -> v -> r) -> r -> m k v -> r
foldlWithKey ((r -> (k, v) -> r) -> r -> k -> v -> r
forall t a b t. (t -> (a, b) -> t) -> t -> a -> b -> t
go r -> (k, v) -> r
k) r
r m k v
m)
  where
    go :: (t -> (a, b) -> t) -> t -> a -> b -> t
go t -> (a, b) -> t
k t
r a
a b
b = t -> (a, b) -> t
k t
r (a
a, b
b)
    {-# INLINE go #-}
{-# INLINE fromMap #-}

-- | Builds a FoldList from a Foldable.
fromFoldable :: F.Foldable f => f a -> FoldList a
fromFoldable :: f a -> FoldList a
fromFoldable f a
l = (forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList (\r -> a -> r
k r
r -> (r -> a -> r) -> r -> f a -> r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' r -> a -> r
k r
r f a
l)
{-# INLINE fromFoldable #-}

-- | Applies the given function to all elements in the FoldList.
--
-- Note that the function is applied lazily when the results are requested. If
-- the results of the same FoldList are requested multiple times, the function
-- will be called multiple times on the same elements.
map :: (a -> b) -> FoldList a -> FoldList b
map :: (a -> b) -> FoldList a -> FoldList b
map a -> b
f (FoldList forall r. (r -> a -> r) -> r -> r
l) = (forall r. (r -> b -> r) -> r -> r) -> FoldList b
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList ((forall r. (r -> b -> r) -> r -> r) -> FoldList b)
-> (forall r. (r -> b -> r) -> r -> r) -> FoldList b
forall a b. (a -> b) -> a -> b
$ \r -> b -> r
k r
r0 -> (r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
l (\r
r1 a
a -> r -> b -> r
k r
r1 (a -> b
f a
a)) r
r0
{-# INLINE map #-}

-- | Returns a FoldList with the given item repeated @n@ times.
replicate :: Int -> a -> FoldList a
replicate :: Int -> a -> FoldList a
replicate Int
n a
a = [a] -> FoldList a
forall (f :: * -> *) a. Foldable f => f a -> FoldList a
fromFoldable (Int -> a -> [a]
forall a. Int -> a -> [a]
L.replicate Int
n a
a)
{-# INLINE replicate #-}

-- | Executes the given monadic action the given number of times and returns
-- a FoldList of the results.
replicateM :: Monad m => Int -> m a -> m (FoldList a)
replicateM :: Int -> m a -> m (FoldList a)
replicateM Int
n = ([a] -> FoldList a) -> m [a] -> m (FoldList a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM [a] -> FoldList a
forall (f :: * -> *) a. Foldable f => f a -> FoldList a
fromFoldable (m [a] -> m (FoldList a))
-> (m a -> m [a]) -> m a -> m (FoldList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
M.replicateM Int
n
{-# INLINE replicateM #-}

instance Show a => Show (FoldList a) where
    show :: FoldList a -> String
show FoldList a
l = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> [String] -> [String]) -> [String] -> FoldList a -> [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> [String] -> [String]
forall a. Show a => a -> [String] -> [String]
go [] FoldList a
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
      where
        go :: a -> [String] -> [String]
go a
a [String]
xs = a -> String
forall a. Show a => a -> String
show a
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs

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

instance F.Foldable FoldList where
    foldMap :: (a -> m) -> FoldList a -> m
foldMap a -> m
f (FoldList forall r. (r -> a -> r) -> r -> r
l) = (m -> a -> m) -> m -> m
forall r. (r -> a -> r) -> r -> r
l (\m
r a
a -> m
r m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
a) m
forall a. Monoid a => a
mempty
    {-# INLINE foldMap #-}

    foldl' :: (b -> a -> b) -> b -> FoldList a -> b
foldl' b -> a -> b
f b
r (FoldList forall r. (r -> a -> r) -> r -> r
l) = (b -> a -> b) -> b -> b
forall r. (r -> a -> r) -> r -> r
l b -> a -> b
f b
r
    {-# INLINE foldl' #-}

instance T.Traversable FoldList where
    sequenceA :: FoldList (f a) -> f (FoldList a)
sequenceA (FoldList forall r. (r -> f a -> r) -> r -> r
f) =
        (f (FoldList a) -> f a -> f (FoldList a))
-> f (FoldList a) -> f (FoldList a)
forall r. (r -> f a -> r) -> r -> r
f (\f (FoldList a)
l f a
a -> FoldList a -> a -> FoldList a
forall a. FoldList a -> a -> FoldList a
go (FoldList a -> a -> FoldList a)
-> f (FoldList a) -> f (a -> FoldList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FoldList a)
l f (a -> FoldList a) -> f a -> f (FoldList a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
a) (FoldList a -> f (FoldList a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList (\r -> a -> r
_ r
r -> r
r)))
      where
        go :: FoldList a -> a -> FoldList a
go (FoldList forall r. (r -> a -> r) -> r -> r
xs) a
x = (forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList (\r -> a -> r
k r
r -> r -> a -> r
k ((r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
xs r -> a -> r
k r
r) a
x)
        {-# INLINE go #-}
    {-# INLINE sequenceA #-}

instance Eq a => Eq (FoldList a) where
    FoldList a
l == :: FoldList a -> FoldList a -> Bool
== FoldList a
r = FoldList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FoldList a
l [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== FoldList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FoldList a
r

instance NFData a => NFData (FoldList a) where
    rnf :: FoldList a -> ()
rnf (FoldList forall r. (r -> a -> r) -> r -> r
l) = (() -> a -> ()) -> () -> ()
forall r. (r -> a -> r) -> r -> r
l (\() a
a -> a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` ()) ()

instance Hashable a => Hashable (FoldList a) where
    hashWithSalt :: Int -> FoldList a -> Int
hashWithSalt Int
s (FoldList forall r. (r -> a -> r) -> r -> r
l) = (Int -> a -> Int) -> Int -> Int
forall r. (r -> a -> r) -> r -> r
l Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s

instance Semigroup (FoldList a) where
    FoldList forall r. (r -> a -> r) -> r -> r
f1 <> :: FoldList a -> FoldList a -> FoldList a
<> FoldList forall r. (r -> a -> r) -> r -> r
f2 =
        (forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList ((forall r. (r -> a -> r) -> r -> r) -> FoldList a)
-> (forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a b. (a -> b) -> a -> b
$ \r -> a -> r
cons r
nil -> (r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
f2 r -> a -> r
cons ((r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
f1 r -> a -> r
cons r
nil)
    {-# INLINE (<>) #-}

instance Monoid (FoldList a) where
    mempty :: FoldList a
mempty = (forall r. (r -> a -> r) -> r -> r) -> FoldList a
forall a. (forall r. (r -> a -> r) -> r -> r) -> FoldList a
FoldList (\r -> a -> r
_ r
r -> r
r)
    {-# INLINE mempty #-}