diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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)
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/show-combinators.cabal b/show-combinators.cabal
new file mode 100644
--- /dev/null
+++ b/show-combinators.cabal
@@ -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
diff --git a/src/Text/Show/Combinators.hs b/src/Text/Show/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Show/Combinators.hs
@@ -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
diff --git a/test/test.hs b/test/test.hs
new file mode 100644
--- /dev/null
+++ b/test/test.hs
@@ -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
