{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Text.Lazy.Lens
-- Copyright   :  (C) 2012-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
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

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Lens
-- >>> import qualified Data.ByteString.Lazy as ByteString

-- | This isomorphism can be used to 'pack' (or 'unpack') lazy 'Text'.
--
-- >>> "hello"^.packed -- :: Text
-- "hello"
--
-- @
-- 'pack' x ≡ x '^.' 'packed'
-- 'unpack' x ≡ x '^.' 'from' 'packed'
-- 'packed' ≡ 'from' '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'.
--
-- >>> "hello"^.unpacked -- :: String
-- "hello"
--
-- @
-- 'pack' x ≡ x '^.' 'from' 'unpacked'
-- 'unpack' x ≡ x '^.' 'packed'
-- @
--
-- This 'Iso' is provided for notational convenience rather than out of great need, since
--
-- @
-- 'unpacked' ≡ 'from' 'packed'
-- @
unpacked :: Iso' Text String
unpacked :: Iso' Text String
unpacked = (Text -> String) -> (String -> Text) -> Iso' Text 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 #-}

-- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@.
--
-- @
-- '_Text' = 'from' 'packed'
-- @
--
-- >>> _Text # "hello" -- :: Text
-- "hello"
_Text :: Iso' Text String
_Text :: Iso' Text String
_Text = AnIso String String Text Text -> Iso' Text String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String Text Text
Iso' String Text
packed
{-# INLINE _Text #-}

-- | Convert between lazy 'Text' and 'Builder' .
--
-- @
-- 'fromLazyText' x ≡ x '^.' 'builder'
-- 'toLazyText' x ≡ x '^.' 'from' 'builder'
-- @
builder :: Iso' Text 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
Builder.fromLazyText Builder -> Text
Builder.toLazyText
{-# INLINE builder #-}

-- | Traverse the individual characters in a 'Text'.
--
-- >>> anyOf text (=='c') "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', @'setting' 'Data.Text.Lazy.map'@
-- can be more efficient.
text :: IndexedTraversal' Int Text Char
text :: IndexedTraversal' Int Text Char
text = (String -> f String) -> Text -> f Text
Iso' Text 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
IndexedTraversal Int String String Char Char
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)
forall a b. a -> b -> b
`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 :: forall a. (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
forall a b. a -> b -> b
`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 #-}

-- | Encode\/Decode a lazy '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.
--
-- >>> ByteString.unpack (utf8 # "☃")
-- [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
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 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c 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 $mText :: forall {r}. Text -> (String -> r) -> ((# #) -> r) -> r
$bText :: String -> Text
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 String
_Text String
a