diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 15e51e5..6e6286c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -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 diff --git a/.github/workflows/linting.yml b/.github/workflows/linting.yml new file mode 100644 index 0000000..973c969 --- /dev/null +++ b/.github/workflows/linting.yml @@ -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 diff --git a/Makefile b/Makefile index d5c190c..b702030 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..fdbad1b --- /dev/null +++ b/fourmolu.yaml @@ -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: [] diff --git a/src/Data/Text/Display.hs b/src/Data/Text/Display.hs index d6abc1d..cefaf98 100644 --- a/src/Data/Text/Display.hs +++ b/src/Data/Text/Display.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StrictData #-} @@ -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 @@ -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 @@ -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 @@ -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! -- @@ -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 @@ -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. @@ -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 @@ -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 -- diff --git a/test/Main.hs b/test/Main.hs index c8e2882..b400c91 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,19 +1,19 @@ +{-# 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 @@ -21,8 +21,8 @@ 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 @@ -30,7 +30,8 @@ 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 "" OpaqueType) spec :: Spec diff --git a/text-display.cabal b/text-display.cabal index 55c7d9b..728019b 100644 --- a/text-display.cabal +++ b/text-display.cabal @@ -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: @@ -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 @@ -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 @@ -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