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

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Semigroup.Generator
-- Copyright   :  (c) Edward Kmett 2009
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- A 'Generator1' @c@ is a possibly-specialized container, which contains values of
-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract
-- an answer.
--
-- 'Generator1' is to 'Generator' as 'Foldable1' is to 'Foldable'.
-----------------------------------------------------------------------------

module Data.Semigroup.Generator
  (
  -- * Generators
    Generator1(..)
  -- * Combinators
  , reduce1
  , mapReduceWith1
  , reduceWith1
  ) where

import Data.List.NonEmpty (NonEmpty)
import Data.Semigroup.Foldable
import Data.Semigroup.Reducer
import Data.Generator

-- #if !(MIN_VERSION_base(4,8,0))
-- import Data.Monoid (Monoid(..))
-- import Data.Foldable (fold,foldMap)
-- #endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..)) -- , WrappedMonoid(..))
#endif

-- | minimal definition 'mapReduce1' or 'mapTo1'
class Generator c => Generator1 c where
  mapReduce1 :: Reducer e m => (Elem c -> e) -> c -> m
  mapTo1     :: Reducer e m => (Elem c -> e) -> m -> c -> m
  mapFrom1   :: Reducer e m => (Elem c -> e) -> c -> m -> m

  mapTo1 Elem c -> e
f m
m = m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) m
m (m -> m) -> (c -> m) -> c -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem c -> e) -> c -> m
forall c e m.
(Generator1 c, Reducer e m) =>
(Elem c -> e) -> c -> m
mapReduce1 Elem c -> e
f
  mapFrom1 Elem c -> e
f = m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (m -> m -> m) -> (c -> m) -> c -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem c -> e) -> c -> m
forall c e m.
(Generator1 c, Reducer e m) =>
(Elem c -> e) -> c -> m
mapReduce1 Elem c -> e
f

instance Generator1 (NonEmpty e) where
  mapReduce1 :: (Elem (NonEmpty e) -> e) -> NonEmpty e -> m
mapReduce1 Elem (NonEmpty e) -> e
f = (e -> m) -> NonEmpty e -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (e -> m
forall c m. Reducer c m => c -> m
unit (e -> m) -> (e -> e) -> e -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
Elem (NonEmpty e) -> e
f)

{-
mapReduceDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> c -> m
mapReduceDefault f = unwrapMonoid . mapReduce1 f

mapToDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m
mapToDefault f = unwrapMonoid . mapTo1 f

mapFromDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m
mapFromDefault f = unwrapMonoid . mapFrom1 f
-}

-- | Apply a 'Reducer' directly to the elements of a 'Generator'
reduce1 :: (Generator1 c, Reducer (Elem c) m) => c -> m
reduce1 :: c -> m
reduce1 = (Elem c -> Elem c) -> c -> m
forall c e m.
(Generator1 c, Reducer e m) =>
(Elem c -> e) -> c -> m
mapReduce1 Elem c -> Elem c
forall a. a -> a
id
{-# SPECIALIZE reduce1 :: Reducer a m => NonEmpty a -> m #-}

mapReduceWith1 :: (Generator1 c, Reducer e m) => (m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith1 :: (m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith1 m -> n
f Elem c -> e
g = m -> n
f (m -> n) -> (c -> m) -> c -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem c -> e) -> c -> m
forall c e m.
(Generator1 c, Reducer e m) =>
(Elem c -> e) -> c -> m
mapReduce1 Elem c -> e
g
{-# INLINE mapReduceWith1 #-}

reduceWith1 :: (Generator1 c, Reducer (Elem c) m) => (m -> n) -> c -> n
reduceWith1 :: (m -> n) -> c -> n
reduceWith1 m -> n
f = m -> n
f (m -> n) -> (c -> m) -> c -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> m
forall c m. (Generator1 c, Reducer (Elem c) m) => c -> m
reduce1
{-# INLINE reduceWith1 #-}