diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2018, Monadfix
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Monadfix nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
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/exe/Main.hs b/exe/Main.hs
new file mode 100644
--- /dev/null
+++ b/exe/Main.hs
@@ -0,0 +1,11 @@
+module Main where
+
+import Shower (showerString)
+import Control.Exception (evaluate)
+import System.Exit (die)
+
+main :: IO ()
+main = do
+  s <- getContents
+  _ <- evaluate (length s) -- strict 'getContents'
+  either die putStrLn $ showerString s
diff --git a/lib/Shower.hs b/lib/Shower.hs
new file mode 100644
--- /dev/null
+++ b/lib/Shower.hs
@@ -0,0 +1,21 @@
+module Shower
+  ( shower,
+    showerString
+  ) where
+
+import Data.Bifunctor (bimap)
+import Text.Megaparsec (parse, errorBundlePretty, eof)
+import Shower.Parser (pShower)
+import Shower.Printer (showerRender)
+
+shower :: Show a => a -> String
+shower a =
+  case showerString s of
+    Left _ -> s
+    Right s' -> s'
+  where
+    s = show a
+
+showerString :: String -> Either String String
+showerString s =
+  bimap errorBundlePretty showerRender (parse (pShower <* eof) "" s)
diff --git a/lib/Shower/Class.hs b/lib/Shower/Class.hs
new file mode 100644
--- /dev/null
+++ b/lib/Shower/Class.hs
@@ -0,0 +1,21 @@
+module Shower.Class where
+
+-- A tagless final encoding for a result builder (ShowS, Doc, Html, etc).
+--
+-- Note that 'showerStringLit' and 'showerCharLit' take exact uninterpreted
+-- strings to avoid losing information (e.g. "\n" vs. "\10").
+class Shower a where
+  -- { x = 24, y = 42 }
+  showerRecord :: [(a, a)] -> a
+  -- [1, 2, 3]
+  showerList :: [a] -> a
+  -- (1, 2, 3)
+  showerTuple :: [a] -> a
+  -- "hello, (world)"
+  showerStringLit :: String -> a
+  -- '('
+  showerCharLit :: String -> a
+  -- variable names, numeric literals, etc
+  showerAtom :: String -> a
+  -- whitespace-separated
+  showerSpace :: [a] -> a
diff --git a/lib/Shower/Parser.hs b/lib/Shower/Parser.hs
new file mode 100644
--- /dev/null
+++ b/lib/Shower/Parser.hs
@@ -0,0 +1,83 @@
+module Shower.Parser (pShower) where
+
+import Data.Void
+import Data.Char
+import Text.Megaparsec
+import Text.Megaparsec.Char
+
+import Shower.Class
+
+type Parser = Parsec Void String
+
+pLexeme :: Parser a -> Parser a
+pLexeme p = p <* space
+
+pShower :: Shower a => Parser a
+pShower = space *> pExpr
+
+pExpr :: Shower a => Parser a
+pExpr = showerSpace <$> some pPart
+
+pPart :: Shower a => Parser a
+pPart =
+  pRecord <|>
+  pList <|>
+  pTuple <|>
+  pStringLit <|>
+  pCharLit <|>
+  pAtom
+
+pRecord :: Shower a => Parser a
+pRecord = do
+  _ <- pLexeme (char '{')
+  fields <- pField `sepBy` pLexeme (char ',')
+  _ <- pLexeme (char '}')
+  return (showerRecord fields)
+
+pField :: Shower a => Parser (a, a)
+pField = do
+  name <- pExpr
+  _ <- pLexeme (char '=')
+  value <- pExpr
+  return (name, value)
+
+pList :: Shower a => Parser a
+pList = do
+  _ <- pLexeme (char '[')
+  elements <- pExpr `sepBy` pLexeme (char ',')
+  _ <- pLexeme (char ']')
+  return (showerList elements)
+
+pTuple :: Shower a => Parser a
+pTuple = do
+  _ <- pLexeme (char '(')
+  elements <- pExpr `sepBy` pLexeme (char ',')
+  _ <- pLexeme (char ')')
+  return (showerTuple elements)
+
+pStringLit :: Shower a => Parser a
+pStringLit =
+  pLexeme $ do
+    _ <- char '"'
+    s <- manyTill pStringPart (char '"')
+    return (showerStringLit (concat s))
+  where
+    pStringPart = string "\\\"" <|> ((:[]) <$> anySingle)
+
+pCharLit :: Shower a => Parser a
+pCharLit =
+  pLexeme $ try $ do
+    _ <- char '\''
+    c <- string "\\'" <|> ((:[]) <$> anySingle)
+    _ <- char '\''
+    return (showerCharLit c)
+
+pAtom :: Shower a => Parser a
+pAtom =
+  pLexeme $ do
+    s <- some (satisfy atomChar)
+    return (showerAtom s)
+  where
+    atomChar c =
+      not (c `elem` "()[]{},=") &&
+      not (isSpace c)
diff --git a/lib/Shower/Printer.hs b/lib/Shower/Printer.hs
new file mode 100644
--- /dev/null
+++ b/lib/Shower/Printer.hs
@@ -0,0 +1,53 @@
+module Shower.Printer where
+
+import Data.Coerce
+import qualified Text.PrettyPrint as PP
+
+import Shower.Class
+
+newtype ShowerDoc = SD PP.Doc
+
+instance Shower ShowerDoc where
+  showerRecord = coerce showerRecord'
+  showerList = coerce showerList'
+  showerTuple = coerce showerTuple'
+  showerStringLit = coerce showerStringLit'
+  showerCharLit = coerce showerCharLit'
+  showerSpace = coerce showerSpace'
+  showerAtom = coerce showerAtom'
+
+showerRecord' :: [(PP.Doc, PP.Doc)] -> PP.Doc
+showerRecord' fields =
+  PP.braces (PP.nest 2 (showerFields fields))
+  where
+    showerFields = PP.sep . PP.punctuate PP.comma . map showerField
+    showerField (name, x) = PP.hang (name PP.<+> PP.equals) 2 x
+
+showerList' :: [PP.Doc] -> PP.Doc
+showerList' elements =
+  PP.brackets (PP.nest 2 (showerElements elements))
+  where
+    showerElements = PP.sep . PP.punctuate PP.comma
+
+showerTuple' :: [PP.Doc] -> PP.Doc
+showerTuple' elements =
+  PP.parens (PP.nest 2 (showerElements elements))
+  where
+    showerElements = PP.sep . PP.punctuate PP.comma
+
+showerSpace' :: [PP.Doc] -> PP.Doc
+showerSpace' (x:xs) = PP.hang x 2 (PP.sep xs)
+showerSpace' xs = PP.sep xs
+
+showerAtom' :: String -> PP.Doc
+showerAtom' = PP.text
+
+showerStringLit' :: String -> PP.Doc
+showerStringLit' = PP.doubleQuotes . PP.text
+
+showerCharLit' :: String -> PP.Doc
+showerCharLit' = PP.quotes . PP.text
+
+showerRender :: ShowerDoc -> String
+showerRender (SD showerDoc) =
+  PP.renderStyle PP.style{ PP.lineLength = 80 } showerDoc ++ "\n"
diff --git a/shower.cabal b/shower.cabal
new file mode 100644
--- /dev/null
+++ b/shower.cabal
@@ -0,0 +1,58 @@
+name: shower
+version: 0.1
+synopsis: Clean up the formatting of 'show' output
+-- description:
+license: BSD3
+license-file: LICENSE
+author: Vladislav Zavialov
+maintainer: Monadfix <hi@monadfix.io>
+category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+homepage: https://monadfix.io/shower
+bug-reports: http://github.com/monadfix/shower/issues
+
+source-repository head
+  type: git
+  location: git://github.com/monadfix/shower.git
+
+library
+  exposed-modules:
+    Shower
+    Shower.Printer
+    Shower.Parser
+    Shower.Class
+  build-depends:
+    base >=4.10 && <4.13,
+    megaparsec,
+    pretty
+  hs-source-dirs: lib
+  default-language: Haskell2010
+  ghc-options: -Wall -O2
+
+executable shower
+  main-is: Main.hs
+  build-depends:
+    base >=4.10 && <4.13,
+    shower
+  hs-source-dirs: exe
+  default-language: Haskell2010
+  ghc-options: -Wall -O2
+
+test-suite shower-tests
+  main-is: Main.hs
+  type: exitcode-stdio-1.0
+  build-depends:
+    base >=4.10 && <4.13,
+    tasty,
+    tasty-golden,
+    containers,
+    filepath,
+    directory,
+    process,
+    temporary,
+    shower
+  hs-source-dirs: tests
+  default-language: Haskell2010
+  ghc-options: -Wall -Wno-missing-signatures
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import Data.Set (Set)
+import Data.Map (Map)
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Foldable
+import Data.Traversable
+import Control.Monad
+
+import Control.Exception
+
+import System.Directory
+import System.FilePath
+import System.Process
+import System.IO
+import System.IO.Temp
+import System.Exit
+
+import Test.Tasty
+import Test.Tasty.Golden.Advanced
+
+import Shower
+
+main :: IO ()
+main = do
+  inOutTests <- mkInOutTests
+  defaultMain $
+    testGroup "Shower" [inOutTests]
+
+mkInOutTests :: IO TestTree
+mkInOutTests = do
+  currentDir <- getCurrentDirectory
+  let inOutDir = currentDir </> "tests/in-out/"
+  inOutFilePaths <- listDirectory inOutDir
+  case zipInOutFilePaths (map (inOutDir </>) inOutFilePaths) of
+    Left ZipInOutFail{..} -> do
+      let
+        reportPathSet xs msg =
+          unless (Set.null xs) $ do
+            putStrLn msg
+            traverse_ (putStrLn . ("  "++)) xs
+      reportPathSet ziofBadExtension "Bad extension, expected .in or .out:"
+      reportPathSet ziofInWithoutOut "In-file has no accompanying out-file:"
+      reportPathSet ziofOutWithoutIn "Out-file has no accompanying in-file:"
+      exitFailure
+    Right zippedPaths -> do
+      testCases <- for (Map.toList zippedPaths) $
+        \(testName, InOut inFilePath outFilePath) -> do
+          let got = do
+                inFile <- readFile inFilePath
+                case showerString inFile of
+                  Left parseError -> throwIO (ErrorCall parseError)
+                  Right s -> pure s
+          pure $ diffTest testName outFilePath got
+      return (testGroup "in/out" testCases)
+
+data ZipInOutFail =
+  ZipInOutFail
+    { ziofBadExtension :: Set FilePath,
+      ziofInWithoutOut :: Set FilePath,
+      ziofOutWithoutIn :: Set FilePath }
+
+data InOut a = InOut a a
+
+zipInOutFilePaths :: [FilePath] -> Either ZipInOutFail (Map TestName (InOut FilePath))
+zipInOutFilePaths filePaths =
+  let
+    (badExt, inExt, outExt) = go ([], [], []) filePaths
+    inWithoutOut = (Set.fromList . Map.elems) (inExt Map.\\ outExt)
+    outWithoutIn = (Set.fromList . Map.elems) (outExt Map.\\ inExt)
+    zippedPaths = Map.intersectionWith InOut inExt outExt
+  in
+    if
+      Set.null badExt &&
+      Set.null inWithoutOut &&
+      Set.null outWithoutIn
+    then
+      Right zippedPaths
+    else
+      Left ZipInOutFail
+        { ziofBadExtension = badExt,
+          ziofInWithoutOut = inWithoutOut,
+          ziofOutWithoutIn = outWithoutIn }
+  where
+    go (accBadExt, accInExt, accOutExt) [] =
+      ( Set.fromList accBadExt,
+        Map.fromList accInExt,
+        Map.fromList accOutExt )
+    go (accBadExt, accInExt, accOutExt) (p:ps) =
+      let
+        fileName = takeFileName p
+        (name, ext) = splitExtensions fileName
+      in
+        case ext of
+          ".in"  -> go (accBadExt, (name, p) : accInExt, accOutExt) ps
+          ".out" -> go (accBadExt, accInExt, (name, p) : accOutExt) ps
+          _ -> go (p:accBadExt, accInExt, accOutExt) ps
+
+-- | Output differences between a file and a string using @git diff@.
+diffTest
+  :: TestName
+  -> FilePath   -- ^ Expected ".out" file
+  -> IO String  -- ^ Actual output
+  -> TestTree
+diffTest name ref got =
+  goldenTest name (readFile ref) got cmp (writeFile ref)
+  where
+    template = takeFileName ref <.> "actual"
+    diffParams = ["--no-index", "--color", "--word-diff-regex=."]
+    cmp _ actual = withSystemTempFile template $ \tmpFile tmpHandle -> do
+      hPutStr tmpHandle actual >> hFlush tmpHandle
+      let diffProc = proc "git" (["diff"] ++ diffParams ++ [ref, tmpFile])
+      (exitCode, out, _) <- readCreateProcessWithExitCode diffProc ""
+      return $ case exitCode of
+        ExitSuccess -> Nothing
+        _ -> Just (unlines . drop 4 . lines $ out)  -- drop diff header