1-- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/> 2-- 3-- SPDX-License-Identifier: MPL-2.0 4 5{-# LANGUAGE CPP #-} 6{-# LANGUAGE LambdaCase #-} 7{-# LANGUAGE TemplateHaskell #-} 8{-# LANGUAGE TypeApplications #-} 9 10#include <HsBaseConfig.h> 11 12module Main (main) where 13 14import Prelude hiding (print, putStr, putStrLn) 15 16import Control.Exception.Safe (catchIO, tryIO) 17import Control.Monad (filterM, forM_, when) 18import Data.List (sort) 19import Data.Maybe (isJust) 20import Data.Version (showVersion) 21import Foreign.C.String (CString, peekCAString) 22import GHC.IO.Encoding (getLocaleEncoding, initLocaleEncoding) 23#if !(defined(mingw32_HOST_OS) || defined(__MINGW32__)) 24import GHC.IO.Encoding.Iconv (localeEncodingName) 25#endif 26import GHC.Show (showLitString) 27import Language.Haskell.TH.Env (envQ) 28import System.Directory (doesDirectoryExist, doesPathExist, listDirectory) 29import System.Environment (lookupEnv) 30import System.FilePath ((</>)) 31import System.Info (arch, compilerName, compilerVersion, os) 32import System.IO (hGetEncoding, stderr, stdout) 33import System.Process (readProcess) 34 35 36#if MIN_VERSION_base(4,11,0) 37#else 38import Data.Semigroup ((<>)) 39#endif 40 41import qualified Prelude as P 42 43 44-- | Encode a 'String' to be safe to print in ASCII-only. 45protect :: String -> String 46protect s = showLitString s "" 47 48 49putStr :: String -> IO () 50putStr = P.putStr . protect 51 52putStrLn :: String -> IO () 53putStrLn = P.putStrLn . protect 54 55showEnvVar :: String -> IO () 56showEnvVar name = do 57 putStr $ " * " <> name <> " " 58 lookupEnv name >>= \case 59 Nothing -> putStrLn "is not set" 60 Just v -> putStrLn $ "= " <> v 61 62 63showSystem :: IO () 64showSystem = do 65 putStrLn "# System" 66 putStrLn $ " * OS = " <> os 67 putStrLn $ " * arch = " <> arch 68 putStrLn $ " * compiler = " 69 <> compilerName <> " " <> showVersion compilerVersion 70 showEnvVar "TERM" 71 72 -- Nix stuff 73 let builtNix = isJust ($$(envQ @String "NIX_BUILD_TOP")) 74 when builtNix $ do 75 putStrLn " * Built with Nix" 76 let builtNixShell = isJust ($$(envQ @String "IN_NIX_SHELL")) 77 when builtNixShell $ do 78 putStrLn " * Built in nix-shell" 79 inNixShell <- isJust <$> lookupEnv "IN_NIX_SHELL" 80 when inNixShell $ do 81 putStrLn " * Running in nix-shell" 82 83 when (builtNix || builtNixShell) $ do 84 showEnvVar "LOCALE_ARCHIVE" 85 86 87showGhc :: IO () 88showGhc = do 89 putStrLn "# GHC" 90 putStrLn $ " * initLocaleEncoding = " <> show initLocaleEncoding 91 getLocaleEncoding >>= \e -> putStrLn $ " * locale encoding = " <> show e 92 hGetEncoding stdout >>= \e -> putStrLn $ " * stdout = " <> show e 93 hGetEncoding stderr >>= \e -> putStrLn $ " * stderr = " <> show e 94 95showCbits :: IO () 96showCbits = do 97 putStrLn "# C bits" 98#if !(defined(mingw32_HOST_OS) || defined(__MINGW32__)) 99 putStrLn $ " * localeEncodingName = " <> localeEncodingName 100#endif 101 showLibcharset 102 showLanginfoh 103 where 104 showLibcharset :: IO () 105 showLibcharset = do 106#if defined(HAVE_LIBCHARSET) 107 enc <- c_libcharsetEncoding >>= peekCAString 108 putStrLn $ " * libcharset:locale_charset = " <> enc 109#else 110 putStrLn $ " * No libcharset." 111#endif 112 113 showLanginfoh :: IO () 114 showLanginfoh = do 115#if defined(HAVE_LANGINFO_H) 116 enc <- c_langinfoEncoding >>= peekCAString 117 putStrLn $ " * langinfo.h:nl_langinfo(CODESET) = " <> enc 118#else 119 putStrLn $ " * No <langinfo.h>." 120#endif 121 122#if defined(HAVE_LIBCHARSET) 123foreign import ccall unsafe "libcharsetEncoding" 124 c_libcharsetEncoding :: IO CString 125#endif 126 127#if defined(HAVE_LANGINFO_H) 128foreign import ccall unsafe "langinfoEncoding" 129 c_langinfoEncoding :: IO CString 130#endif 131 132showEnv :: IO () 133showEnv = do 134 putStrLn "# Environment" 135 mapM_ showEnvVar 136 [ "LANG" 137 , "LC_CTYPE" 138 , "LC_ALL=" 139 ] 140 141showLocales :: IO () 142showLocales = do 143 putStrLn "# Locales" 144 tryIO callLocalectl >>= \case 145 Right out -> do 146 putStrLn $ " * localectl list-locales:" 147 showLocaleList (lines out) 148 Left _ -> do 149 listDir "/usr/lib/locale" 150 listFile "/usr/lib/locale/locale-archive" `catchIO` \e -> 151 putStrLn $ "<error>: " <> show e 152 where 153 showLocaleList :: [String] -> IO () 154 showLocaleList locales = 155 forM_ (sort locales) $ \item -> putStrLn $ " * " <> item 156 157 callLocalectl :: IO String 158 callLocalectl = readProcess "localectl" ["list-locales"] "" 159 160 listDir :: FilePath -> IO () 161 listDir path = doesPathExist path >>= \case 162 False -> putStrLn $ " * " <> path <> " does not exist" 163 True -> doesDirectoryExist path >>= \case 164 False -> putStrLn $ " * " <> path <> " is not a directory" 165 True -> do 166 putStrLn $ " * " <> path <> ":" 167 ls <- listDirectory path >>= filterM (doesDirectoryExist . (path </>)) 168 showLocaleList ls 169 170 listFile :: FilePath -> IO () 171 listFile path = doesPathExist path >>= \case 172 False -> putStrLn $ " * " <> path <> " does not exist" 173 True -> do 174 putStrLn $ " * " <> path <> ":" 175 out <- readProcess "localedef" ["--list", path] "" 176 showLocaleList (lines out) 177 178 179 180main :: IO () 181main = do 182 showSystem 183 showGhc 184 showCbits 185 showEnv 186 showLocales 187