Fix String instance and add prop tests

src/Data/Text/Display.hs

@@ -41,12 +41,12 @@ import Data.List.NonEmpty
 import Data.Text (Text)
 import Data.Text.Lazy.Builder (Builder)
 import Data.Word
-import GHC.Show (showLitString)
 import GHC.TypeLits
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Lazy.Builder.Int as TB
 import qualified Data.Text.Lazy.Builder.RealFloat as TB
+import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Data.Proxy
 
@@ -276,10 +276,10 @@ deriving via (ShowInstance Bool) instance Display Bool
 -- | @since 0.0.1.0
 instance Display Char where
   displayBuilder '\'' = "'\\''"
-  displayBuilder c = "'" <> TB.singleton c <> "\'"
+  displayBuilder c = TB.fromText $ T.singleton c
   -- 'displayList' is overloaded, so that when the @Display [a]@ instance calls 'displayList',
   -- we end up with a nice string enclosed between double quotes.
-  displayList cs = TB.fromString $ "\"" <> showLitString cs "\""
+  displayList cs = TB.fromText $ T.pack cs
 
 -- | Lazy 'TL.Text'
 --

test/Main.hs

@@ -8,8 +8,9 @@ module Main where
 
 import Data.ByteString
 import Data.List.NonEmpty
-import Data.Text (Text)
 import Test.Hspec
+import Test.Hspec.QuickCheck
+import Data.Text.Arbitrary
 import Test.ShouldNotTypecheck (shouldNotTypecheck)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
@@ -34,7 +35,7 @@ data OpaqueType = OpaqueType Int
 
 spec :: Spec
 spec = do
-  describe "Display Tests" $ do
+  describe "Display Tests:" $ do
     it "Display instance for Text stays the same" $
       display ("3" :: Text) `shouldBe` ("3" :: Text)
     it "Deriving via its own Show instance works" $
@@ -59,28 +60,36 @@ spec = do
       T.unpack (display nestedMaybe) `shouldBe` show nestedMaybe
     it "Nothing instance is equivalent to Show" $ do
       T.unpack (display (Nothing @Bool)) `shouldBe` show (Nothing @Bool)
-    it "String instance is equivalent to Show" $ do
-      let string = "Bonjour \"tout le monde\" !" :: String
-      T.unpack (display string) `shouldBe` show string
-    it "Char 'c' instance is equivalent to Show" $ do
-      T.unpack (display 'c') `shouldBe` show 'c'
     it "Char '\'' instance is equivalent to Show" $ do
       T.unpack (display '\'') `shouldBe` show '\''
     it "2-Tuple instance is equivalent to Show" $ do
       let tuple = (1 :: Int, True)
       T.unpack (display tuple) `shouldBe` show tuple
     it "3-Tuple instance is equivalent to Show" $ do
       let tuple = (1 :: Int, True, "hahahha" :: String)
-      T.unpack (display tuple) `shouldBe` show tuple
+      display tuple `shouldBe` "(" <> display (1 :: Int) <> "," <> display True <> "," <> display @String "hahahha" <> ")"
+
+  describe "Display props:" $ do
+    prop "Text instance stays the same" $ do
+      \string -> display (string :: Text) `shouldBe` string
+    prop "String instance is equivalent to Text" $ do
+      \string -> display (string :: String) `shouldBe` T.pack string
+    prop "Chars are packed" $
+      \c -> display (c :: Char) `shouldBe` T.singleton c
 
+  describe "Forbidden instances" $ do
     it "Should not compile for a function instance" $
       shouldNotTypecheck (display id) `shouldThrow` anyErrorCall
     it "Should not compile for ByteStrings" $
       let bs = "badstring" :: ByteString
        in shouldNotTypecheck (display bs) `shouldThrow` anyErrorCall
 
   describe "displayParen tests" $ do
-    it "surrounds with parens when True" $
+    it "Surrounds with parens when True" $
       displayParen True "foo" `shouldBe` "(foo)"
-    it "doesn't surround with parens when False" $
+    it "Doesn't surround with parens when False" $
       displayParen False "foo" `shouldBe` "foo"
+    it "Surrounds deeply-nested Maybes with a prec of 10" $
+      displayPrec 10 (Just (Just (Just (3 :: Int)))) `shouldBe` "Just (Just (Just 3))"
+    it "Surrounds deeply-nested Maybes with a prec of 11" $
+      displayPrec 11 (Just (Just (Just (3 :: Int)))) `shouldBe` "(Just (Just (Just 3)))"

text-display.cabal

@@ -59,3 +59,4 @@ test-suite text-display-test
     , hspec
     , text
     , should-not-typecheck
+    , quickcheck-text