{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Semigroup.Reducer.With
-- Copyright   :  (c) Edward Kmett 2009-2011
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs)
--
-----------------------------------------------------------------------------

module Data.Semigroup.Reducer.With
  ( WithReducer(..)
  ) where

import Data.FingerTree
import Data.Hashable
import Data.Semigroup.Reducer
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable

-- | If @m@ is a @c@-"Reducer", then m is @(c `WithReducer` m)@-"Reducer"
--   This can be used to quickly select a "Reducer" for use as a 'FingerTree'
--   'measure'.

newtype WithReducer m c = WithReducer { forall m c. WithReducer m c -> c
withoutReducer :: c }
  deriving (WithReducer m c -> WithReducer m c -> Bool
(WithReducer m c -> WithReducer m c -> Bool)
-> (WithReducer m c -> WithReducer m c -> Bool)
-> Eq (WithReducer m c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall m c. Eq c => WithReducer m c -> WithReducer m c -> Bool
$c== :: forall m c. Eq c => WithReducer m c -> WithReducer m c -> Bool
== :: WithReducer m c -> WithReducer m c -> Bool
$c/= :: forall m c. Eq c => WithReducer m c -> WithReducer m c -> Bool
/= :: WithReducer m c -> WithReducer m c -> Bool
Eq, Eq (WithReducer m c)
Eq (WithReducer m c) =>
(WithReducer m c -> WithReducer m c -> Ordering)
-> (WithReducer m c -> WithReducer m c -> Bool)
-> (WithReducer m c -> WithReducer m c -> Bool)
-> (WithReducer m c -> WithReducer m c -> Bool)
-> (WithReducer m c -> WithReducer m c -> Bool)
-> (WithReducer m c -> WithReducer m c -> WithReducer m c)
-> (WithReducer m c -> WithReducer m c -> WithReducer m c)
-> Ord (WithReducer m c)
WithReducer m c -> WithReducer m c -> Bool
WithReducer m c -> WithReducer m c -> Ordering
WithReducer m c -> WithReducer m c -> WithReducer m c
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 m c. Ord c => Eq (WithReducer m c)
forall m c. Ord c => WithReducer m c -> WithReducer m c -> Bool
forall m c. Ord c => WithReducer m c -> WithReducer m c -> Ordering
forall m c.
Ord c =>
WithReducer m c -> WithReducer m c -> WithReducer m c
$ccompare :: forall m c. Ord c => WithReducer m c -> WithReducer m c -> Ordering
compare :: WithReducer m c -> WithReducer m c -> Ordering
$c< :: forall m c. Ord c => WithReducer m c -> WithReducer m c -> Bool
< :: WithReducer m c -> WithReducer m c -> Bool
$c<= :: forall m c. Ord c => WithReducer m c -> WithReducer m c -> Bool
<= :: WithReducer m c -> WithReducer m c -> Bool
$c> :: forall m c. Ord c => WithReducer m c -> WithReducer m c -> Bool
> :: WithReducer m c -> WithReducer m c -> Bool
$c>= :: forall m c. Ord c => WithReducer m c -> WithReducer m c -> Bool
>= :: WithReducer m c -> WithReducer m c -> Bool
$cmax :: forall m c.
Ord c =>
WithReducer m c -> WithReducer m c -> WithReducer m c
max :: WithReducer m c -> WithReducer m c -> WithReducer m c
$cmin :: forall m c.
Ord c =>
WithReducer m c -> WithReducer m c -> WithReducer m c
min :: WithReducer m c -> WithReducer m c -> WithReducer m c
Ord, Int -> WithReducer m c -> ShowS
[WithReducer m c] -> ShowS
WithReducer m c -> String
(Int -> WithReducer m c -> ShowS)
-> (WithReducer m c -> String)
-> ([WithReducer m c] -> ShowS)
-> Show (WithReducer m c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m c. Show c => Int -> WithReducer m c -> ShowS
forall m c. Show c => [WithReducer m c] -> ShowS
forall m c. Show c => WithReducer m c -> String
$cshowsPrec :: forall m c. Show c => Int -> WithReducer m c -> ShowS
showsPrec :: Int -> WithReducer m c -> ShowS
$cshow :: forall m c. Show c => WithReducer m c -> String
show :: WithReducer m c -> String
$cshowList :: forall m c. Show c => [WithReducer m c] -> ShowS
showList :: [WithReducer m c] -> ShowS
Show, ReadPrec [WithReducer m c]
ReadPrec (WithReducer m c)
Int -> ReadS (WithReducer m c)
ReadS [WithReducer m c]
(Int -> ReadS (WithReducer m c))
-> ReadS [WithReducer m c]
-> ReadPrec (WithReducer m c)
-> ReadPrec [WithReducer m c]
-> Read (WithReducer m c)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall m c. Read c => ReadPrec [WithReducer m c]
forall m c. Read c => ReadPrec (WithReducer m c)
forall m c. Read c => Int -> ReadS (WithReducer m c)
forall m c. Read c => ReadS [WithReducer m c]
$creadsPrec :: forall m c. Read c => Int -> ReadS (WithReducer m c)
readsPrec :: Int -> ReadS (WithReducer m c)
$creadList :: forall m c. Read c => ReadS [WithReducer m c]
readList :: ReadS [WithReducer m c]
$creadPrec :: forall m c. Read c => ReadPrec (WithReducer m c)
readPrec :: ReadPrec (WithReducer m c)
$creadListPrec :: forall m c. Read c => ReadPrec [WithReducer m c]
readListPrec :: ReadPrec [WithReducer m c]
Read)

instance Hashable c => Hashable (WithReducer m c) where
  hashWithSalt :: Int -> WithReducer m c -> Int
hashWithSalt Int
n = Int -> c -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (c -> Int) -> (WithReducer m c -> c) -> WithReducer m c -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m c -> c
forall m c. WithReducer m c -> c
withoutReducer

instance Functor (WithReducer m) where
  fmap :: forall a b. (a -> b) -> WithReducer m a -> WithReducer m b
fmap a -> b
f = b -> WithReducer m b
forall m c. c -> WithReducer m c
WithReducer (b -> WithReducer m b)
-> (WithReducer m a -> b) -> WithReducer m a -> WithReducer m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (WithReducer m a -> a) -> WithReducer m a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m a -> a
forall m c. WithReducer m c -> c
withoutReducer

instance Foldable (WithReducer m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> WithReducer m a -> m
foldMap a -> m
f = a -> m
f (a -> m) -> (WithReducer m a -> a) -> WithReducer m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m a -> a
forall m c. WithReducer m c -> c
withoutReducer

instance Traversable (WithReducer m) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithReducer m a -> f (WithReducer m b)
traverse a -> f b
f (WithReducer a
a) = b -> WithReducer m b
forall m c. c -> WithReducer m c
WithReducer (b -> WithReducer m b) -> f b -> f (WithReducer m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Foldable1 (WithReducer m) where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> WithReducer m a -> m
foldMap1 a -> m
f = a -> m
f (a -> m) -> (WithReducer m a -> a) -> WithReducer m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m a -> a
forall m c. WithReducer m c -> c
withoutReducer

instance Traversable1 (WithReducer m) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> WithReducer m a -> f (WithReducer m b)
traverse1 a -> f b
f (WithReducer a
a) = b -> WithReducer m b
forall m c. c -> WithReducer m c
WithReducer (b -> WithReducer m b) -> f b -> f (WithReducer m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Reducer c m => Reducer (WithReducer m c) m where
  unit :: WithReducer m c -> m
unit = c -> m
forall c m. Reducer c m => c -> m
unit (c -> m) -> (WithReducer m c -> c) -> WithReducer m c -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m c -> c
forall m c. WithReducer m c -> c
withoutReducer

instance (Monoid m, Reducer c m) => Measured m (WithReducer m c) where
  measure :: WithReducer m c -> m
measure = c -> m
forall c m. Reducer c m => c -> m
unit (c -> m) -> (WithReducer m c -> c) -> WithReducer m c -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithReducer m c -> c
forall m c. WithReducer m c -> c
withoutReducer