1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4
5#if __GLASGOW_HASKELL__ >= 710
6{-# LANGUAGE ViewPatterns #-}
7{-# LANGUAGE PatternSynonyms #-}
8#endif
9-----------------------------------------------------------------------------
10-- |
11-- Module      :  Data.Text.Lens
12-- Copyright   :  (C) 2012-16 Edward Kmett
13-- License     :  BSD-style (see the file LICENSE)
14-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
15-- Stability   :  experimental
16-- Portability :  non-portable
17--
18----------------------------------------------------------------------------
19module Data.Text.Lens
20  ( IsText(..)
21  , unpacked
22  , _Text
23#if __GLASGOW_HASKELL__ >= 710
24  , pattern Text
25#endif
26  ) where
27
28import           Control.Lens.Type
29#if __GLASGOW_HASKELL__ >= 710
30import           Control.Lens.Getter
31import           Control.Lens.Review
32#endif
33import           Control.Lens.Iso
34import           Control.Lens.Traversal
35import           Data.Text as Strict
36import qualified Data.Text.Strict.Lens as Strict
37import           Data.Text.Lazy as Lazy
38import qualified Data.Text.Lazy.Lens as Lazy
39import           Data.Text.Lazy.Builder
40
41-- $setup
42-- >>> import Control.Lens
43
44-- | Traversals for strict or lazy 'Text'
45class IsText t where
46  -- | This isomorphism can be used to 'pack' (or 'unpack') strict or lazy 'Text'.
47  --
48  -- @
49  -- 'pack' x ≡ x '^.' 'packed'
50  -- 'unpack' x ≡ x '^.' 'from' 'packed'
51  -- 'packed' ≡ 'from' 'unpacked'
52  -- @
53  packed :: Iso' String t
54
55  -- | Convert between strict or lazy 'Text' and a 'Builder'.
56  --
57  -- @
58  -- 'fromText' x ≡ x '^.' 'builder'
59  -- @
60  builder :: Iso' t Builder
61
62  -- | Traverse the individual characters in strict or lazy 'Text'.
63  --
64  -- @
65  -- 'text' = 'unpacked' . 'traversed'
66  -- @
67  text :: IndexedTraversal' Int t Char
68  text = unpacked . traversed
69  {-# INLINE text #-}
70
71instance IsText String where
72  packed = id
73  {-# INLINE packed #-}
74  text = traversed
75  {-# INLINE text #-}
76  builder = Lazy.packed . builder
77  {-# INLINE builder #-}
78
79-- | This isomorphism can be used to 'unpack' (or 'pack') both strict or lazy 'Text'.
80--
81-- @
82-- 'unpack' x ≡ x '^.' 'unpacked'
83-- 'pack' x ≡ x '^.' 'from' 'unpacked'
84-- @
85--
86-- This 'Iso' is provided for notational convenience rather than out of great need, since
87--
88-- @
89-- 'unpacked' ≡ 'from' 'packed'
90-- @
91--
92unpacked :: IsText t => Iso' t String
93unpacked = from packed
94{-# INLINE unpacked #-}
95
96-- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@.
97--
98-- @
99-- '_Text' = 'from' 'packed'
100-- @
101--
102-- >>> _Text # "hello" :: Strict.Text
103-- "hello"
104_Text :: IsText t => Iso' t String
105_Text = from packed
106{-# INLINE _Text #-}
107
108#if __GLASGOW_HASKELL__ >= 710
109pattern Text a <- (view _Text -> a) where
110  Text a = review _Text a
111#endif
112
113instance IsText Strict.Text where
114  packed = Strict.packed
115  {-# INLINE packed #-}
116  builder = Strict.builder
117  {-# INLINE builder #-}
118  text = Strict.text
119  {-# INLINE text #-}
120
121instance IsText Lazy.Text where
122  packed = Lazy.packed
123  {-# INLINE packed #-}
124  builder = Lazy.builder
125  {-# INLINE builder #-}
126  text = Lazy.text
127  {-# INLINE text #-}
128
129