show-combinators-0.2.0.0/src/0000755000000000000000000000000013243016500014114 5ustar0000000000000000show-combinators-0.2.0.0/src/Text/0000755000000000000000000000000013242667432015057 5ustar0000000000000000show-combinators-0.2.0.0/src/Text/Show/0000755000000000000000000000000013635750156016001 5ustar0000000000000000show-combinators-0.2.0.0/test/0000755000000000000000000000000013635747410014324 5ustar0000000000000000show-combinators-0.2.0.0/src/Text/Show/Combinators.hs0000644000000000000000000001606713635750156020627 0ustar0000000000000000-- | Combinators to write 'Show' instances. -- -- The following type illustrates the common use cases. -- -- @ -- data MyType a -- = C a a -- a regular constructor -- | a :+: a -- an infix constructor -- | R { f1 :: a, f2 :: a } -- a record -- -- infixl 4 :+: -- -- 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 (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 warning under 'showInfixl'. , showInfixl , showInfixl' , showInfixr , showInfixr' -- * Records , ShowFields , showRecord , showField , (.=.) , noFields , appendFields , (&|) ) where import Text.Show -- | Type of strings representing expressions, parameterized by the surrounding -- precedence level. -- -- This is the return type of @'flip' 'showsPrec'@. 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 infixl 2 `showApp`, @| -- | Show a function application. showApp :: PrecShowS -> PrecShowS -> PrecShowS showApp showF showX d = showParen (d > appPrec) (showF appPrec . showSpace . showX appPrec1) -- | Show a function application. -- -- This is an infix shorthand for 'showApp' when the argument type is an -- instance of 'Show'. -- -- > showF @| x = showApp showF (flip showsPrec x) (@|) :: Show a => PrecShowS -> a -> PrecShowS (@|) showF x = showApp showF (flip showsPrec x) -- | Show an applied infix operator with a given precedence. showInfix :: String -> Int -> PrecShowS -> PrecShowS -> PrecShowS showInfix op prec = showInfix_ op prec (prec + 1) (prec + 1) -- | Show an applied infix operator with a given precedence. -- -- This is a shorthand for 'showInfix' when the arguments types are instances -- of 'Show'. -- -- > showInfix' op prec x y = -- > showInfix op prec (flip showsPrec x) (flip showsPrec y) 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. -- -- ==== Warning -- -- 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 and will not be shown correctly with -- 'showInfixl' and 'showInfixr'. -- -- 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. -- -- ==== Warning -- -- 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 and will not be shown correctly with -- 'showInfixl' and 'showInfixr'. -- -- 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'. type ShowFields = ShowS -- | Show a record. The first argument is the constructor name. -- The second represents the set of record fields. showRecord :: String -> ShowFields -> PrecShowS showRecord con showFields d = showParen (d > appPrec) (showString con . showSpace . showChar '{' . showFields . showChar '}') -- | Show a single record field: a field name and a value separated by @\'=\'@. showField :: String -> PrecShowS -> ShowFields showField field showX = showString field . showString " = " . showX 0 infixr 8 .=. -- | Show a single record field: a field name and a value separated by @\'=\'@. -- -- This is an infix shorthand for 'showField' when the value type is an -- instance of 'Show'. -- -- > field .=. x = showField field (flip showsPrec x) (.=.) :: Show a => String -> a -> ShowFields field .=. x = showField field (flip showsPrec x) -- | Empty set of record fields. noFields :: ShowFields noFields = id infixr 1 `appendFields`, &| -- | Separate two __nonempty__ sets of record fields by a comma. appendFields :: ShowFields -> ShowFields -> ShowFields appendFields showFds1 showFds2 = showFds1 . showString ", " . showFds2 -- | An infix synonym of 'appendFields'. (&|) :: ShowFields -> ShowFields -> ShowFields (&|) = appendFields -- Helpers showSpace :: ShowS showSpace = (' ' :) appPrec, appPrec1 :: Int appPrec = 10 appPrec1 = 11 show-combinators-0.2.0.0/test/test.hs0000644000000000000000000000332013635747410015635 0ustar0000000000000000import Text.Show.Combinators data MyType a = C a a -- a regular constructor | a :+: a -- an infix constructor | R { f1 :: a, f2 :: a } -- a record deriving Show infixl 4 :+: showsMyType :: (a -> PrecShowS) -> MyType a -> PrecShowS showsMyType showA (C a b) = showCon "C" `showApp` showA a `showApp` showA b showsMyType showA (c :+: d) = showInfix ":+:" 4 (showA c) (showA d) showsMyType showA (R {f1 = e, f2 = f}) = showRecord "R" ("f1" `showField` showA e &| "f2" `showField` showA f) -- Just making sure this typechecks _showsMyType' :: Show a => MyType a -> PrecShowS _showsMyType' (C a b) = showCon "C" @| a @| b _showsMyType' (c :+: d) = showInfix' ":+:" 4 c d _showsMyType' (R {f1 = e, f2 = f}) = showRecord "R" ("f1" .=. e &| "f2" .=. f) showR :: [Int] -> PrecShowS showR [] = showCon "[]" showR (x : xs) = showInfixr ":" 5 (flip showsPrec x) (showR xs) -- snoc lists showL :: [Int] -> PrecShowS showL [] = showCon "[]" showL (x : xs) = showInfixl ":" 5 (showL xs) (flip showsPrec x) check :: Show a => (a -> PrecShowS) -> Int -> a -> IO () check show' d x = assertEqual s s' where s = showsPrec d x "" s' = show' x d "" assertEqual :: (Eq a, Show a) => a -> a -> IO () assertEqual s s' = if s == s' then return () else fail $ show (s, s') unPS :: (a -> PrecShowS) -> a -> String unPS p x = p x 0 "" main :: IO () main = do check smt1 0 (C () ()) check smt2 0 (C (C () ()) (() :+: ())) check smt2 0 ((() :+: ()) :+: (() :+: ())) check smt2 11 (R (C () ()) (C () ())) assertEqual (unPS showR [1,2,3]) "1 : 2 : 3 : []" assertEqual (unPS showL [1,2,3]) "[] : 3 : 2 : 1" where smt1 = showsMyType (flip showsPrec) smt2 = showsMyType smt1 show-combinators-0.2.0.0/LICENSE0000644000000000000000000000204513242667323014351 0ustar0000000000000000Copyright Li-yao Xia (c) 2018 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.show-combinators-0.2.0.0/Setup.hs0000644000000000000000000000005613242667323015000 0ustar0000000000000000import Distribution.Simple main = defaultMain show-combinators-0.2.0.0/show-combinators.cabal0000644000000000000000000000230513635750541017626 0ustar0000000000000000name: show-combinators version: 0.2.0.0 synopsis: Combinators to write Show instances description: A minimal pretty-printing library for Show instances in Haskell. homepage: https://github.com/Lysxia/show-combinators#readme license: MIT license-file: LICENSE author: Li-yao Xia maintainer: lysxia@gmail.com copyright: 2018 Li-yao Xia category: Text build-type: Simple 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.4.4, GHC == 8.6.5, GHC == 8.8.1 library hs-source-dirs: src exposed-modules: Text.Show.Combinators build-depends: -- This upper bound is conservative base >= 4.8 && < 4.14 ghc-options: -Wall default-language: Haskell2010 test-suite test hs-source-dirs: test main-is: test.hs build-depends: show-combinators, base ghc-options: -Wall default-language: Haskell2010 type: exitcode-stdio-1.0 source-repository head type: git location: https://github.com/Lysxia/show-combinators show-combinators-0.2.0.0/README.md0000644000000000000000000000140213246237167014622 0ustar0000000000000000# 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. ```haskell data MyType a = C a a -- a regular constructor | a :+: a -- an infix constructor | R { f1 :: a, f2 :: a } -- a record infixl 4 :+: 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 (R {f1 = e, f2 = f}) = showRecord "R" ("f1" .=. e &| "f2" .=. f) ``` show-combinators-0.2.0.0/CHANGELOG.md0000644000000000000000000000034313635750511015152 0ustar0000000000000000# 0.2.0.0 - Fix a bug where `showRecord` would not parenthesize the output if a high enough precedence were supplied. # 0.1.1.0 - Added `showInfixl`, `showInfixr`, `showInfixl'`, `showInfixr'`. # 0.1.0.0 Initial version