content: -- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/>
  --
  -- SPDX-License-Identifier: MPL-2.0
  
  {-# LANGUAGE CPP              #-}
  {-# LANGUAGE LambdaCase       #-}
  {-# LANGUAGE TemplateHaskell  #-}
  {-# LANGUAGE TypeApplications #-}
  
  #include <HsBaseConfig.h>
  
  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)
  #if !(defined(mingw32_HOST_OS) || defined(__MINGW32__))
  import GHC.IO.Encoding.Iconv (localeEncodingName)
  #endif
  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)
  
  
  #if MIN_VERSION_base(4,11,0)
  #else
  import Data.Semigroup ((<>))
  #endif
  
  import qualified Prelude as P
  
  -- See https://github.com/ndmitchell/hlint/commit/505a4d57b972f3ba605ad7a59721cef1f3d98a84
  {-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
  
  -- | 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
  
  showEnvVar :: String -> IO ()
  showEnvVar name = do
    putStr $ "  * " <> name <> " "
    lookupEnv name >>= \case
      Nothing -> putStrLn "is not set"
      Just v  -> putStrLn $ "= " <> v
  
  
  showSystem :: IO ()
  showSystem = do
      putStrLn "# System"
      putStrLn $ "  * OS = " <> os
      putStrLn $ "  * arch = " <> arch
      putStrLn $ "  * compiler = "
              <> 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"
      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
  
  showCbits :: IO ()
  showCbits = do
      putStrLn "# C bits"
  #if !(defined(mingw32_HOST_OS) || defined(__MINGW32__))
      putStrLn $ "  * localeEncodingName = " <> localeEncodingName
  #endif
      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 <langinfo.h>."
  #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_CTYPE"
        , "LC_ALL"
        ]
  
  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 $ "<error>: " <> show e
    where
      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"
        True -> doesDirectoryExist path >>= \case
          False -> putStrLn $ "  * " <> path <> " is not a directory"
          True -> do
            putStrLn $ "  * " <> path <> ":"
            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
    showLocales
  