unicode-show 0.1.0.3 → 0.1.0.4
raw patch · 3 files changed
+63/−84 lines, 3 filesdep +hspecdep −HUnitdep −test-frameworkdep −test-framework-hunit
Dependencies added: hspec
Dependencies removed: HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- src/Text/Show/Unicode.hs +19/−40
- test/Spec.hs +42/−39
- unicode-show.cabal +2/−5
src/Text/Show/Unicode.hs view
@@ -47,52 +47,28 @@ -} - module Text.Show.Unicode (ushow, uprint, ushowWith, uprintWith) where -import Control.Applicative ((<$>), (<$), (<|>))-import GHC.Read (readLitChar)-import Data.Char(isPrint)-import Text.ParserCombinators.ReadP--+import Control.Applicative ((<|>))+import Data.Char (isPrint)+import Text.ParserCombinators.ReadP+import Text.Read.Lex (lexChar) +-- Represents a replaced character using its literal form and its escaped form. type Replacement = (String, String) --- | Parse a value of type 'a', toghether with the original representation.--- This is needed because a quotation mark character can be represented in two ways ------ @"@ or @\\"@ , and we'd like to preserve both representations.--readsWithMatch :: ReadS a -> ReadS (a, String)-readsWithMatch parser input =- [ ((ret, take (length input - length leftover) input), leftover)- | (ret, leftover) <- parser input]- -- | Parse one Haskell character literal expression from a 'String' produced by 'show', and -- -- * If the found char satisfies the predicate, replace the literal string with the character itself. -- * Otherwise, leave the string as it was. -- * Note that special delimiter sequence "\&" may appear in a string. c.f. <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6 Section 2.6 of the Haskell 2010 specification>.- recoverChar :: (Char -> Bool) -> ReadP Replacement-recoverChar p = (represent <$> readS_to_P (readsWithMatch readLitChar)) <|> (("\\&","\\&") <$ string "\\&")- where- represent :: (Char, String) -> Replacement- represent (c,original) | p c = (original, [c])- represent (_,original) = (original, original)---- | Parse many Haskell character literals from the input,--- and concatenate them.-reparse :: (Char -> Bool) -> ReadP String-reparse p = cat2 ("","") <$> many (recoverChar p)+recoverChar p = (represent <$> gather lexChar) <|> (("\\&","\&") <$ string "\\&") where- -- concatenate while removing redundant separator.- cat2 :: Replacement -> [Replacement] -> String- cat2 _ [] = ""- cat2 (pb,pa) ((xb,xa):xs)- | pb /= pa && xb == "\\&" = cat2 (xb,xa) xs- | otherwise = xa ++ cat2 (xb,xa) xs-+ represent :: (String, Char) -> Replacement+ represent (o,lc)+ | p lc = (o, [lc])+ | otherwise = (o, o) -- | Show the input, and then replace Haskell character literals -- with the character it represents, for any Unicode printable characters except backslash, single and double quotation marks.@@ -104,15 +80,18 @@ uprint :: Show a => a -> IO () uprint = putStrLn . ushow - -- | Show the input, and then replace character literals -- with the character itself, for characters that satisfy the given predicate. ushowWith :: Show a => (Char -> Bool) -> a -> String-ushowWith p x = let showx = show x in case readP_to_S (reparse p) $ showx of- [] -> showx- ys -> case last ys of- (ret,"") -> ret- _ -> showx+ushowWith p x = go ("", "") $ readP_to_S (many $ recoverChar p) (show x)+ where+ go :: Replacement -> [([Replacement], String)] -> String+ go _ [] = ""+ go _ (([],""):_) = ""+ go _ ((rs,""):_) = snd $ last rs+ go _ ((_,o):[]) = o+ go pr (([],_):rest) = go pr rest+ go _ ((rs,_):rest) = let r = last rs in snd r ++ go r rest -- | A version of 'print' that uses 'ushowWith'. uprintWith :: Show a => (Char -> Bool) -> a -> IO ()
test/Spec.hs view
@@ -1,55 +1,58 @@ {-# LANGUAGE ScopedTypeVariables #-} -import Test.Framework (defaultMain, testGroup)-import Test.Framework.Providers.API (Test)-import Test.Framework.Providers.HUnit (testCase)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.HUnit.Base hiding (Test)+import Test.Hspec+import Test.Hspec.QuickCheck -import Text.Show.Unicode+import Text.Show.Unicode data T試6験 = Å4 { すけろく :: String} deriving (Eq, Ord, Show, Read) data T試7験 = String :@\& String deriving (Eq, Ord, Show, Read) data T試8験 = String :＠\& String deriving (Eq, Ord, Show, Read) -ushowTo :: Show a => a -> String -> Test-ushowTo f t = testCase ("ushow " ++ show f ++ " == " ++ t) $ t @=? ushow f+ushowTo :: Show a => a -> String -> Spec+ushowTo f t = it ("ushow " ++ show f ++ " == " ++ t) $ t `shouldBe` ushow f -tests :: [Test]-tests =- [ testGroup "individual representations test"- [ "صباح الخير" `ushowTo` "\"صباح الخير\""- , "😆💕>λ\\=🐘" `ushowTo` "\"😆💕>λ\\\\=🐘\""- , "漢6" `ushowTo` "\"漢6\""- , "\32\&7" `ushowTo` "\" 7\""- , "改\n行" `ushowTo` "\"改\\n行\""- , "下一站\na\ri\ta国际机场" `ushowTo` "\"下一站\\na\\ri\\ta国际机场\""- , "\SOH\SO\&H" `ushowTo` "\"\\SOH\\SO\\&H\""- ]+spec :: Spec+spec =+ describe "individual representations test" $ do+ describe "individual representations test" $ do+ "صباح الخير" `ushowTo` "\"صباح الخير\""+ "😆💕>λ\\=🐘" `ushowTo` "\"😆💕>λ\\\\=🐘\""+ "漢6" `ushowTo` "\"漢6\""+ "\32\&7" `ushowTo` "\" 7\""+ "改\n行" `ushowTo` "\"改\\n行\""+ "下一站\na\ri\ta国际机场" `ushowTo` "\"下一站\\na\\ri\\ta国际机场\""+ "\SOH\SO\&H" `ushowTo` "\"\\SOH\\SO\\&H\"" - , testGroup "read . ushow == id"- [ testProperty "read . ushow == id, for String" $- \str -> read (ushow str) == (str :: String)- , testProperty "read . ushow == id, for Char" $- \x -> read (ushow x) == (x :: Char)- , testProperty "read . ushow == id, for [(Char,())]" $- \x -> read (ushow x) == (x :: [(Char,())])- , testProperty "read . read . ushow . ushow == id, for String" $- \str -> (read $ read $ ushow $ ushow str) == (str :: String)- , testProperty "read . ushow == id, for some crazy Unicode type" $- \str -> let v = Å4 str in read (ushow v) == v- , testProperty "read . ushow == id, for some crazy Unicode type" $- \a b -> let v = a :@\& b in read (ushow v) == v- , testProperty "read . ushow == id, for some crazy Unicode type" $- \a b -> let v = a :＠\& b in read (show v) == v- , testProperty "read . ushow == id, for compound type" $- \str -> read (ushow str) == (str :: Either [String] (String,String))- ]- ]+ describe "read . ushow == id" $ do+ prop "read . ushow == id, for String" $+ \str -> read (ushow str) `shouldBe` (str :: String)++ prop "read . ushow == id, for Char" $+ \x -> read (ushow x) `shouldBe` (x :: Char)++ prop "read . ushow == id, for [(Char,())]" $+ \x -> read (ushow x) `shouldBe` (x :: [(Char,())])++ prop "read . read . ushow . ushow == id, for String" $+ \str -> (read $ read $ ushow $ ushow str) `shouldBe` (str :: String)++ prop "read . ushow == id, for some crazy Unicode type" $+ \str -> let v = Å4 str in read (ushow v) `shouldBe` v++ prop "read . ushow == id, for some crazy Unicode type" $+ \a b -> let v = a :@\& b in read (ushow v) `shouldBe` v++ prop "read . ushow == id, for some crazy Unicode type" $+ \a b -> let v = a :＠\& b in read (ushow v) `shouldBe` v++ prop "read . ushow == id, for compound type" $+ \str -> read (ushow str) `shouldBe` (str :: Either [String] (String,String))+ main :: IO () main = do print $ "hoge" :@\& "huga" putStrLn $ ushow $ "hoge" :@\& "huga"- defaultMain tests+ hspec spec
unicode-show.cabal view
@@ -1,5 +1,5 @@ name: unicode-show-version: 0.1.0.3+version: 0.1.0.4 synopsis: print and show in unicode description: This package provides variants of 'show' and 'print' functions that does not escape non-ascii characters.@@ -33,12 +33,9 @@ hs-source-dirs: test main-is: Spec.hs build-depends: base- , HUnit+ , hspec , QuickCheck , unicode-show- , test-framework- , test-framework-hunit- , test-framework-quickcheck2 ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010