-- |
-- Module: Data.Text.Lazy.Optics
-- Description: Optics for working with lazy 'Text.Text'.
--
-- This module provides 'Iso's for converting lazy 'Text.Text' to or from a
-- 'String' or 'Builder', and an 'IxTraversal' for traversing the individual
-- characters of a 'Text.Text'.
--
-- If you need to work with both strict and lazy text, "Data.Text.Optics"
-- provides combinators that support both varieties using a typeclass.
--
module Data.Text.Lazy.Optics
  ( packed
  , unpacked
  , _Text
  , text
  , builder
  , utf8
  , pattern Text
  ) where

import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as Text
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Encoding as TE

import Data.Profunctor.Indexed

import Optics.Core
import Optics.Internal.Fold
import Optics.Internal.IxFold
import Optics.Internal.IxTraversal
import Optics.Internal.Optic

-- $setup
-- >>> import Data.ByteString.Lazy as LBS

-- | This isomorphism can be used to 'pack' (or 'unpack') lazy 'Text.Text'.
--
-- >>> "hello" ^. packed -- :: Text
-- "hello"
--
-- @
-- 'pack' x ≡ x 'Optics.Operators.^.' 'packed'
-- 'unpack' x ≡ x 'Optics.Operators.^.' 're' 'packed'
-- 'packed' ≡ 're' 'unpacked'
-- @
packed :: Iso' String Text
packed :: Iso' String Text
packed = (String -> Text) -> (Text -> String) -> Iso' String 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 #-}

-- | This isomorphism can be used to 'unpack' (or 'pack') lazy 'Text.Text'.
--
-- >>> Text.pack "hello" ^. unpacked -- :: String
-- "hello"
--
-- @
-- 'pack' x ≡ x 'Optics.Operators.^.' 're' 'unpacked'
-- 'unpack' x ≡ x 'Optics.Operators.^.' 'packed'
-- @
--
-- This 'Iso' is provided for notational convenience rather than out of great
-- need, since
--
-- @
-- 'unpacked' ≡ 're' 'packed'
-- @
unpacked :: Iso' Text String
unpacked :: Iso' Text String
unpacked = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) Text Text String String)
-> Iso' Text String
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic__ p i i Text Text String String
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ An_Iso p i (Curry NoIx i) Text Text String String
unpacked__
{-# INLINE unpacked #-}

-- | This is an alias for 'unpacked' that makes it clearer how to use it with
-- @('Optics.Operators.#')@.
--
-- @
-- '_Text' = 're' 'packed'
-- @
--
-- >>> _Text # "hello" -- :: Text
-- "hello"
_Text :: Iso' Text String
_Text :: Iso' Text String
_Text = Iso' String Text
-> Optic (ReversedOptic An_Iso) NoIx Text Text String String
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Iso' String Text
packed
{-# INLINE _Text #-}

-- | Convert between lazy 'Text.Text' and 'Builder' .
--
-- @
-- 'fromLazyText' x ≡ x 'Optics.Operators.^.' 'builder'
-- 'toLazyText' x ≡ x 'Optics.Operators.^.' 're' 'builder'
-- @
builder :: Iso' Text B.Builder
builder :: Iso' Text Builder
builder = (Text -> Builder) -> (Builder -> Text) -> Iso' Text Builder
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Text -> Builder
B.fromLazyText Builder -> Text
B.toLazyText
{-# INLINE builder #-}

-- | Traverse the individual characters in a 'Text.Text'.
--
-- >>> anyOf text (=='c') $ Text.pack "chello"
-- True
--
-- @
-- 'text' = 'unpacked' % 'traversed'
-- @
--
-- When the type is unambiguous, you can also use the more general 'each'.
--
-- @
-- 'text' ≡ 'each'
-- @
--
-- Note that when just using this as a 'Setter', @'sets' 'Data.Text.Lazy.map'@
-- can be more efficient.
text :: IxTraversal' Int Text Char
text :: IxTraversal' Int Text Char
text = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Traversal p i (Curry (WithIx Int) i) Text Text Char Char)
-> IxTraversal' Int Text Char
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Traversal p i (Curry (WithIx Int) i) Text Text Char Char
forall (p :: * -> * -> * -> *) j.
Traversing p =>
Optic__ p j (Int -> j) Text Text Char Char
text__
{-# INLINE text #-}

-- | Encode\/Decode a lazy 'Text.Text' to\/from lazy 'ByteString', via UTF-8.
--
-- Note: This function does not decode lazily, as it must consume the entire
-- input before deciding whether or not it fails.
--
-- >>> LBS.unpack (utf8 # Text.pack "☃")
-- [226,152,131]
utf8 :: Prism' ByteString Text
utf8 :: Prism' ByteString Text
utf8 = (Text -> ByteString)
-> (ByteString -> Maybe Text) -> Prism' ByteString Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> ByteString
TE.encodeUtf8 (Optic' A_Prism NoIx (Either UnicodeException Text) Text
-> Either UnicodeException Text -> Maybe Text
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx (Either UnicodeException Text) Text
forall a b c. Prism (Either a b) (Either a c) b c
_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
TE.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 = Iso' Text String -> String -> Text
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Iso' Text String
_Text String
a

----------------------------------------
-- Internal implementations

-- | Internal implementation of 'unpacked'.
unpacked__ :: Profunctor p => Optic__ p i i Text Text String String
unpacked__ :: Optic__ p i i Text Text String String
unpacked__ = (Text -> String)
-> (String -> Text) -> Optic__ p i i Text Text String String
forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap Text -> String
Text.unpack String -> Text
Text.pack
{-# INLINE unpacked__ #-}

-- | Internal implementation of 'text'.
text__ :: Traversing p => Optic__ p j (Int -> j) Text Text Char Char
text__ :: Optic__ p j (Int -> j) Text Text Char Char
text__ = Optic__ p (Int -> j) (Int -> j) Text Text String String
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic__ p i i Text Text String String
unpacked__ Optic__ p (Int -> j) (Int -> j) Text Text String String
-> (p j Char Char -> p (Int -> j) String String)
-> Optic__ p j (Int -> j) Text Text Char Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p j Char Char -> p (Int -> j) String String
forall (p :: * -> * -> * -> *) i (f :: * -> *) j a b.
(Traversing p, TraversableWithIndex i f) =>
Optic__ p j (i -> j) (f a) (f b) a b
itraversed__
{-# INLINE [0] text__ #-}

{-# RULES

"lazy text__ -> foldr"
  forall (o :: Forget r j Char Char). text__ o = foldring__ Text.foldr (reForget o)
    :: Forget r (Int -> j) Text Text

"lazy text__ -> ifoldr"
  forall (o :: IxForget r j Char Char). text__ o = ifoldring__ ifoldrLazy o
    :: IxForget r (Int -> j) Text Text

"lazy text__ -> map"
  forall (o :: FunArrow j Char Char). text__ o
                                    = roam Text.map (reFunArrow o)
    :: FunArrow (Int -> j) Text Text

"lazy text__ -> imap"
  forall (o :: IxFunArrow j Char Char). text__ o = iroam imapLazy o
    :: IxFunArrow (Int -> j) Text Text

#-}

-- | Indexed fold for 'text__'.
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
i Int -> 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 #-}

-- | Indexed setter for 'text__'.
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 #-}