{-# 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
(
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 (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 (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 (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 (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 (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 Forest 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 -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
a' Forest a
as
go (Key
i:[Key]
is) t :: Tree a
t@(Node a
a Forest a
as)
| Key
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = Tree a -> f (Tree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree a
t
| Bool
otherwise = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
a (Forest a -> Tree a) -> f (Forest a) -> f (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Forest a)
-> (IxValue (Forest a) -> f (IxValue (Forest a)))
-> Forest a
-> f (Forest a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index (Forest a)
i ([Key] -> Tree a -> f (Tree a)
go [Key]
is) Forest 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 (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 (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 (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 (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 (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
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 (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 :: (a -> f b) -> Map c a -> f (Map d b)
each = (a -> f b) -> Map c a -> f (Map d 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 :: (a -> f b) -> IntMap a -> f (IntMap b)
each = (a -> f b) -> IntMap a -> f (IntMap 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 :: (a -> f b) -> Seq a -> f (Seq b)
each = (a -> f b) -> Seq a -> f (Seq 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 :: (a -> f b) -> Tree a -> f (Tree b)
each = (a -> f b) -> Tree a -> f (Tree 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 :: (a -> f b) -> Array i a -> f (Array j b)
each a -> f b
f Array i a
arr = (i, i) -> [(i, b)] -> Array i b
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Array i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i a
arr) ([(i, b)] -> Array i b) -> f [(i, b)] -> f (Array i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((i, a) -> f (i, b)) -> [(i, a)] -> f [(i, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(i
i,a
a) -> (,) i
i (b -> (i, b)) -> f b -> f (i, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) (Array i a -> [(i, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs Array i 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 :: (a -> f b) -> UArray i a -> f (UArray j b)
each a -> f b
f UArray i a
arr = (i, i) -> [(i, b)] -> UArray i b
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (UArray i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i a
arr) ([(i, b)] -> UArray i b) -> f [(i, b)] -> f (UArray i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((i, a) -> f (i, b)) -> [(i, a)] -> f [(i, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(i
i,a
a) -> (,) i
i (b -> (i, b)) -> f b -> f (i, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) (UArray i a -> [(i, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs UArray i a
arr)
{-# INLINE each #-}
instance (a ~ Word8, b ~ Word8) => Each B.ByteString B.ByteString a b where
each :: (a -> f b) -> ByteString -> f ByteString
each = (a -> f b) -> ByteString -> f ByteString
Traversal' ByteString Word8
traversedStrictTree
{-# INLINE each #-}
instance (a ~ Word8, b ~ Word8) => Each BL.ByteString BL.ByteString a b where
each :: (a -> f b) -> ByteString -> f ByteString
each = (a -> f b) -> ByteString -> f ByteString
Traversal' ByteString Word8
traversedLazy
{-# INLINE each #-}
instance Cons (Seq a) (Seq b) a b where
_Cons :: ((a, Seq a) -> f (b, Seq b)) -> Seq a -> f (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 (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 :: ((Seq a, a) -> f (Seq b, b)) -> Seq a -> f (Seq 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 (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 :: ((Word8, ByteString) -> f (Word8, ByteString))
-> ByteString -> f 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 (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
B.empty
{-# INLINE _Cons #-}
instance Cons BL.ByteString BL.ByteString Word8 Word8 where
_Cons :: ((Word8, ByteString) -> f (Word8, ByteString))
-> ByteString -> f 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 (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BL.empty
{-# INLINE _Cons #-}
instance Snoc B.ByteString B.ByteString Word8 Word8 where
_Snoc :: ((ByteString, Word8) -> f (ByteString, Word8))
-> ByteString -> f ByteString
_Snoc (ByteString, Word8) -> f (ByteString, Word8)
f ByteString
s = if ByteString -> Bool
B.null ByteString
s
then ByteString -> f ByteString
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 (ByteString -> ByteString
B.init ByteString
s, ByteString -> Word8
B.last ByteString
s)
{-# INLINE _Snoc #-}
instance Snoc BL.ByteString BL.ByteString Word8 Word8 where
_Snoc :: ((ByteString, Word8) -> f (ByteString, Word8))
-> ByteString -> f ByteString
_Snoc (ByteString, Word8) -> f (ByteString, Word8)
f ByteString
s = if ByteString -> Bool
BL.null ByteString
s
then ByteString -> f ByteString
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 (ByteString -> ByteString
BL.init ByteString
s, ByteString -> Word8
BL.last ByteString
s)
{-# INLINE _Snoc #-}
instance Strict BL.ByteString B.ByteString where
strict :: (ByteString -> f ByteString) -> ByteString -> f 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 :: (ByteString -> f ByteString) -> ByteString -> f 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 :: (StateT s m a -> f (StateT s m a))
-> StateT s m a -> f (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 :: (StateT s m a -> f (StateT s m a))
-> StateT s m a -> f (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 :: (WriterT w m a -> f (WriterT w m a))
-> WriterT w m a -> f (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 :: (WriterT w m a -> f (WriterT w m a))
-> WriterT w m a -> f (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 :: (RWST r w s m a -> f (RWST r w s m a))
-> RWST r w s m a -> f (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 :: (RWST r w s m a -> f (RWST r w s m a))
-> RWST r w s m a -> f (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 #-}