{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ImplicitParams #-}

-- Note: this module is marked 'Unsafe' because it exports 'coerce', and Data.Coerce is marked 'Unsafe' in base. As per <https://github.com/ekmett/lens/issues/661>, this is an issue for 'lens' as well but they have opted for 'Trustworthy' instead.
{-# LANGUAGE Unsafe #-}

{- |
Module      :  Lens.Micro.Internal
Copyright   :  (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix
License     :  BSD-style (see the file LICENSE)

This module is needed to give other packages from the microlens family (like <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>) access to functions and classes that don't need to be exported from "Lens.Micro" (because they just clutter the namespace). Also:

  * 'traversed' is here because otherwise there'd be a dependency cycle
  * 'sets' is here because it's used in RULEs

Classes like 'Each', 'Ixed', etc are provided for convenience – you're not supposed to export functions that work on all members of 'Ixed', for instance. Only microlens can do that. You mustn't declare instances of those classes for other types, either; these classes are incompatible with lens's classes, and by doing so you would divide the ecosystem.

If you absolutely need to define an instance (e.g. for internal use), only do it for your own types, because otherwise I might add an instance to one of the microlens packages later and if our instances are different it might lead to subtle bugs.
-}
module Lens.Micro.Internal
(
  traversed,
  folded,
  foldring,
  foldrOf,
  foldMapOf,
  sets,
  phantom,
  Each(..),
  Index,
  IxValue,
  Ixed(..),
  At(..),
  ixAt,
  Field1(..),
  Field2(..),
  Field3(..),
  Field4(..),
  Field5(..),
  Cons(..),
  Snoc(..),
  Strict(..),

  -- * CallStack
  HasCallStack,

  -- * Coerce compatibility shim
  coerce,

  -- * Coerce-like composition
  ( #. ),
  ( .# ),
)
where


import Lens.Micro.Type

import Control.Applicative
import Data.Monoid
import Data.Foldable as F
import Data.Functor.Identity
import Data.Complex

#if __GLASGOW_HASKELL__ >= 800
import Data.List.NonEmpty (NonEmpty(..))
#endif

#if __GLASGOW_HASKELL__ < 710
import Data.Traversable
#endif

#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
#else
import Unsafe.Coerce
#endif

-- We don't depend on the call-stack package because building an extra
-- package is likely slower than adding several lines of code here.
#if MIN_VERSION_base(4,9,0)
import Data.Kind (Type)
import GHC.Stack (HasCallStack)
#elif MIN_VERSION_base(4,8,1)
import qualified GHC.Stack as GHC
type HasCallStack = (?callStack :: GHC.CallStack)
#else
import GHC.Exts (Constraint)
type HasCallStack = (() :: Constraint)
#endif

{- |
'traversed' traverses any 'Traversable' container (list, vector, @Map@, 'Maybe', you name it):

>>> Just 1 ^.. traversed
[1]

'traversed' is the same as 'traverse', but can be faster thanks to magic rewrite rules.
-}
traversed :: Traversable f => Traversal (f a) (f b) a b
traversed :: Traversal (f a) (f b) a b
traversed = (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE [0] traversed #-}

{-# RULES
"traversed -> mapped"
  traversed = sets fmap :: Functor f => ASetter (f a) (f b) a b;
"traversed -> folded"
  traversed = folded :: Foldable f => Getting (Endo r) (f a) a;
  #-}

{- |
'folded' is a fold for anything 'Foldable'. In a way, it's an opposite of
'mapped' – the most powerful getter, but can't be used as a setter.
-}
folded :: Foldable f => SimpleFold (f a) a
folded :: SimpleFold (f a) a
folded = ((a -> Const r a -> Const r a) -> Const r a -> f a -> Const r a)
-> (a -> Const r a) -> f a -> Const r (f a)
forall r a s b t.
Monoid r =>
((a -> Const r a -> Const r a) -> Const r a -> s -> Const r a)
-> (a -> Const r b) -> s -> Const r t
foldring (a -> Const r a -> Const r a) -> Const r a -> f a -> Const r a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
{-# INLINE folded #-}

foldring :: Monoid r => ((a -> Const r a -> Const r a) -> Const r a -> s -> Const r a) -> (a -> Const r b) -> s -> Const r t
foldring :: ((a -> Const r a -> Const r a) -> Const r a -> s -> Const r a)
-> (a -> Const r b) -> s -> Const r t
foldring (a -> Const r a -> Const r a) -> Const r a -> s -> Const r a
fr a -> Const r b
f = Const r a -> Const r t
forall r a b. Const r a -> Const r b
phantom (Const r a -> Const r t) -> (s -> Const r a) -> s -> Const r t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const r a -> Const r a) -> Const r a -> s -> Const r a
fr (\a
a Const r a
fa -> a -> Const r b
f a
a Const r b -> Const r a -> Const r a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Const r a
fa) Const r a
forall r a. Monoid r => Const r a
noEffect
{-# INLINE foldring #-}

foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf Getting (Endo r) s a
l a -> r -> r
f r
z = (Endo r -> r -> r) -> r -> Endo r -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo r -> r -> r
forall a. Endo a -> a -> a
appEndo r
z (Endo r -> r) -> (s -> Endo r) -> s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo r) s a -> (a -> Endo r) -> s -> Endo r
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (Endo r) s a
l ((r -> r) -> Endo r
forall a. (a -> a) -> Endo a
Endo ((r -> r) -> Endo r) -> (a -> r -> r) -> a -> Endo r
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> r -> r
f)
{-# INLINE foldrOf #-}

foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting r s a
l a -> r
f = Const r s -> r
forall a k (b :: k). Const a b -> a
getConst (Const r s -> r) -> (s -> Const r s) -> s -> r
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting r s a
l (r -> Const r a
forall k a (b :: k). a -> Const a b
Const (r -> Const r a) -> (a -> r) -> a -> Const r a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> r
f)
{-# INLINE foldMapOf #-}

{- |
'sets' creates an 'ASetter' from an ordinary function. (The only thing it does is wrapping and unwrapping 'Identity'.)
-}
sets :: ((a -> b) -> s -> t) -> ASetter s t a b
sets :: ((a -> b) -> s -> t) -> ASetter s t a b
sets (a -> b) -> s -> t
f a -> Identity b
g = t -> Identity t
forall a. a -> Identity a
Identity (t -> Identity t) -> (s -> t) -> s -> Identity t
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. (a -> b) -> s -> t
f (Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> (a -> Identity b) -> a -> b
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> Identity b
g)
{-# INLINE sets #-}

------------------------------------------------------------------------------
-- Control.Lens.Internal.Getter
------------------------------------------------------------------------------

-- was renamed from “coerce”
phantom :: Const r a -> Const r b
phantom :: Const r a -> Const r b
phantom = r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (Const r a -> r) -> Const r a -> Const r b
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Const r a -> r
forall a k (b :: k). Const a b -> a
getConst
{-# INLINE phantom #-}

noEffect :: Monoid r => Const r a
noEffect :: Const r a
noEffect = Const r () -> Const r a
forall r a b. Const r a -> Const r b
phantom (() -> Const r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE noEffect #-}

------------------------------------------------------------------------------
-- classes
------------------------------------------------------------------------------

class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
  {- |
'each' tries to be a universal 'Traversal' – it behaves like 'traversed' in most situations, but also adds support for e.g. tuples with same-typed values:

>>> (1,2) & each %~ succ
(2,3)

>>> ["x", "y", "z"] ^. each
"xyz"

However, note that 'each' doesn't work on /every/ instance of 'Traversable'. If you have a 'Traversable' which isn't supported by 'each', you can use 'traversed' instead. Personally, I like using 'each' instead of 'traversed' whenever possible – it's shorter and more descriptive.

You can use 'each' with these things:

@
'each' :: 'Traversal' [a] [b] a b

'each' :: 'Traversal' ('Maybe' a) ('Maybe' b) a b
'each' :: 'Traversal' ('Either' a a) ('Either' b b) a b  -- since 0.4.11

'each' :: 'Traversal' (a,a) (b,b) a b
'each' :: 'Traversal' (a,a,a) (b,b,b) a b
'each' :: 'Traversal' (a,a,a,a) (b,b,b,b) a b
'each' :: 'Traversal' (a,a,a,a,a) (b,b,b,b,b) a b

'each' :: ('RealFloat' a, 'RealFloat' b) => 'Traversal' ('Complex' a) ('Complex' b) a b
@

You can also use 'each' with types from <http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, and <http://hackage.haskell.org/package/containers containers> by using <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, or additionally with types from <http://hackage.haskell.org/package/vector vector>, <http://hackage.haskell.org/package/text text>, and <http://hackage.haskell.org/package/unordered-containers unordered-containers> by using <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
  -}
  each :: Traversal s t a b

instance (a~b, q~r) => Each (a,b) (q,r) a q where
  each :: (a -> f q) -> (a, b) -> f (q, r)
each a -> f q
f ~(a
a,b
b) = (,) (q -> q -> (q, q)) -> f q -> f (q -> (q, q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f q
f a
a f (q -> (q, q)) -> f q -> f (q, q)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
b
b
  {-# INLINE each #-}

instance (a~b, a~c, q~r, q~s) => Each (a,b,c) (q,r,s) a q where
  each :: (a -> f q) -> (a, b, c) -> f (q, r, s)
each a -> f q
f ~(a
a,b
b,c
c) = (,,) (q -> q -> q -> (q, q, q)) -> f q -> f (q -> q -> (q, q, q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f q
f a
a f (q -> q -> (q, q, q)) -> f q -> f (q -> (q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
b
b f (q -> (q, q, q)) -> f q -> f (q, q, q)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
c
c
  {-# INLINE each #-}

instance (a~b, a~c, a~d, q~r, q~s, q~t) => Each (a,b,c,d) (q,r,s,t) a q where
  each :: (a -> f q) -> (a, b, c, d) -> f (q, r, s, t)
each a -> f q
f ~(a
a,b
b,c
c,d
d) = (,,,) (q -> q -> q -> q -> (q, q, q, q))
-> f q -> f (q -> q -> q -> (q, q, q, q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f q
f a
a f (q -> q -> q -> (q, q, q, q))
-> f q -> f (q -> q -> (q, q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
b
b f (q -> q -> (q, q, q, q)) -> f q -> f (q -> (q, q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
c
c f (q -> (q, q, q, q)) -> f q -> f (q, q, q, q)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
d
d
  {-# INLINE each #-}

instance (a~b, a~c, a~d, a~e, q~r, q~s, q~t, q~u) => Each (a,b,c,d,e) (q,r,s,t,u) a q where
  each :: (a -> f q) -> (a, b, c, d, e) -> f (q, r, s, t, u)
each a -> f q
f ~(a
a,b
b,c
c,d
d,e
e) = (,,,,) (q -> q -> q -> q -> q -> (q, q, q, q, q))
-> f q -> f (q -> q -> q -> q -> (q, q, q, q, q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f q
f a
a f (q -> q -> q -> q -> (q, q, q, q, q))
-> f q -> f (q -> q -> q -> (q, q, q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
b
b f (q -> q -> q -> (q, q, q, q, q))
-> f q -> f (q -> q -> (q, q, q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
c
c f (q -> q -> (q, q, q, q, q)) -> f q -> f (q -> (q, q, q, q, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
d
d f (q -> (q, q, q, q, q)) -> f q -> f (q, q, q, q, q)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f q
f a
e
e
  {-# INLINE each #-}

instance Each (Complex a) (Complex b) a b where
  each :: (a -> f b) -> Complex a -> f (Complex b)
each a -> f b
f (a
a :+ a
b) = b -> b -> Complex b
forall a. a -> a -> Complex a
(:+) (b -> b -> Complex b) -> f b -> f (b -> Complex b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> Complex b) -> f b -> f (Complex b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b
  {-# INLINE each #-}

instance Each [a] [b] a b where
  each :: (a -> f b) -> [a] -> f [b]
each = (a -> f b) -> [a] -> f [b]
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
  {-# INLINE each #-}

instance Each (Maybe a) (Maybe b) a b where
  each :: (a -> f b) -> Maybe a -> f (Maybe b)
each = (a -> f b) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
  {-# INLINE each #-}

{- |
@since 0.4.11
-}
instance (a~a', b~b') => Each (Either a a') (Either b b') a b where
  each :: (a -> f b) -> Either a a' -> f (Either b b')
each a -> f b
f (Left a
a)   = b -> Either b b'
forall a b. a -> Either a b
Left (b -> Either b b') -> f b -> f (Either b b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  each a -> f b
f (Right a'
a ) = b -> Either b b
forall a b. b -> Either a b
Right (b -> Either b b) -> f b -> f (Either b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a'
a
  {-# INLINE each #-}

#if __GLASGOW_HASKELL__ >= 800
instance Each (NonEmpty a) (NonEmpty b) a b where
  each :: (a -> f b) -> NonEmpty a -> f (NonEmpty b)
each = (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
  {-# INLINE each #-}
#endif

-- NOTE: when adding new instances of 'Each', update the docs for 'each'.

#if MIN_VERSION_base(4,9,0)
type family Index (s :: Type) :: Type
type family IxValue (m :: Type) :: Type
#else
type family Index (s :: *) :: *
type family IxValue (m :: *) :: *
#endif

type instance Index   (e -> a) = e
type instance IxValue (e -> a) = a
type instance Index   [a] = Int
type instance IxValue [a] = a

#if __GLASGOW_HASKELL__ >= 800
type instance Index   (NonEmpty a) = Int
type instance IxValue (NonEmpty a) = a
#endif

class Ixed m where
  {- |
This traversal lets you access (and update) an arbitrary element in a list, array, @Map@, etc. (If you want to insert or delete elements as well, look at 'at'.)

An example for lists:

>>> [0..5] & ix 3 .~ 10
[0,1,2,10,4,5]

You can use it for getting, too:

>>> [0..5] ^? ix 3
Just 3

Of course, the element may not be present (which means that you can use 'ix' as a safe variant of ('!!')):

>>> [0..5] ^? ix 10
Nothing

Another useful instance is the one for functions – it lets you modify their outputs for specific inputs. For instance, here's 'maximum' that returns 0 when the list is empty (instead of throwing an exception):

@
maximum0 = 'maximum' 'Lens.Micro.&' 'ix' [] 'Lens.Micro..~' 0
@

The following instances are provided in this package:

#if __GLASGOW_HASKELL__ >= 800
@
'ix' :: 'Int' -> 'Traversal'' [a] a

'ix' :: 'Int' -> 'Traversal'' (NonEmpty a) a

'ix' :: ('Eq' e) => e -> 'Traversal'' (e -> a) a
@
#else
@
'ix' :: 'Int' -> 'Traversal'' [a] a

'ix' :: ('Eq' e) => e -> 'Traversal'' (e -> a) a
@
#endif

You can also use 'ix' with types from <http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, and <http://hackage.haskell.org/package/containers containers> by using <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, or additionally with types from <http://hackage.haskell.org/package/vector vector>, <http://hackage.haskell.org/package/text text>, and <http://hackage.haskell.org/package/unordered-containers unordered-containers> by using <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
  -}
  ix :: Index m -> Traversal' m (IxValue m)

class Ixed m => At m where
  {- |
This lens lets you read, write, or delete elements in @Map@-like structures. It returns 'Nothing' when the value isn't found, just like @lookup@:

@
Data.Map.lookup k m = m 'Lens.Micro.^.' at k
@

However, it also lets you insert and delete values by setting the value to @'Just' value@ or 'Nothing':

@
Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Just a

Data.Map.delete k m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Nothing
@

Or you could use ('Lens.Micro.?~') instead of ('Lens.Micro..~'):

@
Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro.?~' a
@

Note that 'at' doesn't work for arrays or lists. You can't delete an arbitrary element from an array (what would be left in its place?), and you can't set an arbitrary element in a list because if the index is out of list's bounds, you'd have to somehow fill the stretch between the last element and the element you just inserted (i.e. @[1,2,3] & at 10 .~ 5@ is undefined). If you want to modify an already existing value in an array or list, you should use 'ix' instead.

'at' is often used with 'Lens.Micro.non'. See the documentation of 'Lens.Micro.non' for examples.

Note that 'at' isn't strict for @Map@, even if you're using @Data.Map.Strict@:

>>> Data.Map.Strict.size (Data.Map.Strict.empty & at 1 .~ Just undefined)
1

The reason for such behavior is that there's actually no “strict @Map@” type; @Data.Map.Strict@ just provides some strict functions for ordinary @Map@s.

This package doesn't actually provide any instances for 'at', but there are instances for @Map@ and @IntMap@ in <http://hackage.haskell.org/package/microlens-ghc microlens-ghc> and an instance for @HashMap@ in <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
  -}
  at :: Index m -> Lens' m (Maybe (IxValue m))

ixAt :: At m => Index m -> Traversal' m (IxValue m)
ixAt :: Index m -> Traversal' m (IxValue m)
ixAt Index m
i = Index m -> Lens' m (Maybe (IxValue m))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
i ((Maybe (IxValue m) -> f (Maybe (IxValue m))) -> m -> f m)
-> ((IxValue m -> f (IxValue m))
    -> Maybe (IxValue m) -> f (Maybe (IxValue m)))
-> (IxValue m -> f (IxValue m))
-> m
-> f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IxValue m -> f (IxValue m))
-> Maybe (IxValue m) -> f (Maybe (IxValue m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE ixAt #-}

instance Eq e => Ixed (e -> a) where
  ix :: Index (e -> a) -> Traversal' (e -> a) (IxValue (e -> a))
ix Index (e -> a)
e IxValue (e -> a) -> f (IxValue (e -> a))
p e -> a
f = (\a
a e
e' -> if e
Index (e -> a)
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
e' then a
a else e -> a
f e
e') (a -> e -> a) -> f a -> f (e -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (e -> a) -> f (IxValue (e -> a))
p (e -> a
f e
Index (e -> a)
e)
  {-# INLINE ix #-}

instance Ixed [a] where
  ix :: Index [a] -> Traversal' [a] (IxValue [a])
ix Index [a]
k IxValue [a] -> f (IxValue [a])
f [a]
xs0 | Int
Index [a]
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs0
             | Bool
otherwise = [a] -> Int -> f [a]
go [a]
xs0 Int
Index [a]
k where
    go :: [a] -> Int -> f [a]
go [] Int
_ = [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (a
a:[a]
as) Int
0 = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) (a -> [a]) -> f a -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue [a] -> f (IxValue [a])
f a
IxValue [a]
a
    go (a
a:[a]
as) Int
i = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> Int -> f [a]
go [a]
as (Int -> f [a]) -> Int -> f [a]
forall a b. (a -> b) -> a -> b
$! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  {-# INLINE ix #-}

#if __GLASGOW_HASKELL__ >= 800
instance Ixed (NonEmpty a) where
  ix :: Index (NonEmpty a)
-> Traversal' (NonEmpty a) (IxValue (NonEmpty a))
ix Index (NonEmpty a)
k IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f NonEmpty a
xs0 | Int
Index (NonEmpty a)
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = NonEmpty a -> f (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
xs0
             | Bool
otherwise = NonEmpty a -> Int -> f (NonEmpty a)
go NonEmpty a
xs0 Int
Index (NonEmpty a)
k where
    go :: NonEmpty a -> Int -> f (NonEmpty a)
go (a
a:|[a]
as) Int
0 = (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[a]
as) (a -> NonEmpty a) -> f a -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f a
IxValue (NonEmpty a)
a
    go (a
a:|[a]
as) Int
i = (a
aa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index [a] -> (IxValue [a] -> f (IxValue [a])) -> [a] -> f [a]
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IxValue [a] -> f (IxValue [a])
IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f [a]
as
  {-# INLINE ix #-}
#endif

class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  {- |
Gives access to the 1st field of a tuple (up to 5-tuples).

Getting the 1st component:

>>> (1,2,3,4,5) ^. _1
1

Setting the 1st component:

>>> (1,2,3) & _1 .~ 10
(10,2,3)

Note that this lens is lazy, and can set fields even of 'undefined':

>>> set _1 10 undefined :: (Int, Int)
(10,*** Exception: Prelude.undefined

This is done to avoid violating a lens law stating that you can get back what you put:

>>> view _1 . set _1 10 $ (undefined :: (Int, Int))
10

The implementation (for 2-tuples) is:

@
'_1' f t = (,) '<$>' f    ('fst' t)
             '<*>' 'pure' ('snd' t)
@

or, alternatively,

@
'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a
@

(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).

'_2', '_3', '_4', and '_5' are also available (see below).
  -}
  _1 :: Lens s t a b

instance Field1 (a,b) (a',b) a a' where
  _1 :: (a -> f a') -> (a, b) -> f (a', b)
_1 a -> f a'
k ~(a
a,b
b) = (\a'
a' -> (a'
a',b
b)) (a' -> (a', b)) -> f a' -> f (a', b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c) (a',b,c) a a' where
  _1 :: (a -> f a') -> (a, b, c) -> f (a', b, c)
_1 a -> f a'
k ~(a
a,b
b,c
c) = (\a'
a' -> (a'
a',b
b,c
c)) (a' -> (a', b, c)) -> f a' -> f (a', b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d) (a',b,c,d) a a' where
  _1 :: (a -> f a') -> (a, b, c, d) -> f (a', b, c, d)
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d) = (\a'
a' -> (a'
a',b
b,c
c,d
d)) (a' -> (a', b, c, d)) -> f a' -> f (a', b, c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where
  _1 :: (a -> f a') -> (a, b, c, d, e) -> f (a', b, c, d, e)
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e)) (a' -> (a', b, c, d, e)) -> f a' -> f (a', b, c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

{-

instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where
  _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where
  _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where
  _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where
  _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a
  {-# INLINE _1 #-}

-}

class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _2 :: Lens s t a b

instance Field2 (a,b) (a,b') b b' where
  _2 :: (b -> f b') -> (a, b) -> f (a, b')
_2 b -> f b'
k ~(a
a,b
b) = (\b'
b' -> (a
a,b'
b')) (b' -> (a, b')) -> f b' -> f (a, b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c) (a,b',c) b b' where
  _2 :: (b -> f b') -> (a, b, c) -> f (a, b', c)
_2 b -> f b'
k ~(a
a,b
b,c
c) = (\b'
b' -> (a
a,b'
b',c
c)) (b' -> (a, b', c)) -> f b' -> f (a, b', c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d) (a,b',c,d) b b' where
  _2 :: (b -> f b') -> (a, b, c, d) -> f (a, b', c, d)
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d) = (\b'
b' -> (a
a,b'
b',c
c,d
d)) (b' -> (a, b', c, d)) -> f b' -> f (a, b', c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where
  _2 :: (b -> f b') -> (a, b, c, d, e) -> f (a, b', c, d, e)
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e)) (b' -> (a, b', c, d, e)) -> f b' -> f (a, b', c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

{-

instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where
  _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where
  _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where
  _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where
  _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b
  {-# INLINE _2 #-}

-}

class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _3 :: Lens s t a b

instance Field3 (a,b,c) (a,b,c') c c' where
  _3 :: (c -> f c') -> (a, b, c) -> f (a, b, c')
_3 c -> f c'
k ~(a
a,b
b,c
c) = (\c'
c' -> (a
a,b
b,c'
c')) (c' -> (a, b, c')) -> f c' -> f (a, b, c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d) (a,b,c',d) c c' where
  _3 :: (c -> f c') -> (a, b, c, d) -> f (a, b, c', d)
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d) = (\c'
c' -> (a
a,b
b,c'
c',d
d)) (c' -> (a, b, c', d)) -> f c' -> f (a, b, c', d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where
  _3 :: (c -> f c') -> (a, b, c, d, e) -> f (a, b, c', d, e)
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e)) (c' -> (a, b, c', d, e)) -> f c' -> f (a, b, c', d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

{-

instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where
  _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where
  _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where
  _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where
  _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c
  {-# INLINE _3 #-}

-}

class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _4 :: Lens s t a b

instance Field4 (a,b,c,d) (a,b,c,d') d d' where
  _4 :: (d -> f d') -> (a, b, c, d) -> f (a, b, c, d')
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d) = (\d'
d' -> (a
a,b
b,c
c,d'
d')) (d' -> (a, b, c, d')) -> f d' -> f (a, b, c, d')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where
  _4 :: (d -> f d') -> (a, b, c, d, e) -> f (a, b, c, d', e)
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e)) (d' -> (a, b, c, d', e)) -> f d' -> f (a, b, c, d', e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

{-

instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where
  _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where
  _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where
  _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where
  _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d
  {-# INLINE _4 #-}

-}

class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _5 :: Lens s t a b

instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where
  _5 :: (e -> f e') -> (a, b, c, d, e) -> f (a, b, c, d, e')
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e')) (e' -> (a, b, c, d, e')) -> f e' -> f (a, b, c, d, e')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

{-

instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where
  _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where
  _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where
  _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where
  _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e
  {-# INLINE _5 #-}

-}

class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _Cons :: Traversal s t (a,s) (b,t)

instance Cons [a] [b] a b where
  _Cons :: ((a, [a]) -> f (b, [b])) -> [a] -> f [b]
_Cons (a, [a]) -> f (b, [b])
f (a
a:[a]
as) = (b -> [b] -> [b]) -> (b, [b]) -> [b]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((b, [b]) -> [b]) -> f (b, [b]) -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, [a]) -> f (b, [b])
f (a
a, [a]
as)
  _Cons (a, [a]) -> f (b, [b])
_ []     = [b] -> f [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  {-# INLINE _Cons #-}

class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _Snoc :: Traversal s t (s,a) (t,b)

instance Snoc [a] [b] a b where
  _Snoc :: (([a], a) -> f ([b], b)) -> [a] -> f [b]
_Snoc ([a], a) -> f ([b], b)
_ [] = [b] -> f [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  _Snoc ([a], a) -> f ([b], b)
f [a]
xs = (\([b]
as,b
a) -> [b]
as [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b
a]) (([b], b) -> [b]) -> f ([b], b) -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a], a) -> f ([b], b)
f ([a] -> [a]
forall a. [a] -> [a]
init [a]
xs, [a] -> a
forall a. [a] -> a
last [a]
xs)
  {-# INLINE _Snoc #-}

class Strict lazy strict | lazy -> strict, strict -> lazy where
  {- |
'strict' lets you convert between strict and lazy versions of a datatype:

>>> let someText = "hello" :: Lazy.Text
>>> someText ^. strict
"hello" :: Strict.Text

It can also be useful if you have a function that works on a strict type but your type is lazy:

@
stripDiacritics :: Strict.Text -> Strict.Text
stripDiacritics = ...
@

>>> let someText = "Paul Erdős" :: Lazy.Text
>>> someText & strict %~ stripDiacritics
"Paul Erdos" :: Lazy.Text

'strict' works on @ByteString@ and @StateT@\/@WriterT@\/@RWST@ if you use <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, and additionally on @Text@ if you use <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
  -}
  strict :: Lens' lazy strict

  {- |
'lazy' is like 'strict' but works in opposite direction:

>>> let someText = "hello" :: Strict.Text
>>> someText ^. lazy
"hello" :: Lazy.Text
  -}
  lazy   :: Lens' strict lazy

----------------------------------------------------------------------------
-- Coerce compatibility shim
----------------------------------------------------------------------------

#if __GLASGOW_HASKELL__ < 708
coerce :: a -> b
coerce = unsafeCoerce
{-# INLINE coerce #-}
#endif

----------------------------------------------------------------------------
-- Coerce-like composition
----------------------------------------------------------------------------

-- Note: 'lens' defines a type-restricted version of (#.) to work around a
-- bug, but our version is restricted enough that we don't need it. See
-- <https://github.com/ekmett/lens/commit/cde2fc39c0dba413d1a6f814b47bd14431a5e339>

#if __GLASGOW_HASKELL__ >= 708
( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
( #. ) b -> c
_ = (b -> b) -> a -> b
coerce (\b
x -> b
x :: b) :: forall a b. Coercible b a => a -> b

( .# ) :: Coercible b a => (b -> c) -> (a -> b) -> (a -> c)
( .# ) b -> c
pbc a -> b
_ = (b -> c) -> a -> c
coerce b -> c
pbc
#else
( #. ) :: (b -> c) -> (a -> b) -> (a -> c)
( #. ) _ = unsafeCoerce

( .# ) :: (b -> c) -> (a -> b) -> (a -> c)
( .# ) pbc _ = unsafeCoerce pbc
#endif

{-# INLINE ( #. ) #-}
{-# INLINE ( .# ) #-}

infixr 9 #.
infixl 8 .#