{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Data.String.Conv
  ( StringConv (..),
    toS,
    toSL,
    convS,
    convSL,
    Leniency (..),
  )
where

------------------------------------------------------------------------------
import Data.ByteString as B
import Data.ByteString.Lazy as LB
import Data.Text as T
import Data.Text.Encoding as T
import Data.Text.Encoding.Error as T
import Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding as LT

------------------------------------------------------------------------------

------------------------------------------------------------------------------

-- | Data type representing the two leniency modes defining how decoding
-- failure is handled.
data Leniency = Lenient | Strict
  deriving (Leniency -> Leniency -> Bool
(Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Bool) -> Eq Leniency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Leniency -> Leniency -> Bool
$c/= :: Leniency -> Leniency -> Bool
== :: Leniency -> Leniency -> Bool
$c== :: Leniency -> Leniency -> Bool
Eq, Int -> Leniency -> ShowS
[Leniency] -> ShowS
Leniency -> String
(Int -> Leniency -> ShowS)
-> (Leniency -> String) -> ([Leniency] -> ShowS) -> Show Leniency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Leniency] -> ShowS
$cshowList :: [Leniency] -> ShowS
show :: Leniency -> String
$cshow :: Leniency -> String
showsPrec :: Int -> Leniency -> ShowS
$cshowsPrec :: Int -> Leniency -> ShowS
Show, ReadPrec [Leniency]
ReadPrec Leniency
Int -> ReadS Leniency
ReadS [Leniency]
(Int -> ReadS Leniency)
-> ReadS [Leniency]
-> ReadPrec Leniency
-> ReadPrec [Leniency]
-> Read Leniency
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Leniency]
$creadListPrec :: ReadPrec [Leniency]
readPrec :: ReadPrec Leniency
$creadPrec :: ReadPrec Leniency
readList :: ReadS [Leniency]
$creadList :: ReadS [Leniency]
readsPrec :: Int -> ReadS Leniency
$creadsPrec :: Int -> ReadS Leniency
Read, Eq Leniency
Eq Leniency
-> (Leniency -> Leniency -> Ordering)
-> (Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Leniency)
-> (Leniency -> Leniency -> Leniency)
-> Ord Leniency
Leniency -> Leniency -> Bool
Leniency -> Leniency -> Ordering
Leniency -> Leniency -> Leniency
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Leniency -> Leniency -> Leniency
$cmin :: Leniency -> Leniency -> Leniency
max :: Leniency -> Leniency -> Leniency
$cmax :: Leniency -> Leniency -> Leniency
>= :: Leniency -> Leniency -> Bool
$c>= :: Leniency -> Leniency -> Bool
> :: Leniency -> Leniency -> Bool
$c> :: Leniency -> Leniency -> Bool
<= :: Leniency -> Leniency -> Bool
$c<= :: Leniency -> Leniency -> Bool
< :: Leniency -> Leniency -> Bool
$c< :: Leniency -> Leniency -> Bool
compare :: Leniency -> Leniency -> Ordering
$ccompare :: Leniency -> Leniency -> Ordering
$cp1Ord :: Eq Leniency
Ord, Int -> Leniency
Leniency -> Int
Leniency -> [Leniency]
Leniency -> Leniency
Leniency -> Leniency -> [Leniency]
Leniency -> Leniency -> Leniency -> [Leniency]
(Leniency -> Leniency)
-> (Leniency -> Leniency)
-> (Int -> Leniency)
-> (Leniency -> Int)
-> (Leniency -> [Leniency])
-> (Leniency -> Leniency -> [Leniency])
-> (Leniency -> Leniency -> [Leniency])
-> (Leniency -> Leniency -> Leniency -> [Leniency])
-> Enum Leniency
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Leniency -> Leniency -> Leniency -> [Leniency]
$cenumFromThenTo :: Leniency -> Leniency -> Leniency -> [Leniency]
enumFromTo :: Leniency -> Leniency -> [Leniency]
$cenumFromTo :: Leniency -> Leniency -> [Leniency]
enumFromThen :: Leniency -> Leniency -> [Leniency]
$cenumFromThen :: Leniency -> Leniency -> [Leniency]
enumFrom :: Leniency -> [Leniency]
$cenumFrom :: Leniency -> [Leniency]
fromEnum :: Leniency -> Int
$cfromEnum :: Leniency -> Int
toEnum :: Int -> Leniency
$ctoEnum :: Int -> Leniency
pred :: Leniency -> Leniency
$cpred :: Leniency -> Leniency
succ :: Leniency -> Leniency
$csucc :: Leniency -> Leniency
Enum, Leniency
Leniency -> Leniency -> Bounded Leniency
forall a. a -> a -> Bounded a
maxBound :: Leniency
$cmaxBound :: Leniency
minBound :: Leniency
$cminBound :: Leniency
Bounded)

