{-# 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 :: p Text (f Text) -> p String (f String)
packed = (String -> Text) -> (Text -> String) -> Iso String String Text Text
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 :: p String (f String) -> p Text (f Text)
unpacked = (Text -> String) -> (String -> Text) -> Iso Text Text String String
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 :: p String (f String) -> p Text (f Text)
_Text = AnIso String String Text Text -> Iso Text Text String String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String Text Text
Iso String String Text Text
packed
{-# INLINE _Text #-}
builder :: Iso' Text Builder
builder :: p Builder (f Builder) -> p Text (f Text)
builder = (Text -> Builder)
-> (Builder -> Text) -> Iso Text 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 :: p Char (f Char) -> Text -> f Text
text = (String -> f String) -> Text -> f Text
Iso Text Text String String
unpacked ((String -> f String) -> Text -> f Text)
-> (p Char (f Char) -> String -> f String)
-> p Char (f Char)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Char (f Char) -> String -> f String
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 = (Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Text -> (Int, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> (Int, Char)) -> Int -> Text -> (Int, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
Text.mapAccumL (\Int
i Char
a -> Int
i Int -> (Int, Char) -> (Int, Char)
`seq` (Int
i Int -> Int -> Int
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 :: (Int -> Char -> a -> a) -> a -> Text -> a
ifoldrLazy Int -> Char -> a -> a
f a
z Text
xs = (Char -> (Int -> a) -> Int -> a) -> (Int -> a) -> Text -> Int -> a
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\ Char
x Int -> a
g Int
i -> Int
i Int -> a -> a
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (a -> Int -> a
forall a b. a -> b -> a
const a
z) Text
xs Int
0
{-# INLINE ifoldrLazy #-}
utf8 :: Prism' ByteString Text
utf8 :: p Text (f Text) -> p ByteString (f ByteString)
utf8 = (Text -> ByteString)
-> (ByteString -> Maybe Text)
-> Prism ByteString ByteString Text Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> ByteString
encodeUtf8 (Getting (First Text) (Either UnicodeException Text) Text
-> Either UnicodeException Text -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) (Either UnicodeException Text) Text
forall c a b. Prism (Either c a) (Either c b) a b
_Right (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
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) -> (Void# -> r) -> r
Text a <- (view _Text -> a) where
Text String
a = AReview Text String -> String -> Text
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Text String
Iso Text Text String String
_Text String
a