{-# LANGUAGE TypeFamilies #-}

-- | Due to the switch from 'String' to 'Text' in pandoc-types 1.20, some
-- legacy filters might not work in newer versions. This module contains some
-- string conversion utility functions to make filters work in across different
-- versions.
module Text.Pandoc.Utils.String (
  -- * Conversions
  ToString (..),
  ToText (..),
  IsText (..),
  -- * Reexport from Data.String
  IsString (..),
  ) where

import qualified Data.Text as T

import Data.String (IsString (..))
import Data.Text   (Text)

-- | A helper typeclass for converting 'String' and 'Text' to 'String'.
class IsString s => ToString s where
  -- | Convert strings to 'String'.
  toString :: s -> String

instance Char ~ c => ToString [c] where
  toString :: [c] -> String
toString = [c] -> String
forall a. a -> a
id

instance ToString Text where
  toString :: Text -> String
toString = Text -> String
T.unpack

-- | A helper typeclass for converting 'String' and 'Text' to 'Text'.
class IsString s => ToText s where
  -- | Convert strings to 'Text'.
  toText :: s -> Text

instance Char ~ c => ToText [c] where
  toText :: [c] -> Text
toText = [c] -> Text
String -> Text
T.pack

instance ToText Text where
  toText :: Text -> Text
toText = Text -> Text
forall a. a -> a
id

-- | A helper typeclass for converting 'Text' to either 'String' or 'Text'.
class IsText a where
  -- | Convert from 'Text' to strings
  fromText :: Text -> a

instance Char ~ c => IsText [c] where
  fromText :: Text -> [c]
fromText = Text -> [c]
Text -> String
T.unpack

instance IsText Text where
  fromText :: Text -> Text
fromText = Text -> Text
forall a. a -> a
id