{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
#endif
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 Data.Text as Strict
import qualified Data.Text.Strict.Lens as Strict
import Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Lens as Lazy
import Data.Text.Lazy.Builder
class IsText t where
packed :: Iso' String t
builder :: Iso' t Builder
text :: IndexedTraversal' Int t Char
text = unpacked . traversed
{-# INLINE text #-}
instance IsText String where
packed = id
{-# INLINE packed #-}
text = traversed
{-# INLINE text #-}
builder = Lazy.packed . builder
{-# INLINE builder #-}
unpacked :: IsText t => Iso' t String
unpacked = from packed
{-# INLINE unpacked #-}
_Text :: IsText t => Iso' t String
_Text = from packed
{-# INLINE _Text #-}
#if __GLASGOW_HASKELL__ >= 710
pattern Text a <- (view _Text -> a) where
Text a = review _Text a
#endif
instance IsText Strict.Text where
packed = Strict.packed
{-# INLINE packed #-}
builder = Strict.builder
{-# INLINE builder #-}
text = Strict.text
{-# INLINE text #-}
instance IsText Lazy.Text where
packed = Lazy.packed
{-# INLINE packed #-}
builder = Lazy.builder
{-# INLINE builder #-}
text = Lazy.text
{-# INLINE text #-}