diff --git a/CHANGELOG.md b/CHANGELOG.md index f694231..4219ebd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,10 @@ SPDX-License-Identifier: MPL-2.0 ## Unreleased +### Added + +- `utf8-troubleshoot` – the troubleshooting tool + ## 1.0.0.0 diff --git a/README.md b/README.md index 21f9e95..5688a76 100644 --- a/README.md +++ b/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 diff --git a/app/utf8-troubleshoot/Main.hs b/app/utf8-troubleshoot/Main.hs new file mode 100644 index 0000000..3d489d3 --- /dev/null +++ b/app/utf8-troubleshoot/Main.hs @@ -0,0 +1,89 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- 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 diff --git a/package.yaml b/package.yaml index 6a3ffd3..65b9138 100644 --- a/package.yaml +++ b/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