------------------------------------------------------------------------------

-- | A type class to standardize string conversions.  With this type class you
-- only need to remember one function for converting between any two string
-- variants.  This package includes support for String, ByteString, and Text
-- as well as the Lazy and Strict variants where necessary.
--
-- This type class lets you control how conversion should behave when failure
-- is possible.  Strict mode will cause an exception to be thrown when
-- decoding fails.  Lenient mode will attempt to recover, inserting a
-- replacement character for invalid bytes.
--
-- StringConv's `toS` function is most useful when you have a fully defined
-- string conversion with a fixed (non-polymorphic) input and output type.  Of
-- course you can still use it when you don't have a fixed type.  In that case
-- you might need to specify a type class constraint such as @StringConv
-- s String@.
class StringConv a b where
  strConv :: Leniency -> a -> b

------------------------------------------------------------------------------

-- | Universal string conversion function for strict decoding.
toS :: StringConv a b => a -> b
toS :: a -> b
toS = Leniency -> a -> b
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
Strict

------------------------------------------------------------------------------

-- | Universal string conversion function for lenient decoding.
toSL :: StringConv a b => a -> b
toSL :: a -> b
toSL = Leniency -> a -> b
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
Lenient

instance StringConv String String where strConv :: Leniency -> ShowS
strConv Leniency
_ = ShowS
forall a. a -> a
id

instance StringConv String B.ByteString where strConv :: Leniency -> String -> ByteString
strConv Leniency
_ = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance StringConv String LB.ByteString where strConv :: Leniency -> String -> ByteString
strConv Leniency
_ = Text -> ByteString
LT.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack

instance StringConv String T.Text where strConv :: Leniency -> String -> Text
strConv Leniency
_ = String -> Text
T.pack

instance StringConv String LT.Text where strConv :: Leniency -> String -> Text
strConv Leniency
_ = String -> Text
LT.pack

instance StringConv B.ByteString String where strConv :: Leniency -> ByteString -> String
strConv Leniency
l = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Leniency -> ByteString -> Text
decodeUtf8T Leniency
l

instance StringConv B.ByteString B.ByteString where strConv :: Leniency -> ByteString -> ByteString
strConv Leniency
_ = ByteString -> ByteString
forall a. a -> a
id

