Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 1 addition & 34 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -7,46 +7,13 @@ on:
branches: ["main"]

jobs:
lint:
name: HLint
runs-on: ubuntu-latest
steps:
- name: Checkout HLint repo
uses: actions/checkout@v2
with:
repository: ndmitchell/hlint
ref: '8e10b5143acf97fbdf9baff40ee2da93881e0bf8'
- name: Set up Haskell
id: setup-haskell
uses: haskell/actions/setup@v1
with:
ghc-version: '9.0.1'
cabal-version: 'latest'
- name: Configure HLint
run: cabal new-configure
- name: Freeze HLint
run: cabal freeze
- name: Cache
uses: actions/cache@v2.1.3
with:
path: ${{ steps.setup-haskell.outputs.cabal-store }}
key: ${{ hashFiles('cabal.project.freeze') }}
- name: Build HLint
run: cabal new-install
- name: Checkout text-display
uses: actions/checkout@v2
with:
path: ./text-display
- name: Run HLint
run: |
cd text-display && find src test -name "*.hs" -exec ${{ steps.setup-haskell.outputs.cabal-store }}/../bin/hlint {} +
native:
name: ${{ matrix.ghc }} on ${{ matrix.os }}
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-latest, macos-latest, windows-latest]
ghc: ['8.8', '8.10', '9.0', '9.2.1']
ghc: ['8.8', '8.10', '9.0', '9.2', '9.4.1']
steps:
- name: Checkout base repo
uses: actions/checkout@v2
Expand Down
34 changes: 34 additions & 0 deletions .github/workflows/linting.yml
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
name: Linting

on:
pull_request:
push:
branches: ["main", "development"]

jobs:
fourmolu:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2

- uses: fourmolu/fourmolu-action@v3
with:
pattern: |
src/**/*.hs
test/**/*.hs

hlint:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2

- name: 'Set up HLint'
uses: rwe/actions-hlint-setup@v1
with:
version: '3.4.1'

- name: 'Run HLint'
uses: rwe/actions-hlint-run@v1
with:
path: '["src/", "test/"]'
fail-on: warning
4 changes: 4 additions & 0 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,10 @@ test: ## Run the test suite
lint: ## Run the code linter (HLint)
@find test src -name "*.hs" | parallel -j $(PROCS) -- hlint --refactor-options="-i" --refactor {}

style: ## Run the code styler (stylish-haskell)
@fourmolu -q --mode inplace test src
@cabal-fmt -i *.cabal

check:
@./scripts/ci-check.sh

Expand Down
9 changes: 9 additions & 0 deletions fourmolu.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
indentation: 2
comma-style: leading # for lists, tuples etc. - can also be 'leading'
import-export-style: leading
record-brace-space: false # rec {x = 1} vs. rec{x = 1}
indent-wheres: true # 'false' means save space by only half-indenting the 'where' keyword
respectful: true # don't be too opinionated about newlines etc.
haddock-style: single-line # '--' vs. '{-'
newlines-between-decls: 1 # number of newlines between top-level declarations
fixities: []
111 changes: 59 additions & 52 deletions src/Data/Text/Display.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
Expand All @@ -10,51 +10,54 @@
{-# 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
-- 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
, 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 Data.Word
import GHC.TypeLits
import qualified Data.ByteString.Lazy as BL
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 qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Proxy
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
Expand Down Expand Up @@ -91,11 +94,11 @@ class Display a where
-- > → Custom `displayList`
displayList :: [a] -> Builder
displayList [] = "[]"
displayList (x:xs) = displayList' xs ("[" <> displayBuilder x)
displayList (x : xs) = displayList' xs ("[" <> displayBuilder x)
where
displayList' :: [a] -> Builder -> Builder
displayList' [] acc = acc <> "]"
displayList' (y:ys) acc = displayList' ys (acc <> "," <> displayBuilder y)
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
Expand Down Expand Up @@ -127,13 +130,13 @@ class Display a where
-- > 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 ::
-- | The precedence level passed in by the surrounding context
Int ->
a ->
Builder
displayPrec _ = displayBuilder


-- | Convert a value to a readable 'Text'.
--
-- === Examples
Expand All @@ -159,12 +162,13 @@ instance CannotDisplayBareFunctions => Display (a -> b) where

-- | @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."
)
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!
--
Expand All @@ -185,11 +189,12 @@ 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"
)
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
Expand Down Expand Up @@ -237,7 +242,8 @@ instance KnownSymbol str => Display (OpaqueInstance str a) where
newtype ShowInstance (a :: Type)
= ShowInstance a
deriving newtype
( Show -- ^ @since 0.0.1.0
( -- | @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.
Expand Down Expand Up @@ -301,9 +307,10 @@ instance Display Text where

-- | @since 0.0.1.0
instance Display a => Display [a] where
{-# SPECIALISE instance Display [String] #-}
{-# SPECIALISE instance Display [Char] #-}
{-# SPECIALISE instance Display [Int] #-}
{-# 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
Expand Down Expand Up @@ -373,15 +380,15 @@ 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 <> ")"
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 <> ")"
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 <> ")"
displayBuilder (a, b, c, d) = "(" <> displayBuilder a <> "," <> displayBuilder b <> "," <> displayBuilder c <> "," <> displayBuilder d <> ")"

-- $designChoices
--
Expand Down
15 changes: 8 additions & 7 deletions test/Main.hs
Original file line number Diff line number Diff line change
@@ -1,36 +1,37 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}

module Main where

import Data.ByteString
import Data.List.NonEmpty
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Data.Text.Arbitrary
import Test.Hspec
import Test.Hspec.QuickCheck
import Data.Text.Arbitrary
import Test.ShouldNotTypecheck (shouldNotTypecheck)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T

import Data.Text.Display

main :: IO ()
main = hspec spec

data AutomaticallyDerived = AD
deriving stock Show
deriving Display via (ShowInstance AutomaticallyDerived)
deriving stock (Show)
deriving (Display) via (ShowInstance AutomaticallyDerived)

data ManualType = MT Int

instance Display ManualType where
displayPrec prec (MT i) = displayParen (prec > 10) $ "MT " <> displayPrec 11 i

data OpaqueType = OpaqueType Int
deriving Display
deriving
(Display)
via (OpaqueInstance "<opaque>" OpaqueType)

spec :: Spec
Expand Down
16 changes: 8 additions & 8 deletions text-display.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: text-display
version: 0.0.2.0
version: 0.0.3.0
category: Text
synopsis: A typeclass for user-facing output
description:
Expand All @@ -12,7 +12,7 @@ author: Hécate Moonlight
maintainer: Hécate Moonlight
license: MIT
build-type: Simple
tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
tested-with: GHC ==8.8.* || ==8.10.* || ==9.0.* || ==9.2.* || ==9.4.*
extra-source-files:
CHANGELOG.md
LICENSE
Expand Down Expand Up @@ -41,9 +41,9 @@ library
hs-source-dirs: src
exposed-modules: Data.Text.Display
build-depends:
, base >=4.12 && <= 5
, bytestring ^>=0.10 || ^>=0.11
, text >=1.2
, base >=4.12 && <=5
, bytestring >=0.10 && <0.12
, text >=2.0

test-suite text-display-test
import: common-extensions
Expand All @@ -55,8 +55,8 @@ test-suite text-display-test
build-depends:
, base
, bytestring
, text-display
, hspec
, text
, should-not-typecheck
, quickcheck-text
, should-not-typecheck
, text
, text-display