{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}

-- | This Module will be removed in the future in favor of classes defined in
-- "Data.TypedEncoding.Common.Class.Util.StringConstraints"
--
-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly.

module Data.TypedEncoding.Common.Class.IsStringR where

import           Data.Proxy

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



-- $setup
-- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes
-- >>> import Test.QuickCheck
-- >>> import Test.QuickCheck.Instances.Text()
-- >>> import Test.QuickCheck.Instances.ByteString()

-- | This class will be removed in 0.3.x.x in favor of classes definined in 
-- "Data.TypedEncoding.Common.Class.Util.StringConstraints"
--
-- Reverses 'Data.String.IsString'
--
-- laws:
--
-- @
--  toString . fromString == id
--  fromString . toString == id
-- @
--
-- Note: ByteString is not a valid instance, ByteString "r-ASCII", or "r-UTF8" would
-- be needed.
-- @B.unpack $ B.pack "\160688" == "\176"@
--
-- @since 0.2.0.0
class IsStringR a where
    toString :: a -> String

prop_fromStringToString :: forall s . (IsString s, IsStringR s, Eq s) => s -> Bool
prop_fromStringToString :: s -> Bool
prop_fromStringToString s
x = s
x s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== (IsString s => String -> s
forall a. IsString a => String -> a
fromString @s (String -> s) -> (s -> String) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. IsStringR a => a -> String
toString (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s
x)

prop_toStringFromString :: forall s . (IsString s, IsStringR s) => Proxy s -> String -> Bool
prop_toStringFromString :: Proxy @* s -> String -> Bool
prop_toStringFromString Proxy @* s
_ String
x = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (IsStringR s => s -> String
forall a. IsStringR a => a -> String
toString @s (s -> String) -> (String -> s) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
x)

-- This would not work
-- @B.unpack $ B.pack "\160688" == "\176"@
--
-- prop> prop_toStringFromString (Proxy :: Proxy B.ByteString) 
-- prop> prop_fromStringToString @B.ByteString
-- instance IsStringR B.ByteString where
--     toString = B.unpack
 

-- |
-- prop> prop_toStringFromString (Proxy :: Proxy T.Text) 
-- prop> prop_fromStringToString @T.Text
instance IsStringR T.Text where
    toString :: Text -> String
toString = Text -> String
T.unpack    

-- |
-- prop> prop_toStringFromString (Proxy :: Proxy TL.Text) 
-- prop> prop_fromStringToString @TL.Text
instance IsStringR TL.Text where
    toString :: Text -> String
toString = Text -> String
TL.unpack  

instance IsStringR [Char] where
    toString :: String -> String
toString = String -> String
forall a. a -> a
id