diff --git a/src/Data/Text/Display.hs b/src/Data/Text/Display.hs index b57ac20..4a79fe0 100644 --- a/src/Data/Text/Display.hs +++ b/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 @@ -67,13 +67,12 @@ class Display a where -- -- === Example -- + -- > import qualified Data.Text.Lazy.Builder as TB + -- > -- > instance Display Char where - -- > displayBuilder '\'' = "'\\''" - -- > displayBuilder c = "'" <> TB.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 "\"" - -- + -- > displayBuilder c = TB.fromText $ T.singleton c + -- > displayList cs = TB.fromText $ T.pack cs + -- > -- > instance Display a => Display [a] where -- > -- In this instance, 'displayBuilder' is defined in terms of 'displayList', which for most types -- > -- is defined as the default written in the class declaration. @@ -274,12 +273,19 @@ deriving via (ShowInstance ()) instance Display () deriving via (ShowInstance Bool) instance Display Bool -- | @since 0.0.1.0 +-- 'displayList' is overloaded, so that when the @Display [a]@ instance calls 'displayList', +-- we end up with a nice string instead of a list of chars between brackets. +-- +-- >>> display [1, 2, 3] +-- "[1,2,3]" +-- +-- >>> display ['h', 'e', 'l', 'l', 'o'] +-- "hello" instance Display Char where - displayBuilder '\'' = "'\\''" - displayBuilder c = "'" <> TB.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 "\"" + -- This instance's implementation is used in the haddocks of the typeclass. + -- If you change it, reflect the change in the documentation. + displayBuilder c = TB.fromText $ T.singleton c + displayList cs = TB.fromText $ T.pack cs -- | Lazy 'TL.Text' -- diff --git a/test/Main.hs b/test/Main.hs index 476258a..c8e2882 100644 --- a/test/Main.hs +++ b/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,20 +60,24 @@ 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 "Char '\'' instance is equivalent to Text" $ do + display '\'' `shouldBe` T.singleton '\'' 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" $ @@ -80,7 +85,11 @@ spec = do 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)))" diff --git a/text-display.cabal b/text-display.cabal index 2247b93..310a8ab 100644 --- a/text-display.cabal +++ b/text-display.cabal @@ -59,3 +59,4 @@ test-suite text-display-test , hspec , text , should-not-typecheck + , quickcheck-text