{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Trustworthy #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif


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

This module is an approximation for @<http://hackage.haskell.org/package/lens/docs/Control-Lens.html Control.Lens>@ from <http://hackage.haskell.org/package/lens lens>; by importing it you get all functions and instances from <http://hackage.haskell.org/package/microlens microlens>, <http://hackage.haskell.org/package/microlens-mtl microlens-mtl>, <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, as well as the following instances:

* 'at' for 'HashMap'

* 'each' and 'ix' for

    * 'HashMap'
    * 'Vector.Vector' and variants (unboxed vectors, etc)
    * strict 'T.Text' and lazy 'TL.Text'

* '_head', '_tail', '_init', '_last' for

    * 'Vector.Vector' and variants
    * strict and lazy @Text@

* 'strict' and 'lazy' for @Text@
-}
module Lens.Micro.Platform
(
  module Lens.Micro,
  module Lens.Micro.GHC,
  module Lens.Micro.Mtl,
  module Lens.Micro.TH,
  packed, unpacked,
)
where


import Lens.Micro.Internal
import Lens.Micro
import Lens.Micro.GHC
import Lens.Micro.Mtl
import Lens.Micro.TH
import Lens.Micro.Platform.Internal

import Data.Hashable
import Data.Int
import Data.Monoid

import Data.HashMap.Lazy as HashMap
import Data.Vector as Vector
import Data.Vector.Primitive as Prim
import Data.Vector.Storable as Storable
import Data.Vector.Unboxed as Unboxed
import Data.Vector.Generic as Generic

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif


type instance Index   (HashMap k a) = k
type instance IxValue (HashMap k a) = a
type instance Index   (Vector.Vector a) = Int
type instance IxValue (Vector.Vector a) = a
type instance Index   (Prim.Vector a) = Int
type instance IxValue (Prim.Vector a) = a
type instance Index   (Storable.Vector a) = Int
type instance IxValue (Storable.Vector a) = a
type instance Index   (Unboxed.Vector a) = Int
type instance IxValue (Unboxed.Vector a) = a
type instance Index   T.Text = Int
type instance IxValue T.Text = Char
type instance Index   TL.Text = Int64
type instance IxValue TL.Text = Char

instance (Eq k, Hashable k) => Ixed (HashMap k a) where
  ix :: Index (HashMap k a)
-> Traversal' (HashMap k a) (IxValue (HashMap k a))
ix Index (HashMap k a)
k IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f HashMap k a
m = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Index (HashMap k a)
k HashMap k a
m of
     Just a
v  -> IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f a
v forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Index (HashMap k a)
k a
v' HashMap k a
m
     Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k a
m
  {-# INLINE ix #-}

instance (Eq k, Hashable k) => At (HashMap k a) where
  at :: Index (HashMap k a)
-> Lens' (HashMap k a) (Maybe (IxValue (HashMap k a)))
at Index (HashMap k a)
k Maybe (IxValue (HashMap k a)) -> f (Maybe (IxValue (HashMap k a)))
f HashMap k a
m = Maybe (IxValue (HashMap k a)) -> f (Maybe (IxValue (HashMap k a)))
f Maybe a
mv forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe a
r -> case Maybe a
r of
    Maybe a
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k a
m (forall a b. a -> b -> a
const (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Index (HashMap k a)
k HashMap k a
m)) Maybe a
mv
    Just a
v' -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Index (HashMap k a)
k a
v' HashMap k a
m
    where mv :: Maybe a
mv = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Index (HashMap k a)
k HashMap k a
m
  {-# INLINE at #-}

instance Ixed (Vector.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Int
0 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
Vector.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Vector a -> Int -> a
Vector.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Vector a -> [(Int, a)] -> Vector a
Vector.// [(Index (Vector a)
i, a
a)]
    | Bool
otherwise                     = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

instance Prim a => Ixed (Prim.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Int
0 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Prim a => Vector a -> Int
Prim.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Prim a => Vector a -> Int -> a
Prim.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Prim a => Vector a -> [(Int, a)] -> Vector a
Prim.// [(Index (Vector a)
i, a
a)]
    | Bool
