diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,13 @@ - +## 1.0.2.0 -# Changelog +Improve `utf8-troubleshoot` to make it useful for identifying tricky cases. + +### Changed + +- `utf8-troubleshoot`: improve available locale detection +- `utf8-troubleshoot`: display raw results from C libraries ## 1.0.1.0 diff --git a/app/utf8-troubleshoot/Main.hs b/app/utf8-troubleshoot/Main.hs --- a/app/utf8-troubleshoot/Main.hs +++ b/app/utf8-troubleshoot/Main.hs @@ -2,20 +2,33 @@ -- -- SPDX-License-Identifier: MPL-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +#include + module Main (main) where import Prelude hiding (print, putStr, putStrLn) +import Control.Exception.Safe (catchIO, tryIO) +import Control.Monad (filterM, forM_, when) +import Data.List (sort) +import Data.Maybe (isJust) import Data.Version (showVersion) +import Foreign.C.String (CString, peekCAString) import GHC.IO.Encoding (getLocaleEncoding, initLocaleEncoding) +import GHC.IO.Encoding.Iconv (localeEncodingName) import GHC.Show (showLitString) +import Language.Haskell.TH.Env (envQ) import System.Directory (doesDirectoryExist, doesPathExist, listDirectory) import System.Environment (lookupEnv) +import System.FilePath (()) import System.Info (arch, compilerName, compilerVersion, os) import System.IO (hGetEncoding, stderr, stdout) - +import System.Process (readProcess) import qualified Prelude as P @@ -48,6 +61,21 @@ <> compilerName <> " " <> showVersion compilerVersion showEnvVar "TERM" + -- Nix stuff + let builtNix = isJust ($$(envQ @String "NIX_BUILD_TOP")) + when builtNix $ do + putStrLn " * Built with Nix" + let builtNixShell = isJust ($$(envQ @String "IN_NIX_SHELL")) + when builtNixShell $ do + putStrLn " * Built in nix-shell" + inNixShell <- isJust <$> lookupEnv "IN_NIX_SHELL" + when inNixShell $ do + putStrLn " * Running in nix-shell" + + when (builtNix || builtNixShell) $ do + showEnvVar "LOCALE_ARCHIVE" + + showGhc :: IO () showGhc = do putStrLn "# GHC" @@ -56,46 +84,93 @@ hGetEncoding stdout >>= \e -> putStrLn $ " * stdout = " <> show e hGetEncoding stderr >>= \e -> putStrLn $ " * stderr = " <> show e +showCbits :: IO () +showCbits = do + putStrLn "# C bits" + putStrLn $ " * localeEncodingName = " <> localeEncodingName + showLibcharset + showLanginfoh + where + showLibcharset :: IO () + showLibcharset = do +#if defined(HAVE_LIBCHARSET) + enc <- c_libcharsetEncoding >>= peekCAString + putStrLn $ " * libcharset:locale_charset = " <> enc +#else + putStrLn $ " * No libcharset." +#endif + + showLanginfoh :: IO () + showLanginfoh = do +#if defined(HAVE_LANGINFO_H) + enc <- c_langinfoEncoding >>= peekCAString + putStrLn $ " * langinfo.h:nl_langinfo(CODESET) = " <> enc +#else + putStrLn $ " * No ." +#endif + +#if defined(HAVE_LIBCHARSET) +foreign import ccall unsafe "libcharsetEncoding" + c_libcharsetEncoding :: IO CString +#endif + +#if defined(HAVE_LANGINFO_H) +foreign import ccall unsafe "langinfoEncoding" + c_langinfoEncoding :: IO CString +#endif + showEnv :: IO () showEnv = do putStrLn "# Environment" mapM_ showEnvVar [ "LANG" - , "LC_COLLATE" , "LC_CTYPE" - , "LC_MESSAGES" - , "LC_MONETARY" - , "LC_NUMERIC" - , "LC_TIME" , "LC_ALL=" ] -showLocaleArchive :: IO () -showLocaleArchive = do - putStrLn "# Locale archive" - lookupEnv "LOCPATH" >>= \case - Nothing -> listDir localePath - Just p - | p == localePath -> listDir localePath - | otherwise -> listDir p *> listDir localePath +showLocales :: IO () +showLocales = do + putStrLn "# Locales" + tryIO callLocalectl >>= \case + Right out -> do + putStrLn $ " * localectl list-locales:" + showLocaleList (lines out) + Left _ -> do + listDir "/usr/lib/locale" + listFile "/usr/lib/locale/locale-archive" `catchIO` \e -> + putStrLn $ ": " <> show e where - localePath :: FilePath - localePath = "/usr/share/locale" + showLocaleList :: [String] -> IO () + showLocaleList locales = + forM_ (sort locales) $ \item -> putStrLn $ " * " <> item + callLocalectl :: IO String + callLocalectl = readProcess "localectl" ["list-locales"] "" + listDir :: FilePath -> IO () listDir path = doesPathExist path >>= \case - False -> putStrLn $ " * " <> path <> " does not exist." + False -> putStrLn $ " * " <> path <> " does not exist" True -> doesDirectoryExist path >>= \case - False -> putStrLn $ " * " <> path <> " is not a directory." + False -> putStrLn $ " * " <> path <> " is not a directory" True -> do putStrLn $ " * " <> path <> ":" - listDirectory path >>= mapM_ (\item -> - putStrLn $ " * " <> item) + ls <- listDirectory path >>= filterM (doesDirectoryExist . (path )) + showLocaleList ls + listFile :: FilePath -> IO () + listFile path = doesPathExist path >>= \case + False -> putStrLn $ " * " <> path <> " does not exist" + True -> do + putStrLn $ " * " <> path <> ":" + out <- readProcess "localedef" ["--list", path] "" + showLocaleList (lines out) + + main :: IO () main = do showSystem showGhc + showCbits showEnv - showLocaleArchive + showLocales diff --git a/app/utf8-troubleshoot/cbits/locale.c b/app/utf8-troubleshoot/cbits/locale.c new file mode 100644 --- /dev/null +++ b/app/utf8-troubleshoot/cbits/locale.c @@ -0,0 +1,23 @@ +// SPDX-FileCopyrightText: 2020 Serokell +// +// SPDX-License-Identifier: MPL-2.0 + +#include + +#if !defined(mingw32_HOST_OS) + +#if defined(HAVE_LIBCHARSET) +#include +const char* libcharsetEncoding(void) { + return locale_charset(); +} +#endif + +#if defined(HAVE_LANGINFO_H) +#include +const char* langinfoEncoding(void) { + return nl_langinfo(CODESET); +} +#endif + +#endif diff --git a/with-utf8.cabal b/with-utf8.cabal --- a/with-utf8.cabal +++ b/with-utf8.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: adea88526f74ca2b9e81b219c5f63273f4dbfb0439eab0a2ddff978600294100 +-- hash: 7a8e17b836c254d67dc50ee878cda9586a823dedf7f76b1f36426f2ad817e7b3 name: with-utf8 -version: 1.0.1.0 +version: 1.0.2.0 synopsis: Get your IO right on the first try description: This minimalistic library helps you navigate the world of text encodings avoiding @invalid argument (invalid byte sequence)@ @@ -62,9 +62,15 @@ hs-source-dirs: app/utf8-troubleshoot ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + c-sources: + app/utf8-troubleshoot/cbits/locale.c build-depends: base , directory + , filepath + , process + , safe-exceptions + , th-env default-language: Haskell2010 test-suite with-utf8-test