{-# 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 k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
Index (HashMap k a)
k HashMap k a
m of
     Just a
v  -> IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f a
IxValue (HashMap k a)
v f a -> (a -> HashMap k a) -> f (HashMap k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
Index (HashMap k a)
k a
v' HashMap k a
m
     Maybe a
Nothing -> HashMap k a -> f (HashMap k a)
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
Maybe (IxValue (HashMap k a))
mv f (Maybe a) -> (Maybe a -> HashMap k a) -> f (HashMap k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe a
r -> case Maybe a
r of
    Maybe a
Nothing -> HashMap k a -> (a -> HashMap k a) -> Maybe a -> HashMap k a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k a
m (HashMap k a -> a -> HashMap k a
forall a b. a -> b -> a
const (k -> HashMap k a -> HashMap k a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete k
Index (HashMap k a)
k HashMap k a
m)) Maybe a
mv
    Just a
v' -> k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
Index (HashMap k a)
k a
v' HashMap k a
m
    where mv :: Maybe a
mv = k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (Vector a)
i Bool -> Bool -> Bool
&& Int
Index (Vector a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
Vector.// [(Int
Index (Vector a)
i, a
a)]
    | Bool
otherwise                     = Vector a -> f (Vector a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (Vector a)
i Bool -> Bool -> Bool
&& Int
Index (Vector a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Prim a => Vector a -> Int
Prim.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Int -> a
forall a. Prim a => Vector a -> Int -> a
Prim.! Int
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Prim a => Vector a -> [(Int, a)] -> Vector a
Prim.// [(Int
Index (Vector a)
i, a
a)]
    | Bool
otherwise                   = Vector a -> f (Vector a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (Vector a)
i Bool -> Bool -> Bool
&& Int
Index (Vector a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Storable a => Vector a -> Int
Storable.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Int -> a
forall a. Storable a => Vector a -> Int -> a
Storable.! Int
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Storable a => Vector a -> [(Int, a)] -> Vector a
Storable.// [(Int
Index (Vector a)
i, a
a)]
    | Bool
otherwise                       = Vector a -> f (Vector a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (Vector a)
i Bool -> Bool -> Bool
&& Int
Index (Vector a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Unbox a => Vector a -> Int
Unboxed.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
Unboxed.! Int
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
Unboxed.// [(Int
Index (Vector a)
i, a
a)]
    | Bool
otherwise                      = Vector a -> f (Vector a)
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 Int
Index Text
e Text
s of
     (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
T.uncons Text
mr of
       Maybe (Char, Text)
Nothing      -> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
       Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
IxValue Text
c f Char -> (Char -> Text) -> f Text
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 Int64
Index Text
e Text
s of
     (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
TL.uncons Text
mr of
       Maybe (Char, Text)
Nothing      -> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
       Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
IxValue Text
c f Char -> (Char -> Text) -> f Text
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 :: ((Char, Text) -> f (Char, Text)) -> Text -> f Text
_Cons (Char, Text) -> f (Char, Text)
f Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
    Just (Char, Text)
x  -> (Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons ((Char, Text) -> Text) -> f (Char, Text) -> f Text
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 -> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty
  {-# INLINE _Cons #-}

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

instance Snoc T.Text T.Text Char Char where
  _Snoc :: ((Text, Char) -> f (Text, Char)) -> Text -> f Text
_Snoc (Text, Char) -> f (Text, Char)
f Text
s = if Text -> Bool
T.null Text
s
    then Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty
    else (Text -> Char -> Text) -> (Text, Char) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
T.snoc ((Text, Char) -> Text) -> f (Text, Char) -> f Text
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 :: ((Text, Char) -> f (Text, Char)) -> Text -> f Text
_Snoc (Text, Char) -> f (Text, Char)
f Text
s = if Text -> Bool
TL.null Text
s
    then Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
TL.empty
    else (Text -> Char -> Text) -> (Text, Char) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
TL.snoc ((Text, Char) -> Text) -> f (Text, Char) -> f Text
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 :: ((a, Vector a) -> f (b, Vector b)) -> Vector a -> f (Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if Vector a -> Bool
forall a. Vector a -> Bool
Vector.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Vector a
Vector.empty
    else (b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
Vector.cons ((b, Vector b) -> Vector b) -> f (b, Vector b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (Vector a -> a
forall a. Vector a -> a
Vector.unsafeHead Vector a
s, Vector a -> Vector a
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 :: ((a, Vector a) -> f (b, Vector b)) -> Vector a -> f (Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if Vector a -> Bool
forall a. Prim a => Vector a -> Bool
Prim.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Prim a => Vector a
Prim.empty
    else (b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Prim a => a -> Vector a -> Vector a
Prim.cons ((b, Vector b) -> Vector b) -> f (b, Vector b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (Vector a -> a
forall a. Prim a => Vector a -> a
Prim.unsafeHead Vector a
s, Vector a -> Vector a
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 :: ((a, Vector a) -> f (b, Vector b)) -> Vector a -> f (Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if Vector a -> Bool
forall a. Storable a => Vector a -> Bool
Storable.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Storable a => Vector a
Storable.empty
    else (b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Storable a => a -> Vector a -> Vector a
Storable.cons ((b, Vector b) -> Vector b) -> f (b, Vector b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (Vector a -> a
forall a. Storable a => Vector a -> a
Storable.unsafeHead Vector a
s, Vector a -> Vector a
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 :: ((a, Vector a) -> f (b, Vector b)) -> Vector a -> f (Vector b)
_Cons (a, Vector a) -> f (b, Vector b)
f Vector a
s = if Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
Unboxed.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Unbox a => Vector a
Unboxed.empty
    else (b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Unbox a => a -> Vector a -> Vector a
Unboxed.cons ((b, Vector b) -> Vector b) -> f (b, Vector b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Vector a) -> f (b, Vector b)
f (Vector a -> a
forall a. Unbox a => Vector a -> a
Unboxed.unsafeHead Vector a
s, Vector a -> Vector a
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 :: ((Vector a, a) -> f (Vector b, b)) -> Vector a -> f (Vector b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if Vector a -> Bool
forall a. Vector a -> Bool
Vector.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Vector a
Vector.empty
    else (Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Vector a -> a -> Vector a
Vector.snoc ((Vector b, b) -> Vector b) -> f (Vector b, b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (Vector a -> Vector a
forall a. Vector a -> Vector a
Vector.unsafeInit Vector a
s, Vector a -> a
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 :: ((Vector a, a) -> f (Vector b, b)) -> Vector a -> f (Vector b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if Vector a -> Bool
forall a. Prim a => Vector a -> Bool
Prim.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Prim a => Vector a
Prim.empty
    else (Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Prim a => Vector a -> a -> Vector a
Prim.snoc ((Vector b, b) -> Vector b) -> f (Vector b, b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (Vector a -> Vector a
forall a. Prim a => Vector a -> Vector a
Prim.unsafeInit Vector a
s, Vector a -> a
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 :: ((Vector a, a) -> f (Vector b, b)) -> Vector a -> f (Vector b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if Vector a -> Bool
forall a. Storable a => Vector a -> Bool
Storable.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Storable a => Vector a
Storable.empty
    else (Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Storable a => Vector a -> a -> Vector a
Storable.snoc ((Vector b, b) -> Vector b) -> f (Vector b, b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
Storable.unsafeInit Vector a
s, Vector a -> a
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 :: ((Vector a, a) -> f (Vector b, b)) -> Vector a -> f (Vector b)
_Snoc (Vector a, a) -> f (Vector b, b)
f Vector a
s = if Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
Unboxed.null Vector a
s
    then Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector b
forall a. Unbox a => Vector a
Unboxed.empty
    else (Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Unbox a => Vector a -> a -> Vector a
Unboxed.snoc ((Vector b, b) -> Vector b) -> f (Vector b, b) -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector a, a) -> f (Vector b, b)
f (Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
Unboxed.unsafeInit Vector a
s, Vector a -> a
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 :: (a -> f b) -> Vector a -> f (Vector b)
each = (a -> f b) -> Vector a -> f (Vector b)
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 :: (a -> f b) -> Vector a -> f (Vector b)
each = (a -> f b) -> Vector a -> f (Vector b)
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 :: (a -> f b) -> Vector a -> f (Vector b)
each = (a -> f b) -> Vector a -> f (Vector b)
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 :: (a -> f b) -> Vector a -> f (Vector b)
each = (a -> f b) -> Vector a -> f (Vector b)
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 :: (a -> f b) -> HashMap c a -> f (HashMap d b)
each = (a -> f b) -> HashMap c a -> f (HashMap d b)
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 :: (a -> f b) -> Text -> f Text
each = (a -> f b) -> Text -> f Text
Traversal' Text Char
strictText
  {-# INLINE each #-}

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

strictUnpacked :: Lens' T.Text String
strictUnpacked :: (String -> f String) -> Text -> f Text
strictUnpacked String -> f String
f Text
t = String -> Text
T.pack (String -> Text) -> f String -> f Text
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 :: (Char -> f Char) -> Text -> f Text
strictText = (String -> f String) -> Text -> f Text
Lens' Text String
strictUnpacked ((String -> f String) -> Text -> f Text)
-> ((Char -> f Char) -> String -> f String)
-> (Char -> f Char)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> f Char) -> String -> f String
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 :: (String -> f String) -> Text -> f Text
lazyUnpacked String -> f String
f Text
t = String -> Text
TL.pack (String -> Text) -> f String -> f Text
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 :: (Char -> f Char) -> Text -> f Text
lazyText = (String -> f String) -> Text -> f Text
Lens' Text String
lazyUnpacked ((String -> f String) -> Text -> f Text)
-> ((Char -> f Char) -> String -> f String)
-> (Char -> f Char)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> f Char) -> String -> f String
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 :: Traversal (v a) (w b) a b
vectorTraverse a -> f b
f v a
v = Int -> [b] -> w b
forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
Generic.fromListN (v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Generic.length v a
v) ([b] -> w b) -> f [b] -> f (w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed a -> f b
f (v a -> [a]
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 :: (Text -> f Text) -> Text -> f Text
strict Text -> f Text
f Text
s = Text -> Text
TL.fromStrict (Text -> Text) -> f Text -> f Text
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 :: (Text -> f Text) -> Text -> f Text
lazy Text -> f Text
f Text
s = Text -> Text
TL.toStrict (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (Text -> Text
TL.fromStrict Text
s)
  {-# INLINE lazy #-}