1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3#if __GLASGOW_HASKELL__ >= 710
4{-# LANGUAGE PatternSynonyms #-}
5{-# LANGUAGE ViewPatterns #-}
6#endif
7-----------------------------------------------------------------------------
8-- |
9-- Module      :  Data.Text.Strict.Lens
10-- Copyright   :  (C) 2012-2016 Edward Kmett
11-- License     :  BSD-style (see the file LICENSE)
12-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
13-- Stability   :  experimental
14-- Portability :  non-portable
15--
16----------------------------------------------------------------------------
17module Data.Text.Strict.Lens
18  ( packed, unpacked
19  , builder
20  , text
21  , utf8
22  , _Text
23#if __GLASGOW_HASKELL__ >= 710
24  , pattern Text
25#endif
26  ) where
27
28import Control.Lens.Type
29import Control.Lens.Getter
30import Control.Lens.Fold
31import Control.Lens.Iso
32import Control.Lens.Prism
33#if __GLASGOW_HASKELL__ >= 710
34import Control.Lens.Review
35#endif
36import Control.Lens.Setter
37import Control.Lens.Traversal
38import Data.ByteString (ByteString)
39import Data.Monoid
40import qualified Data.Text as Strict
41import Data.Text (Text)
42import Data.Text.Encoding
43import Data.Text.Lazy (toStrict)
44import qualified Data.Text.Lazy.Builder as Builder
45import Data.Text.Lazy.Builder (Builder)
46
47-- $setup
48-- >>> :set -XOverloadedStrings
49-- >>> import Control.Lens
50
51-- | This isomorphism can be used to 'pack' (or 'unpack') strict 'Text'.
52--
53--
54-- >>> "hello"^.packed -- :: Text
55-- "hello"
56--
57-- @
58-- 'pack' x ≡ x '^.' 'packed'
59-- 'unpack' x ≡ x '^.' 'from' 'packed'
60-- 'packed' ≡ 'from' 'unpacked'
61-- 'packed' ≡ 'iso' 'pack' 'unpack'
62-- @
63packed :: Iso' String Text
64packed = iso Strict.pack Strict.unpack
65{-# INLINE packed #-}
66
67-- | This isomorphism can be used to 'unpack' (or 'pack') lazy 'Text'.
68--
69-- >>> "hello"^.unpacked -- :: String
70-- "hello"
71--
72-- This 'Iso' is provided for notational convenience rather than out of great need, since
73--
74-- @
75-- 'unpacked' ≡ 'from' 'packed'
76-- @
77--
78-- @
79-- 'pack' x ≡ x '^.' 'from' 'unpacked'
80-- 'unpack' x ≡ x '^.' 'packed'
81-- 'unpacked' ≡ 'iso' 'unpack' 'pack'
82-- @
83unpacked :: Iso' Text String
84unpacked = iso Strict.unpack Strict.pack
85{-# INLINE unpacked #-}
86
87-- | This is an alias for 'unpacked' that makes it more obvious how to use it with '#'
88--
89-- >> _Text # "hello" -- :: Text
90-- "hello"
91_Text :: Iso' Text String
92_Text = unpacked
93{-# INLINE _Text #-}
94
95-- | Convert between strict 'Text' and 'Builder' .
96--
97-- @
98-- 'fromText' x ≡ x '^.' 'builder'
99-- 'toStrict' ('toLazyText' x) ≡ x '^.' 'from' 'builder'
100-- @
101builder :: Iso' Text Builder
102builder = iso Builder.fromText (toStrict . Builder.toLazyText)
103{-# INLINE builder #-}
104
105-- | Traverse the individual characters in strict 'Text'.
106--
107-- >>> anyOf text (=='o') "hello"
108-- True
109--
110-- When the type is unambiguous, you can also use the more general 'each'.
111--
112-- @
113-- 'text' ≡ 'unpacked' . 'traversed'
114-- 'text' ≡ 'each'
115-- @
116--
117-- Note that when just using this as a 'Setter', @'setting' 'Data.Text.map'@ can
118-- be more efficient.
119text :: IndexedTraversal' Int Text Char
120text = unpacked . traversed
121{-# INLINE [0] text #-}
122
123{-# RULES
124"strict text -> map"    text = sets Strict.map        :: ASetter' Text Char;
125"strict text -> imap"   text = isets imapStrict       :: AnIndexedSetter' Int Text Char;
126"strict text -> foldr"  text = foldring Strict.foldr  :: Getting (Endo r) Text Char;
127"strict text -> ifoldr" text = ifoldring ifoldrStrict :: IndexedGetting Int (Endo r) Text Char;
128 #-}
129
130imapStrict :: (Int -> Char -> Char) -> Text -> Text
131imapStrict f = snd . Strict.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0
132{-# INLINE imapStrict #-}
133
134ifoldrStrict :: (Int -> Char -> a -> a) -> a -> Text -> a
135ifoldrStrict f z xs = Strict.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0
136{-# INLINE ifoldrStrict #-}
137
138-- | Encode\/Decode a strict 'Text' to\/from strict 'ByteString', via UTF-8.
139--
140-- >>> utf8 # "☃"
141-- "\226\152\131"
142utf8 :: Prism' ByteString Text
143utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8')
144{-# INLINE utf8 #-}
145
146#if __GLASGOW_HASKELL__ >= 710
147pattern Text a <- (view _Text -> a) where
148  Text a = review _Text a
149#endif
150