{-|
Module      : $header$
Description : Class machinery for overloaded writing of String-like types
Copyright   : (c) Justus Adam 2018
License     : MIT
Maintainer  : Serokell <hi@serokell.io>
Stability   : experimental
Portability : portable

You may import this module to define your own, custom instances of 'Print'. Be
advised however that this module is an internal API and may be subject to change
__even for minor version increments__.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Trustworthy       #-}

module Universum.Print.Internal (Print(..)) where

import qualified System.IO as SIO (Handle, hPutStr, hPutStrLn)

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL

import qualified Data.Text as T
import qualified Data.Text.IO as T

import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL

import qualified Universum.Base as Base

-- | Support class to overload writing of string like values.
class Print a where
  hPutStr :: SIO.Handle -> a -> Base.IO ()
  hPutStrLn :: SIO.Handle -> a -> Base.IO ()

instance Print T.Text where
  hPutStr :: Handle -> Text -> IO ()
hPutStr = Handle -> Text -> IO ()
T.hPutStr
  hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn = Handle -> Text -> IO ()
T.hPutStrLn

instance Print TL.Text where
  hPutStr :: Handle -> Text -> IO ()
hPutStr = Handle -> Text -> IO ()
TL.hPutStr
  hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn = Handle -> Text -> IO ()
TL.hPutStrLn

instance Print BS.ByteString where
  hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
BS.hPutStr
  hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn = Handle -> ByteString -> IO ()
BS.hPutStrLn

instance Print BL.ByteString where
  hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
BL.hPutStr
  hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn = Handle -> ByteString -> IO ()
BL.hPutStrLn

instance Print [Base.Char] where
  hPutStr :: Handle -> [Char] -> IO ()
hPutStr = Handle -> [Char] -> IO ()
SIO.hPutStr
  hPutStrLn :: Handle -> [Char] -> IO ()
hPutStrLn = Handle -> [Char] -> IO ()
SIO.hPutStrLn