-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Module defining a version of 'Universum.show' constrained only to types that have a
-- human-readable representation.
--
-- For printing non-human-readable representation, use module "Debug".
module Morley.Prelude.Show
  ( PrettyShow
  , show
  ) where

import Data.Fixed (Fixed)
import Data.Time (NominalDiffTime)
import Data.Typeable (TypeRep)
import Data.Word.Odd (Word62, Word63)
import GHC.TypeLits (ErrorMessage(..), TypeError)
import Language.Haskell.Extension (KnownExtension)
import Language.Haskell.TH (Name)
import Language.Haskell.TH.PprLib (Doc)
import Universum hiding (show)
import Universum qualified (show)

-- | An open type family for types having a human-readable 'Show' representation. The
-- kind is 'Constraint' in case we need to further constrain the instance, and also for
-- convenience to avoid explicitly writing @~ 'True@ everywhere.
type family PrettyShow a :: Constraint

-- Integrals are human-readable
type instance PrettyShow Word = ()
type instance PrettyShow Word8 = ()
type instance PrettyShow Word16 = ()
type instance PrettyShow Word32 = ()
type instance PrettyShow Word62 = ()
type instance PrettyShow Word63 = ()
type instance PrettyShow Word64 = ()
type instance PrettyShow Int = ()
type instance PrettyShow Int8 = ()
type instance PrettyShow Int16 = ()
type instance PrettyShow Int32 = ()
type instance PrettyShow Int64 = ()
type instance PrettyShow Integer = ()
type instance PrettyShow Natural = ()

-- Double and Float are also pretty human-readable
type instance PrettyShow Float = ()
type instance PrettyShow Double = ()

-- Fixed is generally very human-readable
type instance PrettyShow (Fixed _) = ()

-- UnicodeException show instance is human-readable instead of machine-readable
type instance PrettyShow UnicodeException = ()

-- TH 'Name' generally just shows the underlying string
type instance PrettyShow Name = ()

-- The Show instance for 'Doc' is the same as render
type instance PrettyShow Doc = ()

-- KnownExtension's show instance pretty much matches exactly with the
-- expectations, e.g. StarIsType.
type instance PrettyShow KnownExtension = ()

-- TypeRep is pretty human-readable, can use show without worry
type instance PrettyShow TypeRep = ()

-- NominalDiffTime show instance is human-readable instead of machine-readable
type instance PrettyShow NominalDiffTime = ()

-- Lists are human-readable if each element in it is
type instance PrettyShow [a] = PrettyShow a

-- Show instances for String and similar types are not entirely human-readable.
-- For instance:
--
-- >>> print "A string with \"quotes\""
-- "A string with \"quotes\""
--
-- >>> print "A string with non-ascii characters हि"
-- "A string with non-ascii characters \2361\2367"
type instance PrettyShow Text = TypeError (
  'Text "Show instance for Text is not pretty" ':$$:
  'Text "Consider relying on the Buildable instance"
  )
type instance PrettyShow LText = TypeError (
  'Text "Show instance for lazy Text is not pretty" ':$$:
  'Text "Consider relying on the Buildable instance"
  )
type instance PrettyShow Char = TypeError (
  'Text "Show instance for String and Char is not pretty" ':$$:
  'Text "Consider relying on the Buildable instance"
  )

type instance PrettyShow ByteString = TypeError (
  'Text "Show instance for ByteString is not pretty"
  )
type instance PrettyShow LByteString = TypeError (
  'Text "Show instance for lazy ByteString is not pretty"
  )

-- | A version of 'Universum.show' that requires the value to have a human-readable
-- 'Show' instance.
show :: forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show :: forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show = a -> b
forall b a. (Show a, IsString b) => a -> b
Universum.show