{-# LANGUAGE Rank2Types #-}
-- | This is the main module for end-users of lens-families.
-- If you are not building your own lenses or traversals, but just using functional references made by others, this is the only module you need.
module Lens.Family2 (
-- * Lenses
--
-- | This module provides 'LF.^.' for accessing fields and 'LF..~' and 'LF.%~' for setting and modifying fields.
-- Lenses are composed with `Prelude..` from the @Prelude@ and `Prelude.id` is the identity lens.
--
-- Lens composition in this library enjoys the following identities.
--
-- * @x^.l1.l2 === x^.l1^.l2@
--
-- * @l1.l2 %~ f === l1 %~ l2 %~ f@
--
-- The identity lens behaves as follows.
--
-- * @x^.id === x@
--
-- * @id %~ f === f@
--
-- The 'LF.&' operator, allows for a convenient way to sequence record updating:
--
-- @record & l1 .~ value1 & l2 .~ value2@
--
-- Lenses are implemented in van Laarhoven style.
-- Lenses have type @'Functor' f => (b -> f b) -> a -> f a@ and lens families have type @'Functor' f => (b i -> f (b j)) -> a i -> f (a j)@.
--
-- Keep in mind that lenses and lens families can be used directly for functorial updates.
-- For example, @_2 id@ gives you strength.
--
-- > _2 id :: Functor f => (a, f b) -> f (a, b)
--
-- Here is an example of code that uses the 'Maybe' functor to preserves sharing during update when possible.
--
-- > -- | 'sharedUpdate' returns the *identical* object if the update doesn't change anything.
-- > -- This is useful for preserving sharing.
-- > sharedUpdate :: Eq b => LensLike' Maybe a b -> (b -> b) -> a -> a
-- > sharedUpdate l f a = fromMaybe a (l f' a)
-- >  where
-- >   f' b | fb == b  = Nothing
-- >        | otherwise = Just fb
-- >    where
-- >     fb = f b

-- * Traversals
--
-- | 'LF.^.' can be used with traversals to access monoidal fields.
-- The result will be a 'Data.Monid.mconcat' of all the fields referenced.
-- The various @fooOf@ functions can be used to access different monoidal summaries of some kinds of values.
--
-- '^?' can be used to access the first value of a traversal.
-- 'Nothing' is returned when the traversal has no references.
--
-- '^..' can be used with a traversals and will return a list of all fields referenced.
--
-- When 'LF..~' is used with a traversal, all referenced fields will be set to the same value, and when 'LF.%~' is used with a traversal, all referenced fields will be modified with the same function.
--
-- Like lenses, traversals can be composed with '.', and because every lens is automatically a traversal, lenses and traversals can be composed with '.' yielding a traversal.
--
-- Traversals are implemented in van Laarhoven style.
-- Traversals have type @'Applicative' f => (b -> f b) -> a -> f a@ and traversal families have type @'Applicative' f => (b i -> f (b j)) -> a i -> f (a j)@.
--
-- For stock lenses and traversals, see "Lens.Family2.Stock".
--
-- To build your own lenses and traversals, see "Lens.Family2.Unchecked".
--
-- References:
--
-- * <http://www.twanvl.nl/blog/haskell/cps-functional-references>
--
-- * <http://r6.ca/blog/20120623T104901Z.html>
--
-- * <http://comonad.com/reader/2012/mirrored-lenses/>
--
-- * <http://conal.net/blog/posts/semantic-editor-combinators>

-- * Documentation
    to, LF.view, (LF.^.)
  , folding, LF.views, (^..), (^?)
  , toListOf, allOf, anyOf, firstOf, lastOf, sumOf, productOf
  , lengthOf, nullOf
  , LF.backwards
  , over, (%~), set, (.~)
  , (LF.&)
-- * Pseudo-imperatives
  , (+~), (*~), (-~), (//~), (&&~), (||~), (<>~)
-- * Types
  , Lens, Lens'
  , Traversal, Traversal'
  , Setter, Setter'
  , Getter, Getter'
  , Fold, Fold'
  , LF.LensLike, LF.LensLike'
  , LF.FoldLike, LF.FoldLike'
  , LF.Constant
  , LF.Phantom
  , Identical
-- * Re-exports
  , Applicative, Foldable, Monoid
  , LF.Backwards
  ) where

import Control.Applicative (Applicative)
import Data.Foldable (Foldable)
import Data.Monoid (Monoid)
import qualified Lens.Family as LF
import Lens.Family2.Unchecked ( Lens, Lens'
                              , Traversal, Traversal'
                              , Setter, Setter', Identical
                              )

type Fold a a' b b' = forall f. (LF.Phantom f, Applicative f) => LF.LensLike f a a' b b'
type Fold' a b = forall f. (LF.Phantom f, Applicative f) => LF.LensLike' f a b

type Getter a a' b b' = forall f. LF.Phantom f => LF.LensLike f a a' b b'
type Getter' a b = forall f. LF.Phantom f=> LF.LensLike' f a b

-- |'to' promotes a projection function to a read-only lens called a getter.
-- To demote a lens to a projection function, use the section @(^.l)@ or @view l@.
--
-- >>> (3 :+ 4, "example")^._1.to(abs)
-- 5.0 :+ 0.0
to :: (a -> b) -> Getter a a' b b'
to = LF.to

-- | 'folding' promotes a \"toList\" function to a read-only traversal called a fold.
--
-- To demote a traversal or fold to a \"toList\" function use the section @(^..l)@ or @toListOf l@.
folding :: Foldable f => (a -> f b) -> Fold a a' b b'
folding = LF.folding

-- | Returns a list of all of the referenced values in order.
toListOf :: Fold a a' b b' -> a -> [b]
toListOf l = LF.toListOf l

-- | Returns true if all of the referenced values satisfy the given predicate.
allOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool
allOf l = LF.allOf l

-- | Returns true if any of the referenced values satisfy the given predicate.
anyOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool
anyOf l = LF.anyOf l

-- | Returns 'Just' the first referenced value.
-- Returns 'Nothing' if there are no referenced values.
-- See '^?' for an infix version of 'firstOf'
firstOf :: Fold a a' b b' -> a -> Maybe b
firstOf l = LF.firstOf l

-- | Returns 'Just' the last referenced value.
-- Returns 'Nothing' if there are no referenced values.
lastOf :: Fold a a' b b' -> a -> Maybe b
lastOf l = LF.lastOf l

-- | Returns the sum of all the referenced values.
sumOf :: Num b => Fold a a' b b' -> a -> b
sumOf l = LF.sumOf l

-- | Returns the product of all the referenced values.
productOf :: Num b => Fold a a' b b' -> a -> b
productOf l = LF.productOf l

-- | Counts the number of references in a traversal or fold for the input.
lengthOf :: Num r => Fold a a' b b' -> a -> r
lengthOf l = LF.lengthOf l

-- | Returns true if the number of references in the input is zero.
nullOf :: Fold a a' b b' -> a -> Bool
nullOf l = LF.nullOf l

infixl 8 ^..

-- | Returns a list of all of the referenced values in order.
(^..) :: a -> Fold a a' b b' -> [b]
x^..l = x LF.^.. l

infixl 8 ^?

-- | Returns 'Just' the first referenced value.
-- Returns 'Nothing' if there are no referenced values.
(^?) :: a -> Fold a a' b b' -> Maybe b
x^?l = x LF.^? l

-- | Demote a setter to a semantic editor combinator.
over :: Setter a a' b b' -> (b -> b') -> a -> a'
over l = LF.over l

infixr 4 %~

-- | Modify all referenced fields.
(%~) :: Setter a a' b b' -> (b -> b') -> a -> a'
l %~ f = l LF.%~ f

infixr 4 .~

-- | Set all referenced fields to the given value.
(.~) :: Setter a a' b b' -> b' -> a -> a'
l .~ b = l LF..~ b

-- | Set all referenced fields to the given value.
set :: Setter a a' b b' -> b' -> a -> a'
set l = LF.set l

infixr 4 +~, -~, *~

(+~), (-~), (*~) :: Num b => Setter' a b -> b -> a -> a
f +~ b = f LF.+~ b
f -~ b = f LF.-~ b
f *~ b = f LF.*~ b

infixr 4 //~

(//~) :: Fractional b => Setter' a b -> b -> a -> a
f //~ b = f LF.//~ b

infixr 4 &&~, ||~

(&&~), (||~) :: Setter' a Bool -> Bool -> a -> a
f &&~ b = f LF.&&~ b
f ||~ b = f LF.||~ b

infixr 4 <>~

-- | Monoidally append a value to all referenced fields.
(<>~) :: (Monoid o) => Setter' a o -> o -> a -> a
f <>~ o = f LF.<>~ o