{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}
module Control.Lens.Compat
  ( pre
  , assign
  , modifying
  , traverseOf

  , Getter

  , module Lens.Micro.Platform
  ) where

import Data.Monoid         (First)
import Lens.Micro.Platform hiding (assign, modifying, traverseOf)
import Control.Monad.State (MonadState, modify)


pre :: Getting (First a) s a -> Getter s (Maybe a)
pre :: Getting (First a) s a -> Getter s (Maybe a)
pre Getting (First a) s a
l = (s -> Maybe a) -> Getter s (Maybe a)
forall s a. (s -> a) -> SimpleGetter s a
to (Getting (First a) s a -> s -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) s a
l)
{-# INLINE pre #-}

assign :: MonadState s m => ASetter s s a b -> b -> m ()
assign :: ASetter s s a b -> b -> m ()
assign ASetter s s a b
l b
b = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a b
l b
b)
{-# INLINE assign #-}

modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
modifying :: ASetter s s a b -> (a -> b) -> m ()
modifying ASetter s s a b
l a -> b
f = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter s s a b -> (a -> b) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s a b
l a -> b
f)
{-# INLINE modifying #-}

traverseOf :: a -> a
traverseOf :: a -> a
traverseOf = a -> a
forall a. a -> a
id
{-# INLINE traverseOf #-}

type Getter s a = SimpleGetter s a

-- | Build an (index-preserving) 'Getter' from an arbitrary Haskell function.
-- See "Control.Lens".'Lens.to' for details.
--
-- In <https://hackage.haskell.org/package/lens-4.14 lens-4.14>, the constraint
-- @'Functor' f@ is missing from the definition of 'Lens.to'. When compiling
-- with GHC 8.0, this leads to warnings for definitions like
--
-- @
-- foo :: Getter Bar Foo
-- foo = to fooFromBar
-- @
--
-- because of the redundant @'Functor' f@ constraint. This definition is
-- identical to "Control.Lens".'Lens.to' except for the additional constraint
-- @'Functor' f@.
-- to :: (Profunctor p, Functor f, Contravariant f) => (s -> a) -> Optic' p f s a
-- to k = getter
--   where
--     getter = Lens.to k
--     _fakeFunctorConstraint = rmap (fmap undefined) . getter