{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}


{- |
Module      :  Lens.Micro.Platform.Internal
Copyright   :  (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix
License     :  BSD-style (see the file LICENSE)
-}
module Lens.Micro.Platform.Internal
(
  IsText(..),
)
where


import Lens.Micro

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif


class IsText t where
  {- |
'packed' lets you convert between 'String' and @Text@ (strict or lazy). It can be used as a replacement for @pack@ or as a way to modify some 'String' if you have a function like @Text -> Text@.
  -}
  packed :: Lens' String t

  {- |
'unpacked' is like 'packed' but works in the opposite direction.
  -}
  unpacked :: Lens' t String

instance IsText String where
  packed :: (String -> f String) -> String -> f String
packed = (String -> f String) -> String -> f String
forall a. a -> a
id
  {-# INLINE packed #-}
  unpacked :: (String -> f String) -> String -> f String
unpacked = (String -> f String) -> String -> f String
forall a. a -> a
id
  {-# INLINE unpacked #-}

instance IsText T.Text where
  packed :: (Text -> f Text) -> String -> f String
packed Text -> f Text
f String
s = Text -> String
T.unpack (Text -> String) -> f Text -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (String -> Text
T.pack String
s)
  {-# INLINE packed #-}
  unpacked :: (String -> f String) -> Text -> f Text
unpacked String -> f String
f Text
s = String -> Text
T.pack (String -> Text) -> f String -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f (Text -> String
T.unpack Text
s)
  {-# INLINE unpacked #-}

instance IsText TL.Text where
  packed :: (Text -> f Text) -> String -> f String
packed Text -> f Text
f String
s = Text -> String
TL.unpack (Text -> String) -> f Text -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (String -> Text
TL.pack String
s)
  {-# INLINE packed #-}
  unpacked :: (String -> f String) -> Text -> f Text
unpacked String -> f String
f Text
s = String -> Text
TL.pack (String -> Text) -> f String -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f (Text -> String
TL.unpack Text
s)
  {-# INLINE unpacked #-}