unicode-show 0.1.1.0 → 0.1.1.1
raw patch · 3 files changed
+89/−88 lines, 3 filesdep +safedep +transformersPVP ok
version bump matches the API change (PVP)
Dependencies added: safe, transformers
API changes (from Hackage documentation)
Files
- src/Text/Show/Unicode.hs +49/−47
- test/Spec.hs +36/−39
- unicode-show.cabal +4/−2
src/Text/Show/Unicode.hs view
@@ -49,48 +49,19 @@ module Text.Show.Unicode (ushow, uprint, urecover, ushowWith, uprintWith, urecoverWith) where -import Control.Applicative ((<|>))-import Data.Char (isAscii, isPrint)-import Text.ParserCombinators.ReadP-import Text.Read.Lex (lexChar)-import qualified Data.List as L+import Control.Monad.Trans.State.Strict (StateT (StateT, runStateT),+ get, put)+import Data.Char (isAscii, isPrint)+import qualified Data.List as L+import qualified Data.Ord as O+import Safe (minimumByMay)+import Text.ParserCombinators.ReadP (gather, readP_to_S)+import Text.Read.Lex (lexChar) --- Represents a replaced character using its literal form and its escaped form.-type Replacement = (String, String)+-- | Create a parser for less dependencies. ReadP is too slow+type Parser a = StateT String Maybe a --- | 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 <$> gather lexCharAndConsumeEmpties- where- represent :: (String, Char) -> Replacement- represent (o,lc)- -- This is too dirty a hack.- -- However, I couldn't think of any other way to recover the & consumed by lexChar while not needlessly increasing the number of & by mis-detecting the escape sequence.- | p lc =- if head o /= '\\' &&- "\\&" `L.isSuffixOf` o- then (o, lc : "\\&")- else (o, [lc])- | otherwise = (o, o) --- | The base library lexChar has been handling & by itself since 4.9.1.0,--- so consumeEmpties is a meaningless action,--- but it makes sense for older versions of lexChar.-lexCharAndConsumeEmpties :: ReadP Char-lexCharAndConsumeEmpties = lexChar <* consumeEmpties- where- -- Consumes the string "\&" repeatedly and greedily (will only produce one match)- consumeEmpties :: ReadP ()- consumeEmpties = do- rest <- look- case rest of- ('\\':'&':_) -> string "\\&" >> consumeEmpties- _ -> return ()- -- | 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. -- If something fails, fallback to standard 'show'.@@ -118,15 +89,46 @@ -- | Replace character literals with the character itself, for characters that -- satisfy the given predicate. urecoverWith :: (Char -> Bool) -> String -> String-urecoverWith p = go ("", "") . readP_to_S (many $ recoverChar p)+urecoverWith p s =+ case runStateT (recoverChars p) s of+ Just (r, left) -> r ++ left+ Nothing -> s+++recoverChars :: (Char -> Bool) -> Parser String+recoverChars p = outsideLiteral 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+ outsideLiteral = do+ notLit <- untilDoubleQuote+ rest <- get+ case rest of+ '\"' : inLiteral -> do+ put inLiteral+ (notLit ++) . ('\"' :) <$> insideLiteral+ _ ->+ return $ notLit ++ rest++ insideLiteral = do+ recovered <- recoverCharInLiteral+ case recovered of+ ("\"",'"') -> ('"' :) <$> outsideLiteral+ (s, c)+ | p c -> (c :) <$> insideLiteral+ | otherwise -> (s ++) <$> insideLiteral++ untilDoubleQuote = StateT $ Just . L.break (== '\"')+++-- | Parse one Haskell character literal expression from a 'String' produced by 'show', and+-- returns the pair of the string before parsed with the parsed character.+-- * 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>.+recoverCharInLiteral :: Parser (String, Char)+recoverCharInLiteral = StateT $ \s ->+ let result = readP_to_S (gather lexChar) s+ -- The longest match result should leave the shortest string.+ -- So choose the result with the minimum length left.+ in minimumByMay (O.comparing (length . snd)) result+ -- | A version of 'print' that uses 'ushowWith'. uprintWith :: Show a => (Char -> Bool) -> a -> IO ()
test/Spec.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -+import Control.Monad (when) import Test.Hspec import Test.Hspec.QuickCheck import Text.Read (readMaybe)@@ -14,7 +14,7 @@ data T試10験 = String :\&\& String deriving (Eq, Ord, Show, Read) ushowTo :: Show a => a -> String -> Spec-ushowTo f t = it ("ushow " ++ show f ++ " == " ++ t) $ t `shouldBe` ushow f+ushowTo f t = it ("ushow " ++ show f ++ " == " ++ t) $ ushow f `shouldBe` t -- | check `read . ushow == id` when `read . show == id`. -- The reason why we don't test if the show fails is that older versions may fail to read the result of the show,@@ -22,57 +22,54 @@ -- ==> is not used because it will cause an error if there is no test case that can be executed. readUShowIsIdWhenOkPrelude :: (Eq a, Show a, Read a) => a -> Expectation readUShowIsIdWhenOkPrelude v =- if preludeOk- then ushowOk- else pure ()+ when preludeOk ushowOk where preludeOk = readMaybe (show v) == Just v ushowOk = read (ushow v) `shouldBe` v spec :: Spec-spec =+spec = do 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\""+ "صباح الخير" `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\""+ "\"\"" `ushowTo` "\"\\\"\\\"\""+ "\"" `ushowTo` "\"\\\"\""+ "\"unterminated" `ushowTo` "\"\\\"unterminated\"" - describe "read . ushow == id" $ do- prop "read . ushow == id, for String" $- \str -> read (ushow str) `shouldBe` (str :: 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 . 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 . read . ushow . ushow == id, for String" $+ \str -> read (read $ ushow $ ushow str) `shouldBe` (str :: String) - prop "read . ushow == id, for some crazy Unicode type: T試6験" $- \str -> readUShowIsIdWhenOkPrelude $ Å4 str+ prop "read . ushow == id, for some crazy Unicode type: T試6験" $+ \str -> readUShowIsIdWhenOkPrelude $ Å4 str - prop "read . ushow == id, for some crazy Unicode type: T試7験" $- \a b -> readUShowIsIdWhenOkPrelude $ a :@\& b+ prop "read . ushow == id, for some crazy Unicode type: T試7験" $+ \a b -> readUShowIsIdWhenOkPrelude $ a :@\& b - prop "read . ushow == id, for some crazy Unicode type: T試8験" $- \a b -> readUShowIsIdWhenOkPrelude $ a :＠\& b+ prop "read . ushow == id, for some crazy Unicode type: T試8験" $+ \a b -> readUShowIsIdWhenOkPrelude $ a :＠\& b - prop "read . ushow == id, for some crazy Unicode type: T試9験" $- \a b -> readUShowIsIdWhenOkPrelude $ a :\&＠\& b+ prop "read . ushow == id, for some crazy Unicode type: T試9験" $+ \a b -> readUShowIsIdWhenOkPrelude $ a :\&＠\& b - prop "read . ushow == id, for some crazy Unicode type: T試10験" $- \a b -> readUShowIsIdWhenOkPrelude $ a :\&\& b+ prop "read . ushow == id, for some crazy Unicode type: T試10験" $+ \a b -> readUShowIsIdWhenOkPrelude $ a :\&\& b - prop "read . ushow == id, for compound type" $- \str -> read (ushow str) `shouldBe` (str :: Either [String] (String,String))+ 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"- hspec spec+main = hspec spec
unicode-show.cabal view
@@ -1,5 +1,5 @@ name: unicode-show-version: 0.1.1.0+version: 0.1.1.1 synopsis: print and show in unicode description: This package provides variants of 'show' and 'print' functions that does not escape non-ascii characters.@@ -15,7 +15,7 @@ license: BSD3 license-file: LICENSE author: Takayuki Muranushi-maintainer: whosekiteneverfly@gmail.com+maintainer: igrep@n.email.ne.jp copyright: 2016 Takayuki Muranushi category: Text build-type: Simple@@ -26,6 +26,8 @@ hs-source-dirs: src exposed-modules: Text.Show.Unicode build-depends: base >= 4.8.1.0 && < 5+ , transformers >= 0.4.0.0+ , safe >= 0.3.5 default-language: Haskell2010 test-suite unicode-show-test