{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE OverloadedStrings          #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric              #-}
#else
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
#endif

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE AutoDeriveTypeable         #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE StandaloneDeriving         #-}
#endif
{-|
Module:      Text.Show.Text.Classes
Copyright:   (C) 2014-2015 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

The 'Show', 'Show1', and 'Show2' typeclasses.
-}
module Text.Show.Text.Classes where

import           Data.Data (Data, Typeable)
import           Data.Monoid.Compat ((<>))
import           Data.Text         as TS (Text)
import qualified Data.Text.IO      as TS (putStrLn, hPutStrLn)
import qualified Data.Text.Lazy    as TL (Text)
import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)
import           Data.Text.Lazy (toStrict)
import           Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText)

#if __GLASGOW_HASKELL__ >= 702
import           GHC.Generics (Generic)
# if __GLASGOW_HASKELL__ >= 706
import           GHC.Generics (Generic1)
# endif
#else
import qualified Generics.Deriving.TH as Generics (deriveAll)
#endif
import           GHC.Show (appPrec, appPrec1)

import           Prelude ()
import           Prelude.Compat hiding (Show(..))

import           System.IO (Handle)

import           Text.Read (Read(..), readListPrecDefault)
import qualified Text.Show as S (Show(..))
import           Text.Show.Text.Utils (toString)

#include "inline.h"

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

-- | Conversion of values to @Text@. Because there are both strict and lazy @Text@
-- variants, the 'Show' class deliberately avoids using @Text@ in its functions.
-- Instead, 'showbPrec', 'showb', and 'showbList' all return 'Builder', an
-- efficient intermediate form that can be converted to either kind of @Text@.
--
-- 'Builder' is a 'Monoid', so it is useful to use the 'mappend' (or '<>') function
-- to combine 'Builder's when creating 'Show' instances. As an example:
--
-- @
-- import Text.Show.Text
--
-- data Example = Example Int Int
-- instance Show Example where
--     showb (Example i1 i2) = showb i1 <> showbSpace <> showb i2
-- @
--
-- If you do not want to create 'Show' instances manually, you can alternatively
-- use the "Text.Show.Text.TH" module to automatically generate default 'Show'
-- instances using Template Haskell, or the "Text.Show.Text.Generic" module to
-- quickly define 'Show' instances using 'genericShowbPrec'.
--
-- /Since: 0.1/
class Show a where
    -- | Convert a value to a 'Builder' with the given predence.
    --
    -- /Since: 0.1/
    showbPrec :: Int -- ^ The operator precedence of the enclosing context (a number
                     -- from @0@ to @11@). Function application has precedence @10@.
              -> a   -- ^ The value to be converted to a 'String'.
              -> Builder

    -- | A specialized variant of 'showbPrec' using precedence context zero.
    --
    -- /Since: 0.1/
    showb :: a -> Builder

    -- | Allows for specialized display of lists. This is used, for example, when
    -- showing lists of 'Char's.
    --
    -- /Since: 0.1/
    showbList :: [a] -> Builder

    showbPrec _ = showb

    showb = showbPrec 0

    showbList = showbListWith showb