otherwise                   = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

instance Storable a => Ixed (Storable.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Int
0 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Storable a => Vector a -> Int
Storable.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Storable a => Vector a -> Int -> a
Storable.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Storable a => Vector a -> [(Int, a)] -> Vector a
Storable.// [(Index (Vector a)
i, a
a)]
    | Bool
otherwise                       = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

instance Unbox a => Ixed (Unboxed.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Int
0 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Unbox a => Vector a -> Int
Unboxed.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Unbox a => Vector a -> Int -> a
Unboxed.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
Unboxed.// [(Index (Vector a)
i, a
a)]
    | Bool
otherwise                      = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

instance Ixed T.Text where
  ix :: Index Text -> Traversal' Text (IxValue Text)
ix Index Text
e IxValue Text -> f (IxValue Text)
f Text
s = case Int -> Text -> (Text, Text)
T.splitAt Index Text
e Text
s of
     (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
T.uncons Text
mr of
       Maybe (Char, Text)
Nothing      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
       Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
c forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Char
d -> [Text] -> Text
T.concat [Text
l, Char -> Text
T.singleton Char
d, Text
xs]
  {-# INLINE ix #-}

instance Ixed TL.Text where
  ix :: Index Text -> Traversal' Text (IxValue Text)
ix Index Text
e IxValue Text -> f (IxValue Text)
f Text
s = case Int64 -> Text -> (Text, Text)
TL.splitAt Index Text
e Text
s of
     (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
TL.uncons Text
mr of
       Maybe (Char, Text)
Nothing      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
       Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
c forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Char
d -> Text -> Text -> Text
TL.append Text
l (Char -> Text -> Text
TL.cons Char
d Text
xs)
  {-# INLINE ix #-}

instance Cons T.Text T.Text Char Char where
  _Cons :: Traversal Text Text (Char, Text) (Char, Text)
_Cons (Char, Text) -> f (Char, Text)
f Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
    Just (Char, Text)
x  -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char, Text) -> f (Char, Text)
f (Char, Text)
x
    Maybe (Char, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty
  {-# INLINE _Cons #-}

instance Cons TL.Text TL.Text Char Char where
  _Cons :: Traversal Text Text (Char, Text) (Char, Text)
_Cons (Char, Text) -> f (Char, Text)
f Text
s = case Text -> Maybe (Char, Text)
TL.uncons Text
s of
    Just (Char, Text)
x  -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
TL.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char, Text) -> f (Char, Text)
f (Char, Text)
x
    Maybe (Char, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
TL.empty
  {-# INLINE _Cons #-}

instance Snoc T.Text T.Text Char Char where
  _Snoc :: Traversal Text Text (Text, Char) (Text, Char)
_Snoc (Text, Char) -> f (Text, Char)
f Text
s = if Text -> Bool
T.null Text
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
T.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, Char) -> f (Text, Char)
f (Text -> Text
T.init Text
s, Text -> Char
T.last Text
s)
  {-# INLINE _Snoc #-}

instance Snoc TL.Text TL.Text Char Char where
  _Snoc :: Traversal Text Text (Text, Char) (Text, Char)
_Snoc (Text, Char) -> f (Text, Char)
f Text
s = if Text -> Bool
TL.null Text
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
TL.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
TL.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, Char) -> f (Text, Char)
f (Text -> Text
TL.init Text
s, Text -> Char
TL.last Text
s)
  {-# INLINE _Snoc #-}

instance Cons (Vector.Vector a) (Vector.Vector b) a b where
  _Cons :: Traversal (Vector a) (Vector b) (a, Vector a) (b, Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if forall a. Vector a -> Bool
Vector.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Vector a
Vector.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Vector a -> Vector a
Vector.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (forall a. Vector a -> a
Vector.unsafeHead Vector a
s, forall a. Vector a -> Vector a
Vector.unsafeTail Vector a
s)
  {-# INLINE _Cons #-}

instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where
  _Cons :: Traversal (Vector a) (Vector b) (a, Vector a) (b, Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if forall a. Prim a => Vector a -> Bool
Prim.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Prim a => Vector a
Prim.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Prim a => a -> Vector a -> Vector a
Prim.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (forall a. Prim a => Vector a -> a
Prim.unsafeHead Vector a
s, forall a. Prim a => Vector a -> Vector a
Prim.unsafeTail Vector a
s)
  {-# INLINE _Cons #-}

instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where
  _Cons :: Traversal (Vector a) (Vector b) (a, Vector a) (b, Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if forall a. Storable a => Vector a -> Bool
Storable.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Storable a => Vector a
Storable.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => a -> Vector a -> Vector a
Storable.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (forall a. Storable a => Vector a -> a
Storable.unsafeHead Vector a
s, forall a. Storable a => Vector a -> Vector a
Storable.unsafeTail Vector a
s)
  {-# INLINE _Cons #-}

instance (Unbox a, Unbox b) => Cons (Unboxed.Vector a) (Unboxed.Vector b) a b where
  _Cons :: Traversal (Vector a) (Vector b) (a, Vector a) (b, Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if forall a. Unbox a => Vector a -> Bool
Unboxed.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Unbox a => Vector a
Unboxed.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Unbox a => a -> Vector a -> Vector a
Unboxed.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (forall a. Unbox a => Vector a -> a
Unboxed.unsafeHead Vector a
s, forall a. Unbox a => Vector a -> Vector a
Unboxed.unsafeTail Vector a
s)
  {-# INLINE _Cons #-}

instance Snoc (Vector.Vector a) (Vector.Vector b) a b where
  _Snoc :: Traversal (Vector a) (Vector b) (Vector a, a) (Vector b, b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if forall a. Vector a -> Bool
Vector.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Vector a
Vector.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Vector a -> a -> Vector a
Vector.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (forall a. Vector a -> Vector a
Vector.unsafeInit Vector a
s, forall a. Vector a -> a
Vector.unsafeLast Vector a
s)
  {-# INLINE _Snoc #-}

instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where
  _Snoc :: Traversal (Vector a) (Vector b) (Vector a, a) (Vector b, b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if forall a. Prim a => Vector a -> Bool
Prim.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Prim a => Vector a
Prim.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Prim a => Vector a -> a -> Vector a
Prim.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (forall a. Prim a => Vector a -> Vector a
Prim.unsafeInit Vector a
s, forall a. Prim a => Vector a -> a
Prim.unsafeLast Vector a
s)
  {-# INLINE _Snoc #-}

instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where
  _Snoc :: Traversal (Vector a) (Vector b) (Vector a, a) (Vector b, b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if forall a. Storable a => Vector a -> Bool
Storable.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Storable a => Vector a
Storable.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => Vector a -> a -> Vector a
Storable.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (forall a. Storable a => Vector a -> Vector a
Storable.unsafeInit Vector a
s, forall a. Storable a => Vector a -> a
Storable.unsafeLast Vector a
s)
  {-# INLINE _Snoc #-}

instance (Unbox a, Unbox b) => Snoc (Unboxed.Vector a) (Unboxed.Vector b) a b where
  _Snoc :: Traversal (Vector a) (Vector b) (Vector a, a) (Vector b, b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if forall a. Unbox a => Vector a -> Bool
Unboxed.null Vector a
s
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Unbox a => Vector a
Unboxed.empty
    else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Unbox a => Vector a -> a -> Vector a
Unboxed.snoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (forall a. Unbox a => Vector a -> Vector a
Unboxed.unsafeInit Vector a
s, forall a. Unbox a => Vector a -> a
Unboxed.unsafeLast Vector a
s)
  {-# INLINE _Snoc #-}

instance Each (Vector.Vector a) (Vector.Vector b) a b where
  each :: Traversal (Vector a) (Vector b) a b
each = forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
Traversal (v a) (w b) a b
vectorTraverse
  {-# INLINE each #-}

instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where
  each :: Traversal (Vector a) (Vector b) a b
each = forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
Traversal (v a) (w b) a b
vectorTraverse
  {-# INLINE each #-}

instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where
  each :: Traversal (Vector a) (Vector b) a b
each = forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
Traversal (v a) (w b) a b
vectorTraverse
  {-# INLINE each #-}

instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where
  each :: Traversal (Vector a) (Vector b) a b
each = forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
Traversal (v a) (w b) a b
vectorTraverse
  {-# INLINE each #-}

instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where
  each :: Traversal (HashMap c a) (HashMap d b) a b
each = forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
  {-# INLINE each #-}

instance (a ~ Char, b ~ Char) => Each T.Text T.Text a b where
  each :: Traversal Text Text a b
each = Traversal' Text Char
strictText
  {-# INLINE each #-}

instance (a ~ Char, b ~ Char) => Each TL.Text TL.Text a b where
  each :: Traversal Text Text a b
each = Traversal' Text Char
lazyText
  {-# INLINE each #-}

strictUnpacked :: Lens' T.Text String
strictUnpacked :: Lens' Text String
strictUnpacked String -> f String
f Text
t = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f (Text -> String
T.unpack Text
t)
{-# INLINE strictUnpacked #-}

strictText :: Traversal' T.Text Char
strictText :: Traversal' Text Char
strictText = Lens' Text String
strictUnpacked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
{-# INLINE [0] strictText #-}

{-# RULES
"strict text -> map"    strictText = sets T.map        :: ASetter' T.Text Char;
"strict text -> foldr"  strictText = foldring T.foldr  :: Getting (Endo r) T.Text Char;
 #-}

lazyUnpacked :: Lens' TL.Text String
lazyUnpacked :: Lens' Text String
lazyUnpacked String -> f String
f Text
t = String -> Text
TL.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f (Text -> String
TL.unpack Text
t)
{-# INLINE lazyUnpacked #-}

lazyText :: Traversal' TL.Text Char
lazyText :: Traversal' Text Char
lazyText = Lens' Text String
lazyUnpacked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed
{-# INLINE [0] lazyText #-}

{-# RULES
"lazy text -> map"    lazyText = sets TL.map        :: ASetter' TL.Text Char;
"lazy text -> foldr"  lazyText = foldring TL.foldr  :: Getting (Endo r) TL.Text Char;
 #-}

vectorTraverse :: (Generic.Vector v a, Generic.Vector w b) => Traversal (v a) (w b) a b
vectorTraverse :: forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
Traversal (v a) (w b) a b
vectorTraverse a -> f b
f v a
v = forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
Generic.fromListN (forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length v a
v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed a -> f b
f (forall (v :: * -> *) a. Vector v a => v a -> [a]
Generic.toList v a
v)
{-# INLINE [0] vectorTraverse #-}

{-# RULES
"vectorTraverse -> mapped" vectorTraverse  = sets Generic.map         :: (Generic.Vector v a, Generic.Vector v b) => ASetter (v a) (v b) a b;
"vectorTraverse -> foldr"  vectorTraverse  = foldring Generic.foldr   :: Generic.Vector v a => Getting (Endo r) (v a) a;
 #-}

instance Strict TL.Text T.Text where
  strict :: Lens' Text Text
strict Text -> f Text
f Text
s = Text -> Text
TL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (Text -> Text
TL.toStrict Text
s)
  {-# INLINE strict #-}
  lazy :: Lens' Text Text
lazy Text -> f Text
f Text
s = Text -> Text
TL.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (Text -> Text
TL.fromStrict Text
s)
  {-# INLINE lazy #-}