instance StringConv B.ByteString LB.ByteString where strConv :: Leniency -> ByteString -> ByteString
strConv Leniency
_ = [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return

instance StringConv B.ByteString T.Text where strConv :: Leniency -> ByteString -> Text
strConv = Leniency -> ByteString -> Text
decodeUtf8T

instance StringConv B.ByteString LT.Text where strConv :: Leniency -> ByteString -> Text
strConv Leniency
l = Leniency -> ByteString -> Text
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
l (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return

instance StringConv LB.ByteString String where strConv :: Leniency -> ByteString -> String
strConv Leniency
l = Text -> String
LT.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Leniency -> ByteString -> Text
decodeUtf8LT Leniency
l

instance StringConv LB.ByteString B.ByteString where strConv :: Leniency -> ByteString -> ByteString
strConv Leniency
_ = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LB.toChunks

instance StringConv LB.ByteString LB.ByteString where strConv :: Leniency -> ByteString -> ByteString
strConv Leniency
_ = ByteString -> ByteString
forall a. a -> a
id

instance StringConv LB.ByteString T.Text where strConv :: Leniency -> ByteString -> Text
strConv Leniency
l = Leniency -> ByteString -> Text
decodeUtf8T Leniency
l (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Leniency -> ByteString -> ByteString
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
l

instance StringConv LB.ByteString LT.Text where strConv :: Leniency -> ByteString -> Text
strConv = Leniency -> ByteString -> Text
decodeUtf8LT

instance StringConv T.Text String where strConv :: Leniency -> Text -> String
strConv Leniency
_ = Text -> String
T.unpack

instance StringConv T.Text B.ByteString where strConv :: Leniency -> Text -> ByteString
strConv Leniency
_ = Text -> ByteString
T.encodeUtf8

instance StringConv T.Text LB.ByteString where strConv :: Leniency -> Text -> ByteString
strConv Leniency
l = Leniency -> ByteString -> ByteString
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
l (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance StringConv T.Text LT.Text where strConv :: Leniency -> Text -> Text
strConv Leniency
_ = Text -> Text
LT.fromStrict

instance StringConv T.Text T.Text where strConv :: Leniency -> Text -> Text
strConv Leniency
_ = Text -> Text
forall a. a -> a
id

instance StringConv LT.Text String where strConv :: Leniency -> Text -> String
strConv Leniency
_ = Text -> String
LT.unpack

instance StringConv LT.Text T.Text where strConv :: Leniency -> Text -> Text
strConv Leniency
_ = Text -> Text
LT.toStrict

instance StringConv LT.Text LT.Text where strConv :: Leniency -> Text -> Text
strConv Leniency
_ = Text -> Text
forall a. a -> a
id

instance StringConv LT.Text LB.ByteString where strConv :: Leniency -> Text -> ByteString
strConv Leniency
_ = Text -> ByteString
LT.encodeUtf8

instance StringConv LT.Text B.ByteString where strConv :: Leniency -> Text -> ByteString
strConv Leniency
l = Leniency -> ByteString -> ByteString
forall a b. StringConv a b => Leniency -> a -> b
strConv Leniency
l (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LT.encodeUtf8

------------------------------------------------------------------------------

-- | Convenience helper for dispatching based on leniency.
decodeUtf8T :: Leniency -> B.ByteString -> T.Text
decodeUtf8T :: Leniency -> ByteString -> Text
decodeUtf8T Leniency
Lenient = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode
decodeUtf8T Leniency
Strict = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.strictDecode

------------------------------------------------------------------------------

-- | Convenience helper for dispatching based on leniency.
decodeUtf8LT :: Leniency -> LB.ByteString -> LT.Text
decodeUtf8LT :: Leniency -> ByteString -> Text
decodeUtf8LT Leniency
Lenient = OnDecodeError -> ByteString -> Text
LT.decodeUtf8With OnDecodeError
T.lenientDecode
decodeUtf8LT Leniency
Strict = OnDecodeError -> ByteString -> Text
LT.decodeUtf8With OnDecodeError
T.strictDecode

------------------------------------------------------------------------------

-- | A lens for 'toS' to make it slightly more convenient in some scenarios.
convS :: (StringConv a b, StringConv b a, Functor f) => (b -> f b) -> a -> f a
convS :: (b -> f b) -> a -> f a
convS b -> f b
f a
a = (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
forall a b. StringConv a b => a -> b
toS (b -> f b
f (a -> b
forall a b. StringConv a b => a -> b
toS a
a))

------------------------------------------------------------------------------

-- | A lens for 'toSL' to make it slightly more convenient in some scenarios.
convSL :: (StringConv a b, StringConv b a, Functor f) => (b -> f b) -> a -> f a
convSL :: (b -> f b) -> a -> f a
convSL b -> f b
f a
a = (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
forall a b. StringConv a b => a -> b
toSL (b -> f b
f (a -> b
forall a b. StringConv a b => a -> b
toSL a
a))