summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorlyxia <>2019-01-11 12:29:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-01-11 12:29:00 (GMT)
commit715cbf457ca19320b4c4752988a9926f10be0d70 (patch)
tree1cc88fe22e26e6a4c12c73276b55e91f34e80ec2
parent4975adf74e9402510024521efda19c952670a370 (diff)
version 0.1.1.0HEAD0.1.1.0master
-rw-r--r--CHANGELOG.md7
-rw-r--r--README.md2
-rw-r--r--show-combinators.cabal8
-rw-r--r--src/Text/Show/Combinators.hs108
-rw-r--r--test/test.hs25
5 files changed, 133 insertions, 17 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..6c28225
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,7 @@
+# 0.1.1.0
+
+- Added `showInfixl`, `showInfixr`, `showInfixl'`, `showInfixr'`.
+
+# 0.1.0.0
+
+Initial version
diff --git a/README.md b/README.md
index 3ee4003..42ddf57 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-# Show combinators
+# Show combinators [![Hackage](https://img.shields.io/hackage/v/show-combinators.svg)](https://hackage.haskell.org/package/show-combinators) [![Build Status](https://travis-ci.org/Lysxia/show-combinators.svg)](https://travis-ci.org/Lysxia/show-combinators)
A minimal set of convenient combinators to write `Show` instances.
diff --git a/show-combinators.cabal b/show-combinators.cabal
index e5d0fde..89f8c04 100644
--- a/show-combinators.cabal
+++ b/show-combinators.cabal
@@ -1,5 +1,5 @@
name: show-combinators
-version: 0.1.0.0
+version: 0.1.1.0
synopsis: Combinators to write Show instances
description:
A minimal pretty-printing library for Show instances in Haskell.
@@ -11,15 +11,17 @@ maintainer: lysxia@gmail.com
copyright: 2018 Li-yao Xia
category: Text
build-type: Simple
-extra-source-files: README.md
+extra-source-files: README.md, CHANGELOG.md
cabal-version: >=1.10
+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.6.3
library
hs-source-dirs: src
exposed-modules:
Text.Show.Combinators
build-depends:
- base >= 4.9 && < 5
+ -- This upper bound is conservative
+ base >= 4.8 && < 4.13
ghc-options: -Wall
default-language: Haskell2010
diff --git a/src/Text/Show/Combinators.hs b/src/Text/Show/Combinators.hs
index e785024..d1deee6 100644
--- a/src/Text/Show/Combinators.hs
+++ b/src/Text/Show/Combinators.hs
@@ -1,6 +1,4 @@
--- | Combinators for 'Show'
---
--- The combinators below can be used to write 'Show' instances.
+-- | Combinators to write 'Show' instances.
--
-- The following type illustrates the common use cases.
--
@@ -14,20 +12,33 @@
--
-- instance 'Show' a => 'Show' (MyType a) where
-- 'showsPrec' = 'flip' precShows where
--- precShows (C a b) = 'showCon' "C" '@|' a '@|' b
--- precShows (c :+: d) = 'showInfix'' ":+:" 4 c d
+-- precShows (C a b) = 'showCon' \"C\" '@|' a '@|' b
+-- precShows (c :+: d) = 'showInfix'' \":+:\" 4 c d
-- precShows (R {f1 = e, f2 = f}) =
--- 'showRecord' "R" ("f1" '.=.' e '&|' "f2" '.=.' f)
+-- 'showRecord' \"R\" (\"f1\" '.=.' e '&|' \"f2\" '.=.' f)
-- @
module Text.Show.Combinators
( module Text.Show
, PrecShowS
+
+ -- * Simple constructors and applications
, showCon
, showApp
, (@|)
+
+ -- * Infix constructors
, showInfix
, showInfix'
+
+ -- ** Combinators for associative operators
+ -- | Use with care, see 'showInfixl'.
+ , showInfixl
+ , showInfixl'
+ , showInfixr
+ , showInfixr'
+
+ -- * Records
, ShowFields
, showRecord
, showField
@@ -46,6 +57,23 @@ import Text.Show
type PrecShowS = Int -> ShowS
-- | Show a constructor.
+--
+-- Possible constructor names are:
+--
+-- - regular constructors (e.g., @\"Left\"@);
+-- - parenthesized infix constructors (e.g., @\"(:)\"@);
+-- - smart constructors, for abstract types (e.g., @\"Map.fromList\"@).
+--
+-- === __Example with smart constructor__
+--
+-- @
+-- instance (Show k, Show v) => Show (Map k v) where
+-- showsPrec = 'flip' precShows where
+-- precShows m = 'showCon' \"Map.fromList\" '@|' Map.toList m
+--
+-- -- Example output:
+-- -- > Map.fromList [(33, True), (55, False)]
+-- @
showCon :: String -> PrecShowS
showCon con _ = showString con
@@ -67,8 +95,7 @@ showApp showF showX d = showParen (d > appPrec)
-- | Show an applied infix operator with a given precedence.
showInfix :: String -> Int -> PrecShowS -> PrecShowS -> PrecShowS
-showInfix op prec showX showY d = showParen (d > prec)
- (showX (prec + 1) . showSpace . showString op . showSpace . showY (prec + 1))
+showInfix op prec = showInfix_ op prec (prec + 1) (prec + 1)
-- | Show an applied infix operator with a given precedence.
--
@@ -80,6 +107,69 @@ showInfix op prec showX showY d = showParen (d > prec)
showInfix' :: (Show a, Show b) => String -> Int -> a -> b -> PrecShowS
showInfix' op prec x y = showInfix op prec (flip showsPrec x) (flip showsPrec y)
+-- | Show an applied infix operator which is left associative (@infixl@).
+-- Use with care.
+--
+-- This combinator assumes that, if there is another infix operator to the
+-- left, it is either left associative with the same precedence, or it has a
+-- different precedence.
+-- An expression containing two operators at the same level with different
+-- associativities is ambiguous.
+--
+-- By default, prefer 'showInfix' and 'showInfix''.
+showInfixl :: String -> Int -> PrecShowS -> PrecShowS -> PrecShowS
+showInfixl op prec = showInfix_ op prec prec (prec + 1)
+
+-- | Show an applied infix operator which is left associative (@infixl@).
+-- Use with care, see 'showInfixl'.
+--
+-- This is a shorthand for 'showInfixl' when the arguments types are instances
+-- of 'Show'.
+--
+-- By default, prefer 'showInfix' and 'showInfix''.
+showInfixl' :: (Show a, Show b) => String -> Int -> a -> b -> PrecShowS
+showInfixl' op prec x y = showInfixl op prec (flip showsPrec x) (flip showsPrec y)
+
+-- | Show an applied infix operator which is right associative (@infixr@).
+-- Use with care.
+--
+-- This combinator assumes that, if there is another infix operator to the
+-- right, it is either right associative with the same precedence, or it has a
+-- different precedence.
+-- An expression containing two operators at the same level with different
+-- associativities is ambiguous.
+--
+-- By default, prefer 'showInfix' and 'showInfix''.
+--
+-- === __Example usage__
+--
+-- @
+-- showList :: Show a => [a] -> PrecShowS
+-- showList [] = showCon "[]"
+-- showList (x : xs) = showInfixr ":" 5 (flip showsPrec x) (showList xs)
+--
+-- -- Example output:
+-- -- > 0 : 1 : 2 : 3 : []
+-- @
+showInfixr :: String -> Int -> PrecShowS -> PrecShowS -> PrecShowS
+showInfixr op prec = showInfix_ op prec (prec + 1) prec
+
+-- | Show an applied infix operator which is right associative (@infixr@).
+-- Use with care, see 'showInfixr'.
+--
+-- This is a shorthand for 'showInfixr' when the arguments types are instances
+-- of 'Show'.
+--
+-- By default, prefer 'showInfix' and 'showInfix''.
+showInfixr' :: (Show a, Show b) => String -> Int -> a -> b -> PrecShowS
+showInfixr' op prec x y = showInfixr op prec (flip showsPrec x) (flip showsPrec y)
+
+-- | An internal combinator for infix operators, to explicitly update the
+-- precedence levels on each side.
+showInfix_ :: String -> Int -> Int -> Int -> PrecShowS -> PrecShowS -> PrecShowS
+showInfix_ op prec precX precY showX showY d = showParen (d > prec)
+ (showX precX . showSpace . showString op . showSpace . showY precY)
+
-- | Strings representing a set of record fields separated by commas.
-- They can be constructed using ('.=.') and ('@|'), or using 'showField' and
-- 'appendFields'.
@@ -103,7 +193,7 @@ infixr 8 .=.
-- This is an infix shorthand for 'showField' when the value type is an
-- instance of 'Show'.
--
--- > field .=. x = showField field (flip showsPrec x)
+-- > field .=. x = showField field (flip showsPrec x)
(.=.) :: Show a => String -> a -> ShowFields
field .=. x = showField field (flip showsPrec x)
diff --git a/test/test.hs b/test/test.hs
index a73eabb..3c604a7 100644
--- a/test/test.hs
+++ b/test/test.hs
@@ -21,15 +21,30 @@ _showsMyType' (c :+: d) = showInfix' ":+:" 4 c d
_showsMyType' (R {f1 = e, f2 = f}) =
showRecord "R" ("f1" .=. e &| "f2" .=. f)
+showL :: [Int] -> PrecShowS
+showL [] = showCon "[]"
+showL (x : xs) = showInfixr ":" 5 (flip showsPrec x) (showL xs)
+
+-- snoc lists
+showR :: [Int] -> PrecShowS
+showR [] = showCon "[]"
+showR (x : xs) = showInfixl ":" 5 (showR xs) (flip showsPrec x)
+
check :: Show a => (a -> PrecShowS) -> a -> IO ()
-check show' x =
+check show' x = assertEqual s s'
+ where
+ s = show x
+ s' = show' x 0 ""
+
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
+assertEqual s s' =
if s == s' then
return ()
else
fail $ show (s, s')
- where
- s = show x
- s' = show' x 0 ""
+
+unPS :: (a -> PrecShowS) -> a -> String
+unPS p x = p x 0 ""
main :: IO ()
main = do
@@ -37,6 +52,8 @@ main = do
check smt2 (C (C () ()) (() :+: ()))
check smt2 ((() :+: ()) :+: (() :+: ()))
check smt2 (R (C () ()) (C () ()))
+ assertEqual (unPS showL [1,2,3]) "1 : 2 : 3 : []"
+ assertEqual (unPS showR [1,2,3]) "[] : 3 : 2 : 1"
where
smt1 = showsMyType (flip showsPrec)
smt2 = showsMyType smt1