{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710
{-# LANGUAGE Trustworthy #-}
#endif

-----------------------------------------------------------------------------
-- |
-- 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

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Data.FingerTree
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Traversable
#endif
import Data.Hashable
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Semigroup.Reducer
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Semigroup.Instances ()

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