{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#endif
module Data.Text.Lazy.Lens
( packed, unpacked
, _Text
, text
, builder
, utf8
#if __GLASGOW_HASKELL__ >= 710
, pattern Text
#endif
) where
import Control.Lens.Type
import Control.Lens.Getter
import Control.Lens.Fold
import Control.Lens.Iso
import Control.Lens.Prism
#if __GLASGOW_HASKELL__ >= 710
import Control.Lens.Review
#endif
import Control.Lens.Setter
import Control.Lens.Traversal
import Data.ByteString.Lazy as ByteString
import Data.Monoid
import Data.Text.Lazy as Text
import Data.Text.Lazy.Builder
import Data.Text.Lazy.Encoding
packed :: Iso' String Text
packed = iso Text.pack Text.unpack
{-# INLINE packed #-}
unpacked :: Iso' Text String
unpacked = iso Text.unpack Text.pack
{-# INLINE unpacked #-}
_Text :: Iso' Text String
_Text = from packed
{-# INLINE _Text #-}
builder :: Iso' Text Builder
builder = iso fromLazyText toLazyText
{-# INLINE builder #-}
text :: IndexedTraversal' Int Text Char
text = unpacked . 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 f = snd . Text.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0
{-# INLINE imapLazy #-}
ifoldrLazy :: (Int -> Char -> a -> a) -> a -> Text -> a
ifoldrLazy f z xs = Text.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0
{-# INLINE ifoldrLazy #-}
utf8 :: Prism' ByteString Text
utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8')
{-# INLINE utf8 #-}
#if __GLASGOW_HASKELL__ >= 710
pattern Text a <- (view _Text -> a) where
Text a = review _Text a
#endif