-- | Provides universal conversions between any two string-like types.
-- Out-of-the-box, @Text@ (both lazy and strict), @ByteString@ (both lazy and
-- strict), and String, are supported.
--
-- To hook custom string types into the conversion mechanism, implement both
-- @FromString@ and @ToString@ for your type, and optionally provide special
-- cases for conversions to and from some other string-like type by
-- implementing @StringConvert@ directly.
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE FlexibleInstances #-}
module Text.StringConvert
( FromString
, fromString
, ToString
, toString
, StringConvert
, s
)
where

import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Lazy.UTF8 as LUTF8
import qualified Data.ByteString.Lazy as LBS

class FromString a where
    fromString :: String -> a

instance FromString [Char] where
    fromString = id

instance FromString Text.Text where
    fromString = Text.pack

instance FromString LText.Text where
    fromString = LText.pack

instance FromString UTF8.ByteString where
    fromString = UTF8.fromString

instance FromString LUTF8.ByteString where
    fromString = LUTF8.fromString

-- | Defines how a given type should be converted to String.
-- If at all possible, the conversion should be loss-less, and if encodings are
-- involved, UTF-8 should be the default.
class ToString a where
    toString :: a -> String

instance ToString [Char] where
    toString = id

instance ToString LText.Text where
    toString = LText.unpack

instance ToString Text.Text where
    toString = Text.unpack

instance ToString UTF8.ByteString where
    toString = UTF8.toString


-- | Defines conversions between two given stringish types.
class StringConvert a b where
    s :: a -> b

instance (ToString a, FromString b) => StringConvert a b where
    s = fromString . toString

instance StringConvert Text.Text LText.Text where
    s = LText.fromStrict

instance StringConvert LText.Text Text.Text where
    s = LText.toStrict

instance StringConvert UTF8.ByteString LUTF8.ByteString where
    s = LBS.fromStrict

instance StringConvert LUTF8.ByteString UTF8.ByteString where
    s = LBS.toStrict