[#334] showUnicodeText

src/Toml/Type/Printer.hs

@@ -20,6 +20,7 @@ module Toml.Type.Printer
        ) where
 
 import Data.Bifunctor (first)
+import Data.Char (isAscii, ord)
 import Data.Coerce (coerce)
 import Data.Function (on)
 import Data.HashMap.Strict (HashMap)
@@ -29,6 +30,8 @@ import Data.Semigroup (stimes)
 import Data.Text (Text)
 import Data.Time (ZonedTime, defaultTimeLocale, formatTime)
 
+import Text.Printf (printf)
+
 import Toml.Type.AnyValue (AnyValue (..))
 import Toml.Type.Key (Key (..), Piece (..))
 import Toml.Type.PrefixTree (PrefixMap, PrefixTree (..))
@@ -40,6 +43,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Text as Text
 
 
+
 {- | Configures the pretty printer.
 
 @since 0.5.0
@@ -161,7 +165,7 @@ prettyKeyValue options i = mapOrdered (\kv -> [kvText kv]) options . HashMap.toL
     valText (Bool b)    = Text.toLower $ showText b
     valText (Integer n) = showText n
     valText (Double d)  = showDouble d
-    valText (Text s)    = showText s
+    valText (Text s)    = showTextUnicode s
     valText (Zoned z)   = showZonedTime z
     valText (Local l)   = showText l
     valText (Day d)     = showText d
@@ -171,6 +175,17 @@ prettyKeyValue options i = mapOrdered (\kv -> [kvText kv]) options . HashMap.toL
     showText :: Show a => a -> Text
     showText = Text.pack . show
 
+    showTextUnicode :: Text -> Text
+    showTextUnicode text = Text.pack $ show $ foldl (\acc (ch, asciiCh) -> acc ++ getCh ch asciiCh) "" asciiArr
+      where
+        xs = Text.unpack text
+        asciiArr = zip xs $ asciiStatus xs
+        getCh ch True  = [ch]
+        getCh ch False = printf "\\U%08x" ordChr :: String
+          where
+            ordChr = ord ch
+        asciiStatus = map isAscii
+
     showDouble :: Double -> Text
     showDouble d | isInfinite d && d < 0 = "-inf"
                  | isInfinite d = "inf"