-- | Some very simple lens definitions (to avoid further dependencies)
--
-- Intended to be double-imported
-- > import Hackage.Security.Util.Lens (Lens)
-- > import qualified Hackage.Security.Util.Lens as Lens
module Hackage.Security.Util.Lens (
    -- * Generic definitions
    Lens
  , Lens'
  , Traversal
  , Traversal'
  , get
  , over
  , set
  ) where

import MyPrelude
import Control.Applicative
import Data.Functor.Identity

{-------------------------------------------------------------------------------
  General definitions
-------------------------------------------------------------------------------}

-- | Polymorphic lens
type Lens s t a b = forall f. Functor f => LensLike f s t a b

-- | Monomorphic lens
type Lens' s a = Lens s s a a

-- | Polymorphic traversal
type Traversal s t a b = forall f. Applicative f => LensLike f s t a b

-- | Monomorphic traversal
type Traversal' s a = Traversal s s a a

type LensLike f s t a b = (a -> f b) -> s -> f t
type LensLike' f s a = LensLike f s s a a

get :: LensLike' (Const a) s a -> s -> a
get :: forall a s. LensLike' (Const a) s a -> s -> a
get LensLike' (Const a) s a
l = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Const a) s a
l forall {k} a (b :: k). a -> Const a b
Const

over :: LensLike Identity s t a b -> (a -> b) -> s -> t
over :: forall s t a b. LensLike Identity s t a b -> (a -> b) -> s -> t
over LensLike Identity s t a b
l a -> b
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike Identity s t a b
l (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

set :: LensLike Identity s t a b -> b -> s -> t
set :: forall s t a b. LensLike Identity s t a b -> b -> s -> t
set LensLike Identity s t a b
l = forall s t a b. LensLike Identity s t a b -> (a -> b) -> s -> t
over LensLike Identity s t a b
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const