{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Reverse
-- Copyright   :  (c) Russell O'Connor 2009
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  R.Paterson@city.ac.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- Making functors whose elements are notionally in the reverse order
-- from the original functor.
-----------------------------------------------------------------------------

module Data.Functor.Reverse (
    Reverse(..),
  ) where

import Control.Applicative.Backwards
import Data.Functor.Classes
#if MIN_VERSION_base(4,12,0)
import Data.Functor.Contravariant
#endif

import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Data.Foldable
import Data.Traversable
import Data.Monoid

-- | The same functor, but with 'Foldable' and 'Traversable' instances
-- that process the elements in the reverse order.
newtype Reverse f a = Reverse { Reverse f a -> f a
getReverse :: f a }

instance (Eq1 f) => Eq1 (Reverse f) where
    liftEq :: (a -> b -> Bool) -> Reverse f a -> Reverse f b -> Bool
liftEq a -> b -> Bool
eq (Reverse f a
x) (Reverse f b
y) = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
x f b
y
    {-# INLINE liftEq #-}

instance (Ord1 f) => Ord1 (Reverse f) where
    liftCompare :: (a -> b -> Ordering) -> Reverse f a -> Reverse f b -> Ordering
liftCompare a -> b -> Ordering
comp (Reverse f a
x) (Reverse f b
y) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
comp f a
x f b
y
    {-# INLINE liftCompare #-}

instance (Read1 f) => Read1 (Reverse f) where
    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Reverse f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (Reverse f a)) -> Int -> ReadS (Reverse f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Reverse f a)) -> Int -> ReadS (Reverse f a))
-> (String -> ReadS (Reverse f a)) -> Int -> ReadS (Reverse f a)
forall a b. (a -> b) -> a -> b
$
        (Int -> ReadS (f a))
-> String -> (f a -> Reverse f a) -> String -> ReadS (Reverse f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"Reverse" f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse

instance (Show1 f) => Show1 (Reverse f) where
    liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Reverse f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Reverse f a
x) =
        (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"Reverse" Int
d f a
x

instance (Eq1 f, Eq a) => Eq (Reverse f a) where == :: Reverse f a -> Reverse f a -> Bool
(==) = Reverse f a -> Reverse f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare :: Reverse f a -> Reverse f a -> Ordering
compare = Reverse f a -> Reverse f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec :: Int -> ReadS (Reverse f a)
readsPrec = Int -> ReadS (Reverse f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec :: Int -> Reverse f a -> ShowS
showsPrec = Int -> Reverse f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

-- | Derived instance.
instance (Functor f) => Functor (Reverse f) where
    fmap :: (a -> b) -> Reverse f a -> Reverse f b
fmap a -> b
f (Reverse f a
a) = f b -> Reverse f b
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
a)
    {-# INLINE fmap #-}

-- | Derived instance.
instance (Applicative f) => Applicative (Reverse f) where
    pure :: a -> Reverse f a
pure a
a = f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
    {-# INLINE pure #-}
    Reverse f (a -> b)
f <*> :: Reverse f (a -> b) -> Reverse f a -> Reverse f b
<*> Reverse f a
a = f b -> Reverse f b
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f (a -> b)
f f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
a)
    {-# INLINE (<*>) #-}

-- | Derived instance.
instance (Alternative f) => Alternative (Reverse f) where
    empty :: Reverse f a
empty = f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse f a
forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE empty #-}
    Reverse f a
x <|> :: Reverse f a -> Reverse f a -> Reverse f a
<|> Reverse f a
y = f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a
x f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
y)
    {-# INLINE (<|>) #-}

-- | Derived instance.
instance (Monad m) => Monad (Reverse m) where
#if !(MIN_VERSION_base(4,8,0))
    return a = Reverse (return a)
    {-# INLINE return #-}
#endif
    Reverse m a
m >>= :: Reverse m a -> (a -> Reverse m b) -> Reverse m b
>>= a -> Reverse m b
f = m b -> Reverse m b
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (Reverse m a -> m a
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse Reverse m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Reverse m b -> m b
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse (Reverse m b -> m b) -> (a -> Reverse m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Reverse m b
f)
    {-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
    fail msg = Reverse (fail msg)
    {-# INLINE fail #-}
#endif

#if MIN_VERSION_base(4,9,0)
instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where
    fail :: String -> Reverse m a
fail String
msg = m a -> Reverse m a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg)
    {-# INLINE fail #-}
#endif

-- | Derived instance.
instance (MonadPlus m) => MonadPlus (Reverse m) where
    mzero :: Reverse m a
mzero = m a -> Reverse m a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    {-# INLINE mzero #-}
    Reverse m a
x mplus :: Reverse m a -> Reverse m a -> Reverse m a
`mplus` Reverse m a
y = m a -> Reverse m a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (m a
x m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` m a
y)
    {-# INLINE mplus #-}

-- | Fold from right to left.
instance (Foldable f) => Foldable (Reverse f) where
    foldMap :: (a -> m) -> Reverse f a -> m
foldMap a -> m
f (Reverse f a
t) = Dual m -> m
forall a. Dual a -> a
getDual ((a -> Dual m) -> f a -> Dual m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m -> Dual m
forall a. a -> Dual a
Dual (m -> Dual m) -> (a -> m) -> a -> Dual m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) f a
t)
    {-# INLINE foldMap #-}
    foldr :: (a -> b -> b) -> b -> Reverse f a -> b
foldr a -> b -> b
f b
z (Reverse f a
t) = (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f) b
z f a
t
    {-# INLINE foldr #-}
    foldl :: (b -> a -> b) -> b -> Reverse f a -> b
foldl b -> a -> b
f b
z (Reverse f a
t) = (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
z f a
t
    {-# INLINE foldl #-}
    foldr1 :: (a -> a -> a) -> Reverse f a -> a
foldr1 a -> a -> a
f (Reverse f a
t) = (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
f) f a
t
    {-# INLINE foldr1 #-}
    foldl1 :: (a -> a -> a) -> Reverse f a -> a
foldl1 a -> a -> a
f (Reverse f a
t) = (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
f) f a
t
    {-# INLINE foldl1 #-}
#if MIN_VERSION_base(4,8,0)
    null :: Reverse f a -> Bool
null (Reverse f a
t) = f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
t
    length :: Reverse f a -> Int
length (Reverse f a
t) = f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
t
#endif

-- | Traverse from right to left.
instance (Traversable f) => Traversable (Reverse f) where
    traverse :: (a -> f b) -> Reverse f a -> f (Reverse f b)
traverse a -> f b
f (Reverse f a
t) =
        (f b -> Reverse f b) -> f (f b) -> f (Reverse f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Reverse f b
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f (f b) -> f (Reverse f b))
-> (Backwards f (f b) -> f (f b))
-> Backwards f (f b)
-> f (Reverse f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards f (f b) -> f (f b)
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards f (f b) -> f (Reverse f b))
-> Backwards f (f b) -> f (Reverse f b)
forall a b. (a -> b) -> a -> b
$ (a -> Backwards f b) -> f a -> Backwards f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) f a
t
    {-# INLINE traverse #-}

#if MIN_VERSION_base(4,12,0)
-- | Derived instance.
instance Contravariant f => Contravariant (Reverse f) where
    contramap :: (a -> b) -> Reverse f b -> Reverse f a
contramap a -> b
f = f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a)
-> (Reverse f b -> f a) -> Reverse f b -> Reverse f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f (f b -> f a) -> (Reverse f b -> f b) -> Reverse f b -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reverse f b -> f b
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
    {-# INLINE contramap #-}
#endif