show-combinators (empty) → 0.1.0.0
raw patch · 6 files changed
+252/−0 lines, 6 filesdep +basedep +show-combinatorssetup-changed
Dependencies added: base, show-combinators
Files
- LICENSE +19/−0
- README.md +19/−0
- Setup.hs +2/−0
- show-combinators.cabal +38/−0
- src/Text/Show/Combinators.hs +132/−0
- test/test.hs +42/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright 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.
+ README.md view
@@ -0,0 +1,19 @@+# 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)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ show-combinators.cabal view
@@ -0,0 +1,38 @@+name: show-combinators+version: 0.1.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+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules:+ Text.Show.Combinators+ build-depends:+ base >= 4.9 && < 5+ 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
+ src/Text/Show/Combinators.hs view
@@ -0,0 +1,132 @@+-- | Combinators for 'Show'+--+-- The combinators below can be used 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+ , showCon+ , showApp+ , (@|)+ , showInfix+ , showInfix'+ , 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.+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 showX showY d = showParen (d > prec)+ (showX (prec + 1) . showSpace . showString op . showSpace . showY (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)++-- | 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 _ =+ 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
+ test/test.hs view
@@ -0,0 +1,42 @@+import 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)++check :: Show a => (a -> PrecShowS) -> a -> IO ()+check show' x =+ if s == s' then+ return ()+ else+ fail $ show (s, s')+ where+ s = show x+ s' = show' x 0 ""++main :: IO ()+main = do+ check smt1 (C () ())+ check smt2 (C (C () ()) (() :+: ()))+ check smt2 ((() :+: ()) :+: (() :+: ()))+ check smt2 (R (C () ()) (C () ()))+ where+ smt1 = showsMyType (flip showsPrec)+ smt2 = showsMyType smt1