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

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

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


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

By importing this module you get all functions and types from <http://hackage.haskell.org/package/microlens microlens>, as well as the following instances:

* 'at' for 'Map', 'Set', 'IntMap' and 'IntSet'

* 'ix' for

    * 'Map', 'Set', 'IntMap' and 'IntSet'
    * 'Array' and 'UArray'
    * 'Seq'
    * strict 'B.ByteString' and lazy 'BL.ByteString'
    * 'Tree'
    
* 'each' for the same as above, excluding 'Set' and 'IntSet'

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

    * 'Seq'
    * strict and lazy bytestrings

* 'strict' and 'lazy' for

    * bytestrings
    * @StateT@, @WriterT@, @RWST@
-}
module Lens.Micro.GHC
(
  module Lens.Micro,
  packedBytes, unpackedBytes,
  packedChars, unpackedChars,
  chars,
)
where


import Lens.Micro
import Lens.Micro.Internal
import Lens.Micro.GHC.Internal

import qualified Data.Map as Map
import           Data.Map (Map)
import qualified Data.IntMap as IntMap
import           Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import           Data.Sequence (Seq)
import qualified Data.Set as Set
import           Data.Set (Set)
import qualified Data.IntSet as IntSet
import           Data.IntSet (IntSet)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict

import Data.Tree
import Data.Array.IArray as Array
import Data.Array.Unboxed

import Data.Int
import Data.Word

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


type instance Index   (Map k a) = k
type instance IxValue (Map k a) = a
type instance Index   (IntMap a) = Int
type instance IxValue (IntMap a) = a
type instance Index   (Set a) = a
type instance IxValue (Set a) = ()
type instance Index   IntSet = Int
type instance IxValue IntSet = ()
type instance Index   (Seq a) = Int
type instance IxValue (Seq a) = a
type instance Index   (Tree a) = [Int]
type instance IxValue (Tree a) = a
type instance Index   (Array.Array i e) = i
type instance IxValue (Array.Array i e) = e
type instance Index   (UArray i e) = i
type instance IxValue (UArray i e) = e
type instance Index   B.ByteString = Int
type instance IxValue B.ByteString = Word8
type instance Index   BL.ByteString = Int64
type instance IxValue BL.ByteString = Word8

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

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

instance Ixed (Seq a) where
  ix :: Index (Seq a) -> Traversal' (Seq a) (IxValue (Seq a))
