diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ # CHANGELOG -## [Unreleased] +## [v0.0.5.0] - 16/05/2023 + +* Add Generic machinery (GDisplay1) and RecordInstance newtype for deriving via (https://github.com/haskell-text/text-display/pull/52) + +## [v0.0.4.0] - 21/03/2023 * Fix `displayList` by making it lazier (https://github.com/haskell-text/text-display/pull/27) * Add Display instance for `Void` (https://github.com/haskell-text/text-display/pull/28) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,7 +24,7 @@ > *A Typeclass for user-facing output* -The `text-display` library offers the `Display` for developers to print a textual representation of datatypes that does not +The `text-display` library offers the `Display` typeclass for developers to print a textual representation of datatypes that does not have to abide by the rules of the [Show typeclass][Show]. ## Documentation @@ -35,7 +35,7 @@ * [Comparison with other libraries][comparison] [Show]: https://hackage.haskell.org/package/base/docs/Text-Show.html#v:Show -[tutorial]: https://hackage.haskell.org/package/text-display/src/docs/book/Tutorial.html -[design]: https://hackage.haskell.org/package/text-display/src/docs/book/Design.html +[tutorial]: https://hackage.haskell.org/package/text-display/docs/doc/book/Tutorial.html +[design]: https://hackage.haskell.org/package/text-display/docs/doc/book/Design.html [reference]: https://hackage.haskell.org/package/text-display/docs/Data-Text-Display.html -[comparison]: https://hackage.haskell.org/package/text-display/src/docs/book/Comparison.html +[comparison]: https://hackage.haskell.org/package/text-display/docs/doc/book/Comparison.html diff --git a/src/Data/Text/Display.hs b/src/Data/Text/Display.hs --- a/src/Data/Text/Display.hs +++ b/src/Data/Text/Display.hs @@ -1,15 +1,3 @@ -{-# 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 @@ -26,6 +14,7 @@ -- * Deriving your instance automatically , ShowInstance (..) , OpaqueInstance (..) + , RecordInstance (..) -- * Writing your instance by hand , displayParen @@ -35,363 +24,8 @@ ) 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.Void (Void) -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) = "[" <> displayBuilder x <> foldMap go xs <> "]" - where - go :: a -> Builder - go y = "," <> 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 - :: Int - -- ^ The precedence level passed in by the surrounding context - -> 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 - ( Show - -- ^ @since 0.0.1.0 - ) - --- | 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.3.0 -deriving via (ShowInstance Void) instance Display Void - --- | @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 <> ")" +import Data.Text.Display.Core +import Data.Text.Display.Generic -- $designChoices -- diff --git a/src/Data/Text/Display/Core.hs b/src/Data/Text/Display/Core.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Display/Core.hs @@ -0,0 +1,417 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | +-- Module : Data.Text.Display.Core +-- Copyright : © Hécate Moonlight, 2021 +-- License : MIT +-- Maintainer : hecate@glitchbra.in +-- Stability : stable +-- +-- Core 'Display' typeclass and instances +module Data.Text.Display.Core 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.Void (Void) +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) = "[" <> displayBuilder x <> foldMap go xs <> "]" + where + go :: a -> Builder + go y = "," <> 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 + :: Int + -- ^ The precedence level passed in by the surrounding context + -> 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 + ( Show + -- ^ @since 0.0.1.0 + ) + +-- | 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.3.0 +deriving via (ShowInstance Void) instance Display Void + +-- | @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. diff --git a/src/Data/Text/Display/Generic.hs b/src/Data/Text/Display/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Display/Generic.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Module : Data.Text.Display.Generic +-- Copyright : © Jonathan Lorimer, 2023 +-- License : MIT +-- Maintainer : jonathanlorimer@pm.me +-- Stability : stable +-- +-- Generic machinery for automatically deriving display instances for record types +module Data.Text.Display.Generic where + +import Data.Kind +import Data.Text.Display.Core +import Data.Text.Lazy.Builder (Builder) +import qualified Data.Text.Lazy.Builder as TB +import Data.Type.Bool +import GHC.Generics +import GHC.TypeLits + +-- | Generic typeclass machinery for inducting on the structure +-- of the type, such that we can thread `Display` instances through +-- the structure of the type. The primary use case is for implementing +-- `RecordInstance`, which does this "threading" for record fields. This +-- machinery does, crucially, depend on child types (i.e. the type of a +-- record field) having a `Display` instance. +-- +-- @since 0.0.5.0 +class GDisplay1 f where + gdisplayBuilder1 :: f p -> Builder + +instance GDisplay1 V1 where + gdisplayBuilder1 x = case x of {} + +instance GDisplay1 U1 where + gdisplayBuilder1 _ = "()" + +-- | This is the most important instance, it can be considered as the "base case". It +-- requires a non-generic `Display` instance. All this generic machinery can be conceptualized +-- as distributing these `displayBuilder` calls across a product type. +instance Display c => GDisplay1 (K1 i c) where + gdisplayBuilder1 (K1 a) = displayBuilder a + +instance (Constructor c, GDisplay1 f) => GDisplay1 (M1 C c f) where + gdisplayBuilder1 c@(M1 a) + | conIsRecord c = TB.fromString (conName c) <> "\n { " <> gdisplayBuilder1 a <> "\n }" + | conIsTuple c = TB.fromString (conName c) <> " ( " <> gdisplayBuilder1 a <> " )" + | otherwise = TB.fromString (conName c) <> " " <> gdisplayBuilder1 a + where + conIsTuple :: C1 c f p -> Bool + conIsTuple y = + tupleName (conName y) + where + tupleName ('(' : ',' : _) = True + tupleName _ = False + +instance (Selector s, GDisplay1 f) => GDisplay1 (M1 S s f) where + gdisplayBuilder1 s@(M1 a) = + if selName s == "" + then gdisplayBuilder1 a + else TB.fromString (selName s) <> " = " <> gdisplayBuilder1 a + +instance GDisplay1 f => GDisplay1 (M1 D s f) where + gdisplayBuilder1 (M1 a) = gdisplayBuilder1 a + +instance (GDisplay1 a, GDisplay1 b) => GDisplay1 (a :*: b) where + gdisplayBuilder1 (a :*: b) = gdisplayBuilder1 a <> "\n , " <> gdisplayBuilder1 b + +instance (GDisplay1 a, GDisplay1 b) => GDisplay1 (a :+: b) where + gdisplayBuilder1 (L1 a) = gdisplayBuilder1 a + gdisplayBuilder1 (R1 b) = gdisplayBuilder1 b + +gdisplayBuilderDefault :: (Generic a, GDisplay1 (Rep a)) => a -> Builder +gdisplayBuilderDefault = gdisplayBuilder1 . from + +-- | This wrapper allows you to create an `Display` instance for a record, +-- so long as all the record fields have a `Display` instance as well. +-- +-- === Example +-- +-- > data Password = Password +-- > deriving Display +-- > via (OpaqueInstance "[REDACTED]" Password) +-- +-- > data MyRecord = +-- > MyRecord +-- > { fieldA :: String +-- > , fieldB :: Maybe String +-- > , fieldC :: Int +-- > , pword :: Password +-- > } +-- > deriving stock (Generic) +-- > deriving (Display) via (RecordInstance MyRecord) +-- +-- > putStrLn . Data.Text.unpack . display $ MyRecord "hello" (Just "world") 22 Password +-- +-- > MyRecord +-- > { fieldA = hello +-- > , fieldB = Just world +-- > , fieldC = 22 +-- > , pword = [REDACTED] +-- > } +-- +-- @since 0.0.5.0 +newtype RecordInstance a = RecordInstance {unDisplayProduct :: a} + +instance Generic a => Generic (RecordInstance a) where + type Rep (RecordInstance a) = Rep a + to = RecordInstance . to + from (RecordInstance x) = from x + +-- | We leverage the `AssertNoSum` type family to prevent consumers +-- from deriving instances for sum types. Sum types should use a manual instance +-- or derive one via `ShowInstance`. +-- +-- @since 0.0.5.0 +instance (AssertNoSumRecordInstance Display a, Generic a, GDisplay1 (Rep a)) => Display (RecordInstance a) where + displayBuilder = gdisplayBuilderDefault + +-- | This type family is lifted from generic-data. We use it to prevent the user from +-- deriving a `RecordInstance` for sum types +-- +-- @since 0.0.5.0 +type family HasSum f where + HasSum V1 = 'False + HasSum U1 = 'False + HasSum (K1 i c) = 'False + HasSum (M1 i c f) = HasSum f + HasSum (f :*: g) = HasSum f || HasSum g + HasSum (f :+: g) = 'True + +class Assert (pred :: Bool) (msg :: ErrorMessage) +instance Assert 'True msg +instance TypeError msg ~ '() => Assert 'False msg + +-- | Constraint to prevent misuse of `RecordInstance` deriving via mechanism. +-- +-- === Example +-- +-- > data MySum = A | B | C deriving stock (Generic) deriving (Display) via (RecordInstance MySum) +-- +-- > • 🚫 Cannot derive Display instance for MySum via RecordInstance due to sum type +-- > 💡 Sum types should use a manual instance or derive one via ShowInstance. +-- > • When deriving the instance for (Display MySum) +-- +-- @since 0.0.5.0 +type AssertNoSumRecordInstance (constraint :: Type -> Constraint) a = + Assert + (Not (HasSum (Rep a))) + ( 'Text "🚫 Cannot derive " + ':<>: 'ShowType constraint + ':<>: 'Text " instance for " + ':<>: 'ShowType a + ':<>: 'Text " via RecordInstance due to sum type" + ':$$: 'Text "💡 Sum types should use a manual instance or derive one via ShowInstance." + ) diff --git a/text-display.cabal b/text-display.cabal --- a/text-display.cabal +++ b/text-display.cabal @@ -1,18 +1,21 @@ cabal-version: 3.0 name: text-display -version: 0.0.4.0 +version: 0.0.5.0 category: Text synopsis: A typeclass for user-facing output description: The 'Display' typeclass provides a solution for user-facing output that does not have to abide by the rules of the Show typeclass. -homepage: https://hackage.haskell.org/package/text-display/src/docs/book/Introduction.html +homepage: + https://hackage.haskell.org/package/text-display-0.0.4.0/docs/doc/book/Introduction.html + bug-reports: https://github.com/haskell-text/text-display/issues author: Hécate Moonlight maintainer: Hécate Moonlight license: MIT build-type: Simple -tested-with: GHC == {8.8.4, 8.10.7, 9.0.2, 9.2.7, 9.4.4, 9.6.1} +tested-with: + GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.1 extra-source-files: LICENSE @@ -58,7 +61,10 @@ import: common-extensions import: common-ghc-options hs-source-dirs: src - exposed-modules: Data.Text.Display + exposed-modules: + Data.Text.Display + Data.Text.Display.Core + Data.Text.Display.Generic build-depends: , base >=4.12 && <5.0 , bytestring >=0.10 && <0.12