-- | This is the main module for end-users of lens-families.
-- If you are not building your own lenses, but just using top-level defined lenses made by others, this is the only module you need.
-- It provides '^.' for accessing fields and '^=' and '^%=' for setting and modifying fields.
-- Lenses are composed with `Prelude..` from the @Prelude@ and `Prelude.id` is the identity lens.
--
-- /Warning/: Lenses are composed in the opposite order than most lens packages.
-- Lenses in this library enjoy 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@
--
-- 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 x -> f (b x')) -> a x -> f (a x')@.
--
-- Remember that lenses and lens families can be used directly for functorial updates.
-- For example, @sndL id@ gives you strength.
--
-- > sndL 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 => Lens Maybe a b -> (b -> b) -> a -> a
-- > sharedUpdate lens f a = fromMaybe a (lens f' a)
-- >  where
-- >   f' b | fb == b  = Nothing
-- >        | otherwise = Just fb
-- >    where
-- >     fb = f b
--
-- For stock lenses, see "Lens.Family.Stock".
--
-- To build your own lenses, see "Lens.Family.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>
module Lens.Family
  ( getting, setting
  , (^.)
  , (^%=)
  , (^=)
  -- * Pseudo-imperatives
  , (^+=), (^*=), (^-=), (^/=), (^&&=), (^||=)
  -- * Types
  , GetterFamily, Getter
  , SetterFamily, Setter
  ) where

import Lens.Family.Unchecked (LensFamily)

newtype Getting c a = Getting { unGetting :: c }
instance Functor (Getting c) where
  fmap _ (Getting c) = Getting c

newtype Setting a = Setting { unSetting :: a }
instance Functor Setting where
  fmap f (Setting a) = Setting (f a)

type GetterFamily a a' b b' = LensFamily (Getting b) a a' b b'
type Getter a b = GetterFamily a a b b

type SetterFamily a a' b b' = LensFamily Setting a a' b b'
type Setter a b = SetterFamily a a b b

-- | 'getting' promotes a projection function to a read-only lens.
-- To demote a lens to a projection function, use the section @(^. l)@.
--
-- >>> (3 :+ 4, "example") ^. fstL . getting abs
-- 5.0 :+ 0.0
getting :: (a -> b) -> GetterFamily a a' b b'
getting p _ = Getting . p

-- | 'setting' promotes a \"semantic editor combinator\" to a modify-only lens.
-- To demote a lens to a semantic edit combinator, use the section @(l ^%=)@.
--
-- >>> setting map . fstL ^%= length $ [("The",0),("quick",1),("brown",1),("fox",2)]
-- [(3,0),(5,1),(5,1),(3,2)]
setting :: ((b -> b') -> a -> a') -> SetterFamily a a' b b'
setting s f = Setting . s (unSetting . f)

infixr 8 ^.

-- | Access a field.
(^.) :: a -> GetterFamily a a' b b' -> b
x ^. l = unGetting $ l Getting x

infixr 4 ^%=

-- | Modify a field.
(^%=) :: SetterFamily a a' b b' -> (b -> b') -> a -> a'
l ^%= f = unSetting . l (Setting . f)

-- | Set a field.
infixr 4 ^=

(^=) :: SetterFamily a a' b b' -> b' -> a -> a'
l ^= b = l ^%= const b

infixr 4 ^+=, ^-=, ^*=

(^+=), (^-=), (^*=) :: Num b => Setter a b -> b -> a -> a
f ^+= b = f ^%= (+ b)
f ^-= b = f ^%= subtract b
f ^*= b = f ^%= (* b)

infixr 4 ^/=

(^/=) :: Fractional b => Setter a b -> b -> a -> a
f ^/= b = f ^%= (/ b)

infixr 4 ^&&=, ^||=

(^&&=), (^||=) :: Setter a Bool -> Bool -> a -> a
f ^&&= b = f ^%= (&& b)
f ^||= b = f ^%= (|| b)