{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
--  Module      : Data.Text.Display
--  Copyright   : © Hécate Moonlight, 2021
--  License     : MIT
--  Maintainer  : hecate@glitchbra.in
--  Stability   : stable
--
--  Use 'display' to produce user-facing text
module Data.Text.Display
  ( -- * Documentation
    display
  , Display (..)

    -- * Deriving your instance automatically
  , ShowInstance (..)
  , OpaqueInstance (..)

    -- * Writing your instance by hand
  , displayParen

    -- * Design choices
    -- $designChoices
  )
where

import Control.Exception hiding (TypeError)
import Data.ByteString
import qualified Data.ByteString.Lazy as BL
import Data.Int
import Data.Kind
import Data.List.NonEmpty
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.Builder.Int as TB
import qualified Data.Text.Lazy.Builder.RealFloat as TB
import Data.Word
import GHC.TypeLits

-- | A typeclass for user-facing output.
--
-- @since 0.0.1.0
class Display a where
  {-# MINIMAL displayBuilder | displayPrec #-}

  -- | Implement this method to describe how to convert your value to 'Builder'.
  displayBuilder :: a -> Builder
  displayBuilder = displayPrec 0

  -- | The method 'displayList' is provided to allow for a specialised
  -- way to render lists of a certain value.
  -- This is used to render the list of 'Char' as a string of characters
  -- enclosed in double quotes, rather than between square brackets and
  -- separated by commas.
  --
  -- === Example
  --
  -- > import qualified Data.Text.Lazy.Builder as TB
  -- >
  -- > instance Display Char where
  -- >   displayBuilder c = TB.fromText $ T.singleton c
  -- >   displayList cs = TB.fromText $ T.pack cs
  -- >
  -- > instance Display a => Display [a] where
  -- >   -- In this instance, 'displayBuilder' is defined in terms of 'displayList', which for most types
  -- >   -- is defined as the default written in the class declaration.
  -- >   -- But when a ~ Char, there is an explicit implementation that is selected instead, which
  -- >   -- provides the rendering of the character string between double quotes.
  -- >   displayBuilder = displayList
  --
  -- ==== How implementations are selected
  --
  -- > displayBuilder ([1,2,3] :: [Int])
  -- > → displayBuilder @[Int] = displayBuilderList @Int
  -- > → Default `displayList`
  -- >
  -- > displayBuilder ("abc" :: [Char])
  -- > → displayBuilder @[Char] = displayBuilderList @Char
  -- > → Custom `displayList`
  displayList :: [a] -> Builder
  displayList [] = "[]"
  displayList (x : xs) = displayList' xs ("[" <> displayBuilder x)
    where
      displayList' :: [a] -> Builder -> Builder
      displayList' [] acc = acc <> "]"
      displayList' (y : ys) acc = displayList' ys (acc <> "," <> displayBuilder y)

  -- | The method 'displayPrec' allows you to write instances that
  -- require nesting. The precedence parameter can be thought of as a
  -- suggestion coming from the surrounding context for how tightly to bind. If the precedence
  -- parameter is higher than the precedence of the operator (or constructor, function, etc.)
  -- being displayed, then that suggests that the output will need to be surrounded in parentheses
  -- in order to bind tightly enough (see 'displayParen').
  --
  -- For example, if an operator constructor is being displayed, then the precedence requirement
  -- for its arguments will be the precedence of the operator. Meaning, if the argument
  -- binds looser than the surrounding operator, then it will require parentheses.
  --
  -- Note that function/constructor application has an effective precedence of 10.
  --
  -- === Examples
  --
  -- > instance Display a => Display (Maybe a) where
  -- >   -- In this instance, we define 'displayPrec' rather than 'displayBuilder' as we need to decide
  -- >   -- whether or not to surround ourselves in parentheses based on the surrounding context.
  -- >   -- If the precedence parameter is higher than 10 (the precedence of constructor application)
  -- >   -- then we indeed need to surround ourselves in parentheses to avoid malformed outputs
  -- >   -- such as @Just Just 5@.
  -- >   -- We then set the precedence parameter of the inner 'displayPrec' to 11, as even
  -- >   -- constructor application is not strong enough to avoid parentheses.
  -- >   displayPrec _ Nothing = "Nothing"
  -- >   displayPrec prec (Just a) = displayParen (prec > 10) $ "Just " <> displayPrec 11 a
  --
  -- > data Pair a b = a :*: b
  -- > infix 5 :*: -- arbitrary choice of precedence
  -- > instance (Display a, Display b) => Display (Pair a b) where
  -- >   displayPrec prec (a :*: b) = displayParen (prec > 5) $ displayPrec 6 a <> " :*: " <> displayPrec 6 b
  displayPrec ::
    -- | The precedence level passed in by the surrounding context
    Int ->
    a ->
    Builder
  displayPrec _ = displayBuilder

-- | Convert a value to a readable 'Text'.
--
-- === Examples
-- >>> display 3
-- "3"
--
-- >>> display True
-- "True"
--
-- @since 0.0.1.0
display :: Display a => a -> Text
display a = TL.toStrict $ TB.toLazyText $ displayBuilder a

-- | 🚫 You should not try to display functions!
--
-- 💡 Write a 'newtype' wrapper that represents your domain more accurately.
--    If you are not consciously trying to use 'display' on a function,
--    make sure that you are not missing an argument somewhere.
--
-- @since 0.0.1.0
instance CannotDisplayBareFunctions => Display (a -> b) where
  displayBuilder = undefined

-- | @since 0.0.1.0
type family CannotDisplayBareFunctions :: Constraint where
  CannotDisplayBareFunctions =
    TypeError
      ( 'Text "🚫 You should not try to display functions!"
          ':$$: 'Text "💡 Write a 'newtype' wrapper that represents your domain more accurately."
          ':$$: 'Text "   If you are not consciously trying to use `display` on a function,"
          ':$$: 'Text "   make sure that you are not missing an argument somewhere."
      )

-- | 🚫 You should not try to display strict ByteStrings!
--
-- 💡 Always provide an explicit encoding.
-- Use 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' to convert from UTF-8
--
-- @since 0.0.1.0
instance CannotDisplayByteStrings => Display ByteString where
  displayBuilder = undefined

-- | 🚫 You should not try to display lazy ByteStrings!
--
-- 💡 Always provide an explicit encoding.
-- Use 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' to convert from UTF-8
--
-- @since 0.0.1.0
instance CannotDisplayByteStrings => Display BL.ByteString where
  displayBuilder = undefined

type family CannotDisplayByteStrings :: Constraint where
  CannotDisplayByteStrings =
    TypeError
      ( 'Text "🚫 You should not try to display ByteStrings!"
          ':$$: 'Text "💡 Always provide an explicit encoding"
          ':$$: 'Text "Use 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' to convert from UTF-8"
      )

-- | A utility function that surrounds the given 'Builder' with parentheses when the Bool parameter is True.
-- Useful for writing instances that may require nesting. See the 'displayPrec' documentation for more
-- information.
--
-- @since 0.0.1.0
displayParen :: Bool -> Builder -> Builder
displayParen b txt = if b then "(" <> txt <> ")" else txt

-- | This wrapper allows you to create an opaque instance for your type,
-- useful for redacting sensitive content like tokens or passwords.
--
-- === Example
--
-- > data UserToken = UserToken UUID
-- >  deriving Display
-- >    via (OpaqueInstance "[REDACTED]" UserToken)
--
-- > display $ UserToken "7a01d2ce-31ff-11ec-8c10-5405db82c3cd"
-- > "[REDACTED]"
--
-- @since 0.0.1.0
newtype OpaqueInstance (str :: Symbol) (a :: Type) = Opaque a

-- | This wrapper allows you to create an opaque instance for your type,
-- useful for redacting sensitive content like tokens or passwords.
--
-- @since 0.0.1.0
instance KnownSymbol str => Display (OpaqueInstance str a) where
  displayBuilder _ = TB.fromString $ symbolVal (Proxy @str)

-- | This wrapper allows you to rely on a pre-existing 'Show' instance in order to
-- derive 'Display' from it.
--
-- === Example
--
-- > data AutomaticallyDerived = AD
-- >  -- We derive 'Show'
-- >  deriving stock Show
-- >  -- We take advantage of the 'Show' instance to derive 'Display' from it
-- >  deriving Display
-- >    via (ShowInstance AutomaticallyDerived)
--
-- @since 0.0.1.0
newtype ShowInstance (a :: Type)
  = ShowInstance a
  deriving newtype
    ( -- | @since 0.0.1.0
      Show
    )

-- | This wrapper allows you to rely on a pre-existing 'Show' instance in order to derive 'Display' from it.
--
-- @since 0.0.1.0
instance Show e => Display (ShowInstance e) where
  displayBuilder s = TB.fromString $ show s

-- @since 0.0.1.0
newtype DisplayDecimal e
  = DisplayDecimal e
  deriving newtype
    (Integral, Real, Enum, Ord, Num, Eq)

-- @since 0.0.1.0
instance Integral e => Display (DisplayDecimal e) where
  displayBuilder = TB.decimal

-- @since 0.0.1.0
newtype DisplayRealFloat e
  = DisplayRealFloat e
  deriving newtype
    (RealFloat, RealFrac, Real, Ord, Eq, Num, Fractional, Floating)

-- @since 0.0.1.0
instance RealFloat e => Display (DisplayRealFloat e) where
  displayBuilder = TB.realFloat

-- | @since 0.0.1.0
deriving via (ShowInstance ()) instance Display ()

-- | @since 0.0.1.0
deriving via (ShowInstance Bool) instance Display Bool

-- | @since 0.0.1.0
-- 'displayList' is overloaded, so that when the @Display [a]@ instance calls 'displayList',
-- we end up with a nice string instead of a list of chars between brackets.
--
-- >>> display [1, 2, 3]
-- "[1,2,3]"
--
-- >>> display ['h', 'e', 'l', 'l', 'o']
-- "hello"
instance Display Char where
  -- This instance's implementation is used in the haddocks of the typeclass.
  -- If you change it, reflect the change in the documentation.
  displayBuilder c = TB.fromText $ T.singleton c
  displayList cs = TB.fromText $ T.pack cs

-- | Lazy 'TL.Text'
--
-- @since 0.0.1.0
instance Display TL.Text where
  displayBuilder = TB.fromLazyText

-- | Strict 'Data.Text.Text'
--
-- @since 0.0.1.0
instance Display Text where
  displayBuilder = TB.fromText

-- | @since 0.0.1.0
instance Display a => Display [a] where
  {-# SPECIALIZE instance Display [String] #-}
  {-# SPECIALIZE instance Display [Char] #-}
  {-# SPECIALIZE instance Display [Int] #-}

  -- In this instance, 'displayBuilder' is defined in terms of 'displayList', which for most types
  -- is defined as the default written in the class declaration.
  -- But when @a ~ Char@, there is an explicit implementation that is selected instead, which
  -- provides the rendering of the character string between double quotes.
  displayBuilder = displayList

-- | @since 0.0.1.0
instance Display a => Display (NonEmpty a) where
  displayBuilder (a :| as) = displayBuilder a <> TB.fromString " :| " <> displayBuilder as

-- | @since 0.0.1.0
instance Display a => Display (Maybe a) where
  -- In this instance, we define 'displayPrec' rather than 'displayBuilder' as we need to decide
  -- whether or not to surround ourselves in parentheses based on the surrounding context.
  -- If the precedence parameter is higher than 10 (the precedence of constructor application)
  -- then we indeed need to surround ourselves in parentheses to avoid malformed outputs
  -- such as @Just Just 5@.
  -- We then set the precedence parameter of the inner 'displayPrec' to 11, as even
  -- constructor application is not strong enough to avoid parentheses.
  displayPrec _ Nothing = "Nothing"
  displayPrec prec (Just a) = displayParen (prec > 10) $ "Just " <> displayPrec 11 a

-- | @since 0.0.1.0
deriving via (DisplayRealFloat Double) instance Display Double

-- | @since 0.0.1.0
deriving via (DisplayRealFloat Float) instance Display Float

-- | @since 0.0.1.0
deriving via (DisplayDecimal Int) instance Display Int

-- | @since 0.0.1.0
deriving via (DisplayDecimal Int8) instance Display Int8

-- | @since 0.0.1.0
deriving via (DisplayDecimal Int16) instance Display Int16

-- | @since 0.0.1.0
deriving via (DisplayDecimal Int32) instance Display Int32

-- | @since 0.0.1.0
deriving via (DisplayDecimal Int64) instance Display Int64

-- | @since 0.0.1.0
deriving via (DisplayDecimal Integer) instance Display Integer

-- | @since 0.0.1.0
deriving via (DisplayDecimal Word) instance Display Word

-- | @since 0.0.1.0
deriving via (DisplayDecimal Word8) instance Display Word8

-- | @since 0.0.1.0
deriving via (DisplayDecimal Word16) instance Display Word16

-- | @since 0.0.1.0
deriving via (DisplayDecimal Word32) instance Display Word32

-- | @since 0.0.1.0
deriving via (DisplayDecimal Word64) instance Display Word64

-- | @since 0.0.1.0
deriving via (ShowInstance IOException) instance Display IOException

-- | @since 0.0.1.0
deriving via (ShowInstance SomeException) instance Display SomeException

-- | @since 0.0.1.0
instance (Display a, Display b) => Display (a, b) where
  displayBuilder (a, b) = "(" <> displayBuilder a <> "," <> displayBuilder b <> ")"

-- | @since 0.0.1.0
instance (Display a, Display b, Display c) => Display (a, b, c) where
  displayBuilder (a, b, c) = "(" <> displayBuilder a <> "," <> displayBuilder b <> "," <> displayBuilder c <> ")"

-- | @since 0.0.1.0
instance (Display a, Display b, Display c, Display d) => Display (a, b, c, d) where
  displayBuilder (a, b, c, d) = "(" <> displayBuilder a <> "," <> displayBuilder b <> "," <> displayBuilder c <> "," <> displayBuilder d <> ")"

-- $designChoices
--
-- === A “Lawless Typeclass”
--
-- The 'Display' typeclass does not contain any law. This is a controversial choice for some people,
-- but the truth is that there are not any laws to ask of the consumer that are not already enforced
-- by the type system and the internals of the 'Data.Text.Internal.Text' type.
--
-- === "🚫 You should not try to display functions!"
--
-- Sometimes, when using the library, you may encounter this message:
--
-- > • 🚫 You should not try to display functions!
-- >   💡 Write a 'newtype' wrapper that represents your domain more accurately.
-- >      If you are not consciously trying to use `display` on a function,
-- >      make sure that you are not missing an argument somewhere.
--
-- The 'display' library does not allow the definition and usage of 'Display' on
-- bare function types (@(a -> b)@).
-- Experience and time have shown that due to partial application being baked in the language,
-- many users encounter a partial application-related error message when a simple missing
-- argument to a function is the root cause.
--
-- There may be legitimate uses of a 'Display' instance on a function type.
-- But these usages are extremely dependent on their domain of application.
-- That is why it is best to wrap them in a newtype that can better
-- express and enforce the domain.
--
-- === "🚫 You should not try to display ByteStrings!"
--
-- An arbitrary ByteStrings cannot be safely converted to text without prior knowledge of its encoding.
--
-- As such, in order to avoid dangerously blind conversions, it is recommended to use a specialised
-- function such as 'Data.Text.Encoding.decodeUtf8'' or 'Data.Text.Encoding.decodeUtf8With' if you wish to turn a UTF8-encoded ByteString
-- to Text.