{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Text.Lazy.Lens
( packed, unpacked
, _Text
, text
, builder
, utf8
, pattern Text
) where
import Control.Lens.Type
import Control.Lens.Getter
import Control.Lens.Fold
import Control.Lens.Iso
import Control.Lens.Prism
import Control.Lens.Review
import Control.Lens.Setter
import Control.Lens.Traversal
import Data.ByteString.Lazy (ByteString)
import Data.Monoid
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as Text
import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lazy.Builder (Builder)
import Data.Text.Lazy.Encoding
packed :: Iso' String Text
packed :: Iso' String Text
packed = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso String -> Text
Text.pack Text -> String
Text.unpack
{-# INLINE packed #-}
unpacked :: Iso' Text String
unpacked :: Iso' Text String
unpacked = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Text -> String
Text.unpack String -> Text
Text.pack
{-# INLINE unpacked #-}
_Text :: Iso' Text String
_Text :: Iso' Text String
_Text = forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' String Text
packed
{-# INLINE _Text #-}
builder :: Iso' Text Builder
builder :: Iso' Text Builder
builder = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Text -> Builder
Builder.fromLazyText Builder -> Text
Builder.toLazyText
{-# INLINE builder #-}
text :: IndexedTraversal' Int Text Char
text :: IndexedTraversal' Int Text Char
text = Iso' Text String
unpacked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE [0] text #-}
{-# RULES
"lazy text -> map" text = sets Text.map :: ASetter' Text Char;
"lazy text -> imap" text = isets imapLazy :: AnIndexedSetter' Int Text Char;
"lazy text -> foldr" text = foldring Text.foldr :: Getting (Endo r) Text Char;
"lazy text -> ifoldr" text = ifoldring ifoldrLazy :: IndexedGetting Int (Endo r) Text Char;
#-}
imapLazy :: (Int -> Char -> Char) -> Text -> Text
imapLazy :: (Int -> Char -> Char) -> Text -> Text
imapLazy Int -> Char -> Char
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
Text.mapAccumL (\Int
i Char
a -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i forall a. Num a => a -> a -> a
+ Int
1, Int -> Char -> Char
f Int
i Char
a)) Int
0
{-# INLINE imapLazy #-}
ifoldrLazy :: (Int -> Char -> a -> a) -> a -> Text -> a
ifoldrLazy :: forall a. (Int -> Char -> a -> a) -> a -> Text -> a
ifoldrLazy Int -> Char -> a -> a
f a
z Text
xs = forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\ Char
x Int -> a
g Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const a
z) Text
xs Int
0
{-# INLINE ifoldrLazy #-}
utf8 :: Prism' ByteString Text
utf8 :: Prism' ByteString Text
utf8 = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> ByteString
encodeUtf8 (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall c a b. Prism (Either c a) (Either c b) a b
_Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8')
{-# INLINE utf8 #-}
pattern Text :: String -> Text
pattern $bText :: String -> Text
$mText :: forall {r}. Text -> (String -> r) -> ((# #) -> r) -> r
Text a <- (view _Text -> a) where
Text String
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' Text String
_Text String
a