{-# LANGUAGE CPP #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif

#include "lens-common.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Parallel.Strategies.Lens
-- Copyright   :  (C) 2012-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- A 'Lens' or 'Traversal' can be used to take the role of 'Traversable' in
-- @Control.Parallel.Strategies@, enabling those combinators to work with
-- monomorphic containers.
----------------------------------------------------------------------------
module Control.Parallel.Strategies.Lens
  ( evalOf
  , parOf
  , after
  , throughout
  ) where

import Control.Lens
import Control.Parallel.Strategies

-- | Evaluate the targets of a 'Lens' or 'Traversal' into a data structure
-- according to the given 'Strategy'.
--
-- @
-- 'evalTraversable' = 'evalOf' 'traverse' = 'traverse'
-- 'evalOf' = 'id'
-- @
--
-- @
-- 'evalOf' :: 'Lens'' s a -> 'Strategy' a -> 'Strategy' s
-- 'evalOf' :: 'Traversal'' s a -> 'Strategy' a -> 'Strategy' s
-- 'evalOf' :: (a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s
-- @
evalOf :: LensLike' Eval s a -> Strategy a -> Strategy s
evalOf :: LensLike' Eval s a -> LensLike' Eval s a
evalOf LensLike' Eval s a
l = LensLike' Eval s a
l
{-# INLINE evalOf #-}

-- | Evaluate the targets of a 'Lens' or 'Traversal' according into a
-- data structure according to a given 'Strategy' in parallel.
--
-- @'parTraversable' = 'parOf' 'traverse'@
--
-- @
-- 'parOf' :: 'Lens'' s a -> 'Strategy' a -> 'Strategy' s
-- 'parOf' :: 'Traversal'' s a -> 'Strategy' a -> 'Strategy' s
-- 'parOf' :: ((a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s
-- @
parOf :: LensLike' Eval s a -> Strategy a -> Strategy s
#if MIN_VERSION_parallel(3,2,0)
parOf :: LensLike' Eval s a -> LensLike' Eval s a
parOf LensLike' Eval s a
l Strategy a
s = LensLike' Eval s a
l (Strategy a -> Strategy a
forall a. Strategy a -> Strategy a
rparWith Strategy a
s)
#else
parOf l s = l (rpar `dot` s)
#endif
{-# INLINE parOf #-}

-- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to
-- first evaluates its argument according to a given 'Strategy' /before/ proceeding.
--
-- @
-- 'after' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a]
-- @
after :: Strategy s -> LensLike f s t a b -> LensLike f s t a b
after :: Strategy s -> LensLike f s t a b -> LensLike f s t a b
after Strategy s
s LensLike f s t a b
l a -> f b
f = LensLike f s t a b
l a -> f b
f (s -> f t) -> Strategy s -> s -> f t
forall a b. (a -> b) -> Strategy a -> a -> b
$| Strategy s
s
{-# INLINE after #-}

-- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to
-- evaluate its argument according to a given 'Strategy' /in parallel with/ evaluating.
--
-- @
-- 'throughout' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a]
-- @
throughout :: Strategy s -> LensLike f s t a b -> LensLike f s t a b
throughout :: Strategy s -> LensLike f s t a b -> LensLike f s t a b
throughout Strategy s
s LensLike f s t a b
l a -> f b
f = LensLike f s t a b
l a -> f b
f (s -> f t) -> Strategy s -> s -> f t
forall a b. (a -> b) -> Strategy a -> a -> b
$|| Strategy s
s
{-# INLINE throughout #-}