troubleshoot: Make the troubleshooting tool

CHANGELOG.md

@@ -8,6 +8,10 @@ SPDX-License-Identifier: MPL-2.0
 
 ## Unreleased
 
+### Added
+
+- `utf8-troubleshoot` – the troubleshooting tool
+
 
 ## 1.0.0.0
 

README.md

@@ -80,6 +80,16 @@ _Note: there is no `System.IO.Utf8.writeFile`._
 If, for some reason, you really need to use `withFile`/`openFile` from `base`,
 do the same as in the previous step.
 
+## Troubleshooting
+
+Locales are pretty straightforward, but some people might have their terminals
+misconfigured for various reasons. To help troubleshoot any potential issues,
+this package comes with a tool called `utf8-troubleshoot`.
+
+This tool outputs some basic information about locale settings in the OS and
+what they end up being mapped to in Haskell. If you are looking for help,
+please, provide the output of this tool, or if you are helping someone,
+ask them to run this tool and provide the output.
 
 ## Contributing
 

app/utf8-troubleshoot/Main.hs

@@ -0,0 +1,89 @@
+-- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/>
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+import Prelude hiding (print, putStr, putStrLn)
+
+import GHC.IO.Encoding (getLocaleEncoding, initLocaleEncoding)
+import GHC.Show (showLitString)
+import System.Directory (doesDirectoryExist, doesPathExist, listDirectory)
+import System.Environment (lookupEnv)
+import System.IO (hGetEncoding, stderr, stdout)
+
+
+import qualified Prelude as P
+
+
+-- | Encode a 'String' to be safe to print in ASCII-only.
+protect :: String -> String
+protect s = showLitString s ""
+
+
+putStr :: String -> IO ()
+putStr = P.putStr . protect
+
+putStrLn :: String -> IO ()
+putStrLn = P.putStrLn . protect
+
+
+showGhc :: IO ()
+showGhc = do
+    putStrLn "# GHC"
+    putStrLn $ "  * initLocaleEncoding = " <> show initLocaleEncoding
+    getLocaleEncoding >>= \e -> putStrLn $ "  * locale encoding = " <> show e
+    hGetEncoding stdout >>= \e -> putStrLn $ "  * stdout = " <> show e
+    hGetEncoding stderr >>= \e -> putStrLn $ "  * stderr = " <> show e
+
+showEnv :: IO ()
+showEnv = do
+    putStrLn "# Environment"
+    mapM_ showVar
+      [ "LANG"
+      , "LC_COLLATE"
+      , "LC_CTYPE"
+      , "LC_MESSAGES"
+      , "LC_MONETARY"
+      , "LC_NUMERIC"
+      , "LC_TIME"
+      , "LC_ALL="
+      ]
+  where
+    showVar :: String -> IO ()
+    showVar name = do
+      putStr $ "  * " <> name <> " "
+      lookupEnv name >>= \case
+        Nothing -> putStrLn "is not set"
+        Just v -> putStrLn $ "= " <> v
+
+showLocaleArchive :: IO ()
+showLocaleArchive = do
+    putStrLn "# Locale archive"
+    lookupEnv "LOCPATH" >>= \case
+      Nothing -> listDir localePath
+      Just p
+        | p == localePath -> listDir localePath
+        | otherwise -> listDir p *> listDir localePath
+  where
+    localePath :: FilePath
+    localePath = "/usr/share/locale"
+
+    listDir :: FilePath -> IO ()
+    listDir path = doesPathExist path >>= \case
+      False -> putStrLn $ "  * " <> path <> " does not exist."
+      True -> doesDirectoryExist path >>= \case
+        False -> putStrLn $ "  * " <> path <> " is not a directory."
+        True -> do
+          putStrLn $ "  * " <> path <> ":"
+          listDirectory path >>= mapM_ (\item ->
+            putStrLn $ "    * " <> item)
+
+
+main :: IO ()
+main = do
+  showGhc
+  showEnv
+  showLocaleArchive

package.yaml

@@ -44,6 +44,15 @@ library:
     - safe-exceptions >= 0.1 && < 0.2  # only really needed for polymorphic bracket
     - text >= 0.7 && < 1.3
 
+executables:
+  utf8-troubleshoot:
+    source-dirs: app/utf8-troubleshoot
+    main: Main.hs
+
+    dependencies:
+      - base
+      - directory
+
 tests:
   with-utf8-test:
     source-dirs: test