ix Index (Seq a)
i IxValue (Seq a) -> f (IxValue (Seq a))
f Seq a
m
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Seq a)
i Bool -> Bool -> Bool
&& Key
Index (Seq a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Key
forall a. Seq a -> Key
Seq.length Seq a
m = IxValue (Seq a) -> f (IxValue (Seq a))
f (Seq a -> Key -> a
forall a. Seq a -> Key -> a
Seq.index Seq a
m Key
Index (Seq a)
i) f a -> (a -> Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Key -> a -> Seq a -> Seq a
forall a. Key -> a -> Seq a -> Seq a
Seq.update Key
Index (Seq a)
i a
a Seq a
m
    | Bool
otherwise                  = Seq a -> f (Seq a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
m
  {-# INLINE ix #-}

instance Ord k => Ixed (Set k) where
  ix :: Index (Set k) -> Traversal' (Set k) (IxValue (Set k))
ix Index (Set k)
k IxValue (Set k) -> f (IxValue (Set k))
f Set k
m = if k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
Index (Set k)
k Set k
m
     then IxValue (Set k) -> f (IxValue (Set k))
f () f () -> (() -> Set k) -> f (Set k)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \() -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
Index (Set k)
k Set k
m
     else Set k -> f (Set k)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set k
m
  {-# INLINE ix #-}

instance Ixed IntSet where
  ix :: Index IntSet -> Traversal' IntSet (IxValue IntSet)
ix Index IntSet
k IxValue IntSet -> f (IxValue IntSet)
f IntSet
m = if Key -> IntSet -> Bool
IntSet.member Key
Index IntSet
k IntSet
m
     then IxValue IntSet -> f (IxValue IntSet)
f () f () -> (() -> IntSet) -> f IntSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \() -> Key -> IntSet -> IntSet
IntSet.insert Key
Index IntSet
k IntSet
m
     else IntSet -> f IntSet
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntSet
m
  {-# INLINE ix #-}

instance Ixed (Tree a) where
  ix :: Index (Tree a) -> Traversal' (Tree a) (IxValue (Tree a))
ix Index (Tree a)
xs0 IxValue (Tree a) -> f (IxValue (Tree a))
f = [Key] -> Tree a -> f (Tree a)
go [Key]
Index (Tree a)
xs0 where
    go :: [Key] -> Tree a -> f (Tree a)
go [] (Node a
a [Tree a]
as) = IxValue (Tree a) -> f (IxValue (Tree a))
f a
IxValue (Tree a)
a f a -> (a -> Tree a) -> f (Tree a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a' -> a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a' [Tree a]
as
    go (Key
i:[Key]
is) t :: Tree a
t@(Node a
a [Tree a]
as)
      | Key
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0     = Tree a -> f (Tree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree a
t
      | Bool
otherwise = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a ([Tree a] -> Tree a) -> f [Tree a] -> f (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index [Tree a] -> Traversal' [Tree a] (IxValue [Tree a])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index [Tree a]
i ([Key] -> Tree a -> f (Tree a)
go [Key]
is) [Tree a]
as
  {-# INLINE ix #-}

instance Ix i => Ixed (Array.Array i e) where
  ix :: Index (Array i e) -> Traversal' (Array i e) (IxValue (Array i e))
ix Index (Array i e)
i IxValue (Array i e) -> f (IxValue (Array i e))
f Array i e
arr
    | (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array i e -> (i, i)
forall i. Ix i => Array i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i e
arr) i
Index (Array i e)
i = IxValue (Array i e) -> f (IxValue (Array i e))
f (Array i e
arr Array i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! i
Index (Array i e)
i) f e -> (e -> Array i e) -> f (Array i e)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> Array i e
arr Array i e -> [(i, e)] -> Array i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(i
Index (Array i e)
i,e
e)]
    | Bool
otherwise              = Array i e -> f (Array i e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array i e
arr
  {-# INLINE ix #-}

instance (IArray UArray e, Ix i) => Ixed (UArray i e) where
  ix :: Index (UArray i e)
-> Traversal' (UArray i e) (IxValue (UArray i e))
ix Index (UArray i e)
i IxValue (UArray i e) -> f (IxValue (UArray i e))
f UArray i e
arr
    | (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (UArray i e -> (i, i)
forall i. Ix i => UArray i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i e
arr) i
Index (UArray i e)
i = IxValue (UArray i e) -> f (IxValue (UArray i e))
f (UArray i e
arr UArray i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! i
Index (UArray i e)
i) f e -> (e -> UArray i e) -> f (UArray i e)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> UArray i e
arr UArray i e -> [(i, e)] -> UArray i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(i
Index (UArray i e)
i,e
e)]
    | Bool
otherwise              = UArray i e -> f (UArray i e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UArray i e
arr
  {-# INLINE ix #-}

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

instance Ixed BL.ByteString where
  -- TODO: we could be lazier, returning each chunk as it is passed
  ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString)
ix Index ByteString
e IxValue ByteString -> f (IxValue ByteString)
f ByteString
s = case Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt Int64
Index ByteString
e ByteString
s of
     (ByteString
l, ByteString
mr) -> case ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
mr of
       Maybe (Word8, ByteString)
Nothing      -> ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
       Just (Word8
c, ByteString
xs) -> IxValue ByteString -> f (IxValue ByteString)
f Word8
IxValue ByteString
c f Word8 -> (Word8 -> ByteString) -> f ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
d -> ByteString -> ByteString -> ByteString
BL.append ByteString
l (Word8 -> ByteString -> ByteString
BL.cons Word8
d ByteString
xs)
  {-# INLINE ix #-}

instance At (IntMap a) where
#if MIN_VERSION_containers(0,5,8)
  at :: Index (IntMap a) -> Lens' (IntMap a) (Maybe (IxValue (IntMap a)))
at Index (IntMap a)
k Maybe (IxValue (IntMap a)) -> f (Maybe (IxValue (IntMap a)))
f = (Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe a -> f (Maybe a)
Maybe (IxValue (IntMap a)) -> f (Maybe (IxValue (IntMap a)))
f Key
Index (IntMap a)
k
#else
  at k f m = f mv <&> \r -> case r of
    Nothing -> maybe m (const (IntMap.delete k m)) mv
    Just v' -> IntMap.insert k v' m
    where mv = IntMap.lookup k m
#endif
  {-# INLINE at #-}

instance Ord k => At (Map k a) where
#if MIN_VERSION_containers(0,5,8)
  at :: Index (Map k a) -> Lens' (Map k a) (Maybe (IxValue (Map k a)))
at Index (Map k a)
k Maybe (IxValue (Map k a)) -> f (Maybe (IxValue (Map k a)))
f = (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe a -> f (Maybe a)
Maybe (IxValue (Map k a)) -> f (Maybe (IxValue (Map k a)))
f k
Index (Map k a)
k
#else
  at k f m = f mv <&> \r -> case r of
    Nothing -> maybe m (const (Map.delete k m)) mv
    Just v' -> Map.insert k v' m
    where mv = Map.lookup k m
#endif
  {-# INLINE at #-}

instance At IntSet where
  at :: Index IntSet -> Lens' IntSet (Maybe (IxValue IntSet))
at Index IntSet
k Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f IntSet
m = Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f Maybe ()
Maybe (IxValue IntSet)
mv f (Maybe ()) -> (Maybe () -> IntSet) -> f IntSet
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ()
r -> case Maybe ()
r of
    Maybe ()
Nothing -> IntSet -> (() -> IntSet) -> Maybe () -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
m (IntSet -> () -> IntSet
forall a b. a -> b -> a
const (Key -> IntSet -> IntSet
IntSet.delete Key
Index IntSet
k IntSet
m)) Maybe ()
mv
    Just () -> Key -> IntSet -> IntSet
IntSet.insert Key
Index IntSet
k IntSet
m
    where mv :: Maybe ()
mv = if Key -> IntSet -> Bool
IntSet.member Key
Index IntSet
k IntSet
m then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing
  {-# INLINE at #-}

instance Ord k => At (Set k) where
  at :: Index (Set k) -> Lens' (Set k) (Maybe (IxValue (Set k)))
at Index (Set k)
k Maybe (IxValue (Set k)) -> f (Maybe (IxValue (Set k)))
f Set k
m = Maybe (IxValue (Set k)) -> f (Maybe (IxValue (Set k)))
f Maybe ()
Maybe (IxValue (Set k))
mv f (Maybe ()) -> (Maybe () -> Set k) -> f (Set k)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ()
r -> case Maybe ()
r of
    Maybe ()
Nothing -> Set k -> (() -> Set k) -> Maybe () -> Set k
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set k
m (Set k -> () -> Set k
forall a b. a -> b -> a
const (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.delete k
Index (Set k)
k Set k
m)) Maybe ()
mv
    Just () -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
Index (Set k)
k Set k
m
    where mv :: Maybe ()
mv = if k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
Index (Set k)
k Set k
m then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing
  {-# INLINE at #-}

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

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

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

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

instance (Ix i, i ~ j) => Each (Array i a) (Array j b) a b where
  each :: Traversal (Array i a) (Array j b) a b
each a -> f b
f Array i a
arr = (j, j) -> [(j, b)] -> Array j b
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Array j a -> (j, j)
forall i. Ix i => Array i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i a
Array j a
arr) ([(j, b)] -> Array j b) -> f [(j, b)] -> f (Array j b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((j, a) -> f (j, b)) -> [(j, a)] -> f [(j, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(j
i,a
a) -> (,) j
i (b -> (j, b)) -> f b -> f (j, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) (Array j a -> [(j, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs Array i a
Array j a
arr)
  {-# INLINE each #-}

instance (Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b where
  each :: Traversal (UArray i a) (UArray j b) a b
each a -> f b
f UArray i a
arr = (j, j) -> [(j, b)] -> UArray j b
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (UArray j a -> (j, j)
forall i. Ix i => UArray i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i a
UArray j a
arr) ([(j, b)] -> UArray j b) -> f [(j, b)] -> f (UArray j b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((j, a) -> f (j, b)) -> [(j, a)] -> f [(j, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(j
i,a
a) -> (,) j
i (b -> (j, b)) -> f b -> f (j, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) (UArray j a -> [(j, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs UArray i a
UArray j a
arr)
  {-# INLINE each #-}

instance (a ~ Word8, b ~ Word8) => Each B.ByteString B.ByteString a b where
  each :: Traversal ByteString ByteString a b
each = (a -> f b) -> ByteString -> f ByteString
(Word8 -> f Word8) -> ByteString -> f ByteString
Traversal' ByteString Word8
traversedStrictTree
  {-# INLINE each #-}

instance (a ~ Word8, b ~ Word8) => Each BL.ByteString BL.ByteString a b where
  each :: Traversal ByteString ByteString a b
each = (a -> f b) -> ByteString -> f ByteString
(Word8 -> f Word8) -> ByteString -> f ByteString
Traversal' ByteString Word8
traversedLazy
  {-# INLINE each #-}

instance Cons (Seq a) (Seq b) a b where
  _Cons :: Traversal (Seq a) (Seq b) (a, Seq a) (b, Seq b)
_Cons (a, Seq a) -> f (b, Seq b)
f Seq a
s = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
s of
    a
x Seq.:< Seq a
xs -> (b -> Seq b -> Seq b) -> (b, Seq b) -> Seq b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
(Seq.<|) ((b, Seq b) -> Seq b) -> f (b, Seq b) -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Seq a) -> f (b, Seq b)
f (a
x, Seq a
xs)
    ViewL a
Seq.EmptyL  -> Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq b
forall a. Seq a
Seq.empty
  {-# INLINE _Cons #-}

instance Snoc (Seq a) (Seq b) a b where
  _Snoc :: Traversal (Seq a) (Seq b) (Seq a, a) (Seq b, b)
_Snoc (Seq a, a) -> f (Seq b, b)
f Seq a
s = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
s of
    Seq a
xs Seq.:> a
x -> (Seq b -> b -> Seq b) -> (Seq b, b) -> Seq b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
(Seq.|>) ((Seq b, b) -> Seq b) -> f (Seq b, b) -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq a, a) -> f (Seq b, b)
f (Seq a
xs, a
x)
    ViewR a
Seq.EmptyR  -> Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq b
forall a. Seq a
Seq.empty
  {-# INLINE _Snoc #-}

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

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

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

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

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

instance Strict (Lazy.StateT s m a) (Strict.StateT s m a) where
  strict :: Lens' (StateT s m a) (StateT s m a)
strict StateT s m a -> f (StateT s m a)
f StateT s m a
s = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (StateT s m a -> StateT s m a)
-> f (StateT s m a) -> f (StateT s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               StateT s m a -> f (StateT s m a)
f ((s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
s))
  {-# INLINE strict #-}
  lazy :: Lens' (StateT s m a) (StateT s m a)
lazy StateT s m a -> f (StateT s m a)
f StateT s m a
s = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (StateT s m a -> StateT s m a)
-> f (StateT s m a) -> f (StateT s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             StateT s m a -> f (StateT s m a)
f ((s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
s))
  {-# INLINE lazy #-}

instance Strict (Lazy.WriterT w m a) (Strict.WriterT w m a) where
  strict :: Lens' (WriterT w m a) (WriterT w m a)
strict WriterT w m a -> f (WriterT w m a)
f WriterT w m a
s = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (WriterT w m a -> WriterT w m a)
-> f (WriterT w m a) -> f (WriterT w m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               WriterT w m a -> f (WriterT w m a)
f (m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
s))
  {-# INLINE strict #-}
  lazy :: Lens' (WriterT w m a) (WriterT w m a)
lazy WriterT w m a -> f (WriterT w m a)
f WriterT w m a
s = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (WriterT w m a -> WriterT w m a)
-> f (WriterT w m a) -> f (WriterT w m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             WriterT w m a -> f (WriterT w m a)
f (m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
s))
  {-# INLINE lazy #-}

instance Strict (Lazy.RWST r w s m a) (Strict.RWST r w s m a) where
  strict :: Lens' (RWST r w s m a) (RWST r w s m a)
strict RWST r w s m a -> f (RWST r w s m a)
f RWST r w s m a
s = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> RWST r w s m a
-> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (RWST r w s m a -> RWST r w s m a)
-> f (RWST r w s m a) -> f (RWST r w s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               RWST r w s m a -> f (RWST r w s m a)
f ((r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST (RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
s))
  {-# INLINE strict #-}
  lazy :: Lens' (RWST r w s m a) (RWST r w s m a)
lazy RWST r w s m a -> f (RWST r w s m a)
f RWST r w s m a
s = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> RWST r w s m a
-> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (RWST r w s m a -> RWST r w s m a)
-> f (RWST r w s m a) -> f (RWST r w s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             RWST r w s m a -> f (RWST r w s m a)
f ((r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST (RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
s))
  {-# INLINE lazy #-}