{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE PackageImports #-}

module Text.InterpolatedString.QM.ShowQ.Class (ShowQ (..)) where

import "bytestring" Data.ByteString.Char8 as Strict (ByteString, unpack)
import "bytestring" Data.ByteString.Lazy.Char8 as Lazy (ByteString, unpack)
import "text" Data.Text as T (Text, unpack)
import "text" Data.Text.Lazy as LazyT (Text, unpack)


class ShowQ a where
  showQ :: a -> String

instance ShowQ Char where
  showQ :: Char -> String
showQ = (Char -> String -> String
forall a. a -> [a] -> [a]
:[])

instance ShowQ String where
  showQ :: String -> String
showQ = String -> String
forall a. a -> a
id

instance ShowQ Strict.ByteString where
  showQ :: ByteString -> String
showQ = ByteString -> String
Strict.unpack

instance ShowQ Lazy.ByteString where
  showQ :: ByteString -> String
showQ = ByteString -> String
Lazy.unpack

instance ShowQ T.Text where
  showQ :: Text -> String
showQ = Text -> String
T.unpack

instance ShowQ LazyT.Text where
  showQ :: Text -> String
showQ = Text -> String
LazyT.unpack

instance Show a => ShowQ a where
  showQ :: a -> String
showQ = a -> String
forall a. Show a => a -> String
show