#if __GLASGOW_HASKELL__ >= 708
    {-# MINIMAL showbPrec | showb #-}

deriving instance Typeable Show
#endif

-- | Constructs a strict 'TS.Text' from a single value.
--
-- /Since: 0.1/
show :: Show a => a -> TS.Text
show = toStrict . showLazy
{-# INLINE show #-}

-- | Constructs a lazy 'TL.Text' from a single value.
--
-- /Since: 0.3/
showLazy :: Show a => a -> TL.Text
showLazy = toLazyText . showb
{-# INLINE showLazy #-}

-- | Constructs a strict 'TS.Text' from a single value with the given precedence.
--
-- /Since: 0.3/
showPrec :: Show a => Int -> a -> TS.Text
showPrec p = toStrict . showPrecLazy p
{-# INLINE showPrec #-}

-- | Constructs a lazy 'TL.Text' from a single value with the given precedence.
--
-- /Since: 0.3/
showPrecLazy :: Show a => Int -> a -> TL.Text
showPrecLazy p = toLazyText . showbPrec p
{-# INLINE showPrecLazy #-}

-- | Construct a strict 'TS.Text' from a list of values.
--
-- /Since: 0.3.1/
showList :: Show a => [a] -> TS.Text
showList = toStrict . showListLazy
{-# INLINE showList #-}

-- | Construct a lazy 'TL.Text' from a list of values.
--
-- /Since: 0.3.1/
showListLazy :: Show a => [a] -> TL.Text
showListLazy = toLazyText . showbList
{-# INLINE showListLazy #-}

-- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'.
--
-- /Since: 0.1/
showbParen :: Bool -> Builder -> Builder
showbParen p builder | p         = singleton '(' <> builder <> singleton ')'
                     | otherwise = builder
{-# INLINE showbParen #-}

-- | Construct a 'Builder' containing a single space character.
--
-- /Since: 0.5/
showbSpace :: Builder
showbSpace = singleton ' '

-- | Converts a list of values into a 'Builder' in which the values are surrounded
-- by square brackets and each value is separated by a comma. The function argument
-- controls how each element is shown.

-- @'showbListWith' 'showb'@ is the default implementation of 'showbList' save for
-- a few special cases (e.g., 'String').
--
-- /Since: 0.7/
showbListWith :: (a -> Builder) -> [a] -> Builder
showbListWith _      []     = "[]"
showbListWith showbx (x:xs) = singleton '[' <> showbx x <> go xs -- "[..
  where
    go (y:ys) = singleton ',' <> showbx y <> go ys               -- ..,..
    go []     = singleton ']'                                    -- ..]"
{-# INLINE showbListWith #-}

-- | Writes a value's strict 'TS.Text' representation to the standard output, followed
--   by a newline.
--
-- /Since: 0.1/
print :: Show a => a -> IO ()
print = TS.putStrLn . show
{-# INLINE print #-}

-- | Writes a value's lazy 'TL.Text' representation to the standard output, followed
--   by a newline.
--
-- /Since: 0.3/
printLazy :: Show a => a -> IO ()
printLazy = TL.putStrLn . showLazy
{-# INLINE printLazy #-}

-- | Writes a value's strict 'TS.Text' representation to a file handle, followed
--   by a newline.
--
-- /Since: 0.3/
hPrint :: Show a => Handle -> a -> IO ()
hPrint h = TS.hPutStrLn h . show
{-# INLINE hPrint #-}

-- | Writes a value's lazy 'TL.Text' representation to a file handle, followed
--   by a newline.
--
-- /Since: 0.3/
hPrintLazy :: Show a => Handle -> a -> IO ()
hPrintLazy h = TL.hPutStrLn h . showLazy
{-# INLINE hPrintLazy #-}

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

-- | Lifting of the 'Show' class to unary type constructors.
--
-- /Since: 1/
class Show1 f where
    -- | Lifts a 'showbPrec' function through the type constructor.
    --
    -- /Since: 1/
    showbPrecWith :: (Int -> a -> Builder) -> Int -> f a -> Builder

#if __GLASGOW_HASKELL__ >= 708
deriving instance Typeable Show1
#endif

-- | Lift the standard 'showbPrec' function through the type constructor.
--
-- /Since: 1/
showbPrec1 :: (Show1 f, Show a) => Int -> f a -> Builder
showbPrec1 = showbPrecWith showbPrec
{-# INLINE showbPrec1 #-}

-- | @'showbUnaryWith' sp n p x@ produces the 'Builder' representation of a unary data
-- constructor with name @n@ and argument @x@, in precedence context @p@, using the
-- function @sp@ to show occurrences of the type argument.
--
-- /Since: 1/
showbUnaryWith :: (Int -> a -> Builder) -> Builder -> Int -> a -> Builder
showbUnaryWith sp nameB p x = showbParen (p > appPrec) $
    nameB <> showbSpace <> sp appPrec1 x
{-# INLINE showbUnaryWith #-}

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

-- | Lifting of the 'Show' class to binary type constructors.
--
-- /Since: 1/
class Show2 f where
    -- | Lifts 'showbPrec' functions through the type constructor.
    --
    -- /Since: 1/
    showbPrecWith2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) ->
        Int -> f a b -> Builder

#if __GLASGOW_HASKELL__ >= 708
deriving instance Typeable Show2
#endif

-- | Lift two 'showbPrec' functions through the type constructor.
--
-- /Since: 1/
showbPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> Builder
showbPrec2 = showbPrecWith2 showbPrec showbPrec
{-# INLINE showbPrec2 #-}

-- | @'showbBinaryWith' sp n p x y@ produces the 'Builder' representation of a binary
-- data constructor with name @n@ and arguments @x@ and @y@, in precedence context
-- @p@, using the functions @sp1@ and @sp2@ to show occurrences of the type arguments.
--
-- /Since: 1/
showbBinaryWith :: (Int -> a -> Builder) -> (Int -> b -> Builder) ->
    Builder -> Int -> a -> b -> Builder
showbBinaryWith sp1 sp2 nameB p x y = showbParen (p > appPrec) $ nameB
    <> showbSpace <> sp1 appPrec1 x
    <> showbSpace <> sp2 appPrec1 y
{-# INLINE showbBinaryWith #-}

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

-- | The @Text@ 'T.Show' instance for 'FromStringShow' is based on its @String@
-- 'S.Show' instance. That is,
--
-- @
-- showbPrec p ('FromStringShow' x) = 'fromString' (showsPrec p x "")
-- @
--
-- /Since: 0.5/
newtype FromStringShow a = FromStringShow { fromStringShow :: a }
  deriving ( Data
           , Eq
           , Foldable
           , Functor
#if __GLASGOW_HASKELL__ >= 702
           , Generic
# if __GLASGOW_HASKELL__ >= 706
           , Generic1
# endif
#endif
           , Ord
           , Traversable
           , Typeable
           )

instance Read a => Read (FromStringShow a) where
    readPrec = FromStringShow <$> readPrec
    INLINE_INST_FUN(readPrec)

    readListPrec = readListPrecDefault
    INLINE_INST_FUN(readListPrec)

instance S.Show a => Show (FromStringShow a) where
    showbPrec p (FromStringShow x) = fromString $ S.showsPrec p x ""
    INLINE_INST_FUN(showbPrec)

instance S.Show a => S.Show (FromStringShow a) where
    showsPrec p (FromStringShow x) = S.showsPrec p x
    INLINE_INST_FUN(showsPrec)

-- | The @String@ 'S.Show' instance for 'FromTextShow' is based on its @Text@
-- 'T.Show' instance. That is,
--
-- @
-- showsPrec p ('FromTextShow' x) str = 'toString' (showbPrec p x) ++ str
-- @
--
-- /Since: 0.6/
newtype FromTextShow a = FromTextShow { fromTextShow :: a }
  deriving ( Data
           , Eq
           , Foldable
           , Functor
#if __GLASGOW_HASKELL__ >= 702
           , Generic
# if __GLASGOW_HASKELL__ >= 706
           , Generic1
# endif
#endif
           , Ord
           , Traversable
           , Typeable
           )

instance Read a => Read (FromTextShow a) where
    readPrec = FromTextShow <$> readPrec
    INLINE_INST_FUN(readPrec)

    readListPrec = readListPrecDefault
    INLINE_INST_FUN(readListPrec)

instance Show a => S.Show (FromTextShow a) where
    showsPrec p (FromTextShow x) = showString . toString $ showbPrec p x
    INLINE_INST_FUN(showsPrec)

instance Show a => Show (FromTextShow a) where
    showbPrec = showbPrec1
    INLINE_INST_FUN(showbPrec)

instance Show1 FromTextShow where
    showbPrecWith sp p (FromTextShow x) = sp p x
    INLINE_INST_FUN(showbPrecWith)

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

#if __GLASGOW_HASKELL__ < 702
$(Generics.deriveAll ''FromStringShow)
$(Generics.deriveAll ''FromTextShow)
#endif