{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Text.Lens
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Data.Text.Lens
  ( IsText(..)
  , unpacked
  , _Text
#if __GLASGOW_HASKELL__ >= 710
  , pattern Text
#endif
  ) where

import           Control.Lens.Type
#if __GLASGOW_HASKELL__ >= 710
import           Control.Lens.Getter
import           Control.Lens.Review
#endif
import           Control.Lens.Iso
import           Control.Lens.Traversal
import qualified Data.Text as Strict
import qualified Data.Text.Strict.Lens as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Lens as Lazy
import           Data.Text.Lazy.Builder (Builder)

-- $setup
-- >>> import Control.Lens
-- >>> import qualified Data.Text as Strict

-- | Traversals for strict or lazy 'Text'
class IsText t where
  -- | This isomorphism can be used to 'pack' (or 'unpack') strict or lazy 'Text'.
  --
  -- @
  -- 'pack' x ≡ x '^.' 'packed'
  -- 'unpack' x ≡ x '^.' 'from' 'packed'
  -- 'packed' ≡ 'from' 'unpacked'
  -- @
  packed :: Iso' String t

  -- | Convert between strict or lazy 'Text' and a 'Builder'.
  --
  -- @
  -- 'fromText' x ≡ x '^.' 'builder'
  -- @
  builder :: Iso' t Builder

  -- | Traverse the individual characters in strict or lazy 'Text'.
  --
  -- @
  -- 'text' = 'unpacked' . 'traversed'
  -- @
  text :: IndexedTraversal' Int t Char
  text = (String -> f String) -> t -> f t
forall t. IsText t => Iso' t String
unpacked ((String -> f String) -> t -> f t)
-> (p Char (f Char) -> String -> f String)
-> p Char (f Char)
-> t
-> f t
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
traversed
  {-# INLINE text #-}

instance IsText String where
  packed :: p String (f String) -> p String (f String)
packed = p String (f String) -> p String (f String)
forall a. a -> a
id
  {-# INLINE packed #-}
  text :: p Char (f Char) -> String -> f String
text = p Char (f Char) -> String -> f String
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE text #-}
  builder :: p Builder (f Builder) -> p String (f String)
builder = p Text (f Text) -> p String (f String)
Iso' String Text
Lazy.packed (p Text (f Text) -> p String (f String))
-> (p Builder (f Builder) -> p Text (f Text))
-> p Builder (f Builder)
-> p String (f String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Builder (f Builder) -> p Text (f Text)
forall t. IsText t => Iso' t Builder
builder
  {-# INLINE builder #-}

-- | This isomorphism can be used to 'unpack' (or 'pack') both strict or lazy 'Text'.
--
-- @
-- 'unpack' x ≡ x '^.' 'unpacked'
-- 'pack' x ≡ x '^.' 'from' 'unpacked'
-- @
--
-- This 'Iso' is provided for notational convenience rather than out of great need, since
--
-- @
-- 'unpacked' ≡ 'from' 'packed'
-- @
--
unpacked :: IsText t => Iso' t String
unpacked :: Iso' t String
unpacked = AnIso String String t t -> Iso' t String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String t t
forall t. IsText t => Iso' String t
packed
{-# INLINE unpacked #-}

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

#if __GLASGOW_HASKELL__ >= 710
pattern $bText :: String -> s
$mText :: forall r s. IsText s => s -> (String -> r) -> (Void# -> r) -> r
Text a <- (view _Text -> a) where
  Text String
a = AReview s String -> String -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview s String
forall t. IsText t => Iso' t String
_Text String
a
#endif

instance IsText Strict.Text where
  packed :: p Text (f Text) -> p String (f String)
packed = p Text (f Text) -> p String (f String)
Iso' String Text
Strict.packed
  {-# INLINE packed #-}
  builder :: p Builder (f Builder) -> p Text (f Text)
builder = p Builder (f Builder) -> p Text (f Text)
Iso' Text Builder
Strict.builder
  {-# INLINE builder #-}
  text :: p Char (f Char) -> Text -> f Text
text = p Char (f Char) -> Text -> f Text
IndexedTraversal' Int Text Char
Strict.text
  {-# INLINE text #-}

instance IsText Lazy.Text where
  packed :: p Text (f Text) -> p String (f String)
packed = p Text (f Text) -> p String (f String)
Iso' String Text
Lazy.packed
  {-# INLINE packed #-}
  builder :: p Builder (f Builder) -> p Text (f Text)
builder = p Builder (f Builder) -> p Text (f Text)
Iso' Text Builder
Lazy.builder
  {-# INLINE builder #-}
  text :: p Char (f Char) -> Text -> f Text
text = p Char (f Char) -> Text -> f Text
IndexedTraversal' Int Text Char
Lazy.text
  {-# INLINE text #-}