diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,26 @@ +## 0.2 [2018.11.13] +* Rename the `withCodePageVerbosity` function to `withCodePageOptions` to + reflect the fact that its first argument is now an `Options` data type + instead of just a `Bool` to represent its verbosity. (The ability to + configure verbosity is now controlled through the `chatty` field of + `Options`.) +* On non-Windows OSes, `withCodePage` (and related functions) now make a best + effort guess in converting the supplied `CodePage` to a `TextEncoding` and + adjusing the current `TextEncoding` to that one. (For instance, `withCP65001` + will adjust the current `TextEncoding` to be `utf8` on non-Windows OSes.) + If the supplied `CodePage` does not map to a known `TextEncoding`, these + functions will error at runtime on non-Windows OSes. + + This is a departure from the previous major version of `code-page`, where + these functions did not do anything at all on non-Windows OSes. If you + would like to recover this old behavior, use + `withCodePageOptions defaultOptions{nonWindowsBehavior = NonWindowsDoNothing}`. +* `withCodePage` and friends now change the locale encoding (on GHC 7.4 or later) + in addition to the encodings for `stdin`, `stdout`, and `stderr`. +* Add `withCP1252` and `cp1252` for the Latin1 code page. +* Add a `System.IO.CodePage.Internal` module that contains certain internal + details (such as the constructors of `Options` and `NonWindowsBehavior`). + ### 0.1.3 [2017.03.15] * Fix the build on GHC 7.8 and older @@ -8,6 +31,5 @@ ### 0.1.1 [2016.11.09] * Fix the build on non-Intel architectures (thanks, erikd!) -## 0.1 [2016.09.15] - +## 0.1 [2016.09.15] * Initial commit. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,4 +16,7 @@ https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" -Windows code page library for Haskell +This library provides two modules: + +* `System.IO.CodePage`: a cross-platform module that exports functions which adjust code pages on Windows, and do nothing on other operating systems. +* `System.Win32.CodePage`: On Windows, this exports functions for getting, setting, and analyzing code pages. On other operating systems, this module exports nothing. diff --git a/code-page.cabal b/code-page.cabal --- a/code-page.cabal +++ b/code-page.cabal @@ -1,5 +1,5 @@ name: code-page -version: 0.1.3 +version: 0.2 synopsis: Windows code page library for Haskell description: This library provides two modules: . @@ -29,6 +29,9 @@ , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.2 source-repository head type: git @@ -36,6 +39,7 @@ library exposed-modules: System.IO.CodePage + System.IO.CodePage.Internal System.Win32.CodePage build-depends: base >= 4.3 && < 5 build-tools: hsc2hs @@ -53,8 +57,9 @@ type: exitcode-stdio-1.0 main-is: Tests.hs - build-depends: base >= 4.3 && < 5 + build-depends: base >= 4.3 && < 5 , code-page hs-source-dirs: tests default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts diff --git a/src/System/IO/CodePage.hs b/src/System/IO/CodePage.hs --- a/src/System/IO/CodePage.hs +++ b/src/System/IO/CodePage.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} {-| Module: System.IO.CodePage @@ -12,61 +13,56 @@ operating systems. -} module System.IO.CodePage ( + -- * Adjusting 'CodePage's withCP65001 , withCP1200 , withCP1201 , withCP12000 , withCP12001 + , withCP1252 , withCodePage - , withCodePageVerbosity + , withCodePageOptions + -- * Notable 'CodePage's , CodePage , cp65001 , cp1200 , cp1201 , cp12000 , cp12001 + , cp1252 + + -- * 'Options' + , Options + , defaultOptions + -- ** Record fields of 'Options' + , chatty + , nonWindowsBehavior + + -- ** 'NonWindowsBehavior' + , NonWindowsBehavior + -- ** Constructing 'NonWindowsBehavior' + , nonWindowsDoNothing + , nonWindowsFallbackCodePageEncoding + , defaultFallbackCodePageEncoding ) where -#ifdef WINDOWS -import Control.Exception (bracket_) -import Control.Monad (when) -import Data.Foldable (forM_) -import System.IO (hGetEncoding, hPutStrLn, hSetEncoding, stderr, stdin, stdout) -import qualified System.Win32.CodePage as Win32 (CodePage) -import System.Win32.CodePage hiding (CodePage) -#else -import Data.Word (Word32) +import Control.Exception (bracket_) +import Control.Monad (when) +import Data.Foldable (forM_) +import GHC.IO.Encoding (textEncodingName) +import System.IO ( TextEncoding, hGetEncoding, hPutStrLn, hSetEncoding + , stderr, stdin, stdout ) +import System.IO.CodePage.Internal + +#if MIN_VERSION_base(4,5,0) +import GHC.IO.Encoding (getLocaleEncoding, setLocaleEncoding) #endif --- | A numeric type representing Windows code pages. -type CodePage = #ifdef WINDOWS - Win32.CodePage -#else - Word32 +import System.Win32.CodePage hiding (CodePage) #endif --- | The UTF-8 code page. -cp65001 :: CodePage -cp65001 = 65001 - --- | The UTF-16LE code page. -cp1200 :: CodePage -cp1200 = 1200 - --- | The UTF-16BE code page. -cp1201 :: CodePage -cp1201 = 1201 - --- | The UTF-32LE code page. -cp12000 :: CodePage -cp12000 = 12000 - --- | The UTF-32BE code page. -cp12001 :: CodePage -cp12001 = 12001 - -- | Sets the code page for an action to UTF-8 as necessary. withCP65001 :: IO a -> IO a withCP65001 = withCodePage cp65001 @@ -87,9 +83,20 @@ withCP12001 :: IO a -> IO a withCP12001 = withCodePage cp12001 +-- | Sets the code page for an action to Latin1 as necessary. +withCP1252 :: IO a -> IO a +withCP1252 = withCodePage cp1252 + -- | Sets the code page for an action as necessary. +-- +-- On operating systems besides Windows, this will make an effort to change +-- the current 'TextEncoding' to something that is equivalent to the supplied +-- 'CodePage'. Currently, the only supported 'CodePage's on non-Windows OSes +-- are 'cp65001', 'cp1200', 'cp1201', 'cp12000', and 'cp12001'. Supplying any +-- other 'CodePage' will result in a runtime error on non-Windows OSes. (If you +-- would like to configure this behavior, use 'withCodePageOptions' instead.) withCodePage :: CodePage -> IO a -> IO a -withCodePage = withCodePageVerbosity False +withCodePage = withCodePageOptions defaultOptions -- | Sets the code page for an action as necessary. If the 'Bool' argument is 'True', -- this function will emit a warning to @stderr@ indicating that the code page has @@ -98,56 +105,106 @@ -- Taken from the stack codebase -- (https://github.com/commercialhaskell/stack/blob/21e517ba88b3c6bee475fb00ad95f280e7285a54/src/main/Main.hs#L82-L123) -- which is under a 3-clause BSD license -withCodePageVerbosity :: Bool -> CodePage -> IO a -> IO a +withCodePageOptions :: Options -> CodePage -> IO a -> IO a +withCodePageOptions (Options{chatty, nonWindowsBehavior}) cp inner = + case nonWindowsBehavior of + NonWindowsDoNothing -> inner + NonWindowsFallbackCodePageEncoding fallback -> do #ifdef WINDOWS -withCodePageVerbosity chatty cp inner = do - origCPI <- getConsoleCP - origCPO <- getConsoleOutputCP - mbOrigStdinEnc <- hGetEncoding stdin - mbOrigStdoutEnc <- hGetEncoding stdout - mbOrigStderrEnc <- hGetEncoding stderr + origCPI <- getConsoleCP + origCPO <- getConsoleOutputCP +#else + -- These are never used on non-Windows OSes, + -- so their values are irrelevant + let origCPI = 0 + origCPO = 0 +#endif + mbOrigStdinEnc <- hGetEncoding stdin + mbOrigStdoutEnc <- hGetEncoding stdout + mbOrigStderrEnc <- hGetEncoding stderr +#if MIN_VERSION_base(4,5,0) + origLocaleEnc <- getLocaleEncoding +#endif - let setInput = origCPI /= cp - setOutput = origCPO /= cp - fixInput - | setInput = bracket_ - (do - setConsoleCP cp - hSetEncoding stdin expected - ) - (do - setConsoleCP origCPI - forM_ mbOrigStdinEnc $ hSetEncoding stdin - ) - | otherwise = id - fixOutput - | setOutput = bracket_ - (do - setConsoleOutputCP cp - hSetEncoding stdout expected - hSetEncoding stderr expected - ) - (do - setConsoleOutputCP origCPO - forM_ mbOrigStdoutEnc $ hSetEncoding stdout - forM_ mbOrigStderrEnc $ hSetEncoding stderr - ) - | otherwise = id + let expected = codePageEncoding' fallback cp + expectedName = textEncodingName expected + warn typ = when chatty $ hPutStrLn stderr $ concat + [ "Setting" + , typ + , " codepage to " ++ show cp + , if expectedName == ("CP" ++ show cp) + then "" + else " (" ++ expectedName ++ ")" + ] +#ifdef WINDOWS + setInput = origCPI /= cp + setOutput = origCPO /= cp +#else + -- Crude, but the best available option + setInput = fmap textEncodingName mbOrigStdinEnc /= Just expectedName + setOutput = fmap textEncodingName mbOrigStdoutEnc /= Just expectedName +#endif +#if MIN_VERSION_base(4,5,0) + setLocale = textEncodingName origLocaleEnc /= expectedName +#endif + fixInput + | setInput = bracket_ + (do + setConsoleCP' cp + hSetEncoding stdin expected + ) + (do + setConsoleCP' origCPI + forM_ mbOrigStdinEnc $ hSetEncoding stdin + ) + | otherwise = id + fixOutput + | setOutput = bracket_ + (do + setConsoleOutputCP' cp + hSetEncoding stdout expected + hSetEncoding stderr expected + ) + (do + setConsoleOutputCP' origCPO + forM_ mbOrigStdoutEnc $ hSetEncoding stdout + forM_ mbOrigStderrEnc $ hSetEncoding stderr + ) + | otherwise = id + fixLocale +#if MIN_VERSION_base(4,5,0) + | setLocale + = bracket_ + (do when chatty $ hPutStrLn stderr $ unwords + [ "Setting locale encoding to" + , expectedName + ] + setLocaleEncoding expected) + (setLocaleEncoding origLocaleEnc) + | otherwise +#endif + = id - case (setInput, setOutput) of - (False, False) -> return () - (True, True) -> warn "" - (True, False) -> warn " input" - (False, True) -> warn " output" + case (setInput, setOutput) of + (False, False) -> return () + (True, True) -> warn "" + (True, False) -> warn " input" + (False, True) -> warn " output" - fixInput $ fixOutput inner - where - expected = codePageEncoding cp - warn typ = when chatty $ hPutStrLn stderr $ concat - [ "Setting" - , typ - , " codepage to " ++ show cp - ] + fixInput $ fixOutput $ fixLocale inner + +codePageEncoding' :: (CodePage -> TextEncoding) -> CodePage -> TextEncoding +#ifdef WINDOWS +codePageEncoding' _ = codePageEncoding #else -withCodePageVerbosity _ _ inner = inner +codePageEncoding' = id +#endif + +setConsoleCP', setConsoleOutputCP' :: CodePage -> IO () +#ifdef WINDOWS +setConsoleCP' = setConsoleCP +setConsoleOutputCP' = setConsoleOutputCP +#else +setConsoleCP' _ = return () +setConsoleOutputCP' _ = return () #endif diff --git a/src/System/IO/CodePage/Internal.hs b/src/System/IO/CodePage/Internal.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/CodePage/Internal.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE CPP #-} + +{-| +Module: System.IO.CodePage.Internal +Copyright: (C) 2018 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: Portable + +Various internals used by "System.IO.CodePage". + +Note that this is an internal module, and as such, the API presented here is +not guaranteed to be stable, even between minor releases of this library. +-} +module System.IO.CodePage.Internal where + +import System.IO (TextEncoding, latin1, utf8, utf16le, utf16be, utf32le, utf32be) + +#ifdef WINDOWS +import qualified System.Win32.CodePage as Win32 (CodePage) +#else +import Data.Word (Word32) +#endif + +-- | A numeric type representing Windows code pages. +type CodePage = +#ifdef WINDOWS + Win32.CodePage +#else + Word32 +#endif + +-- | The UTF-8 code page. +cp65001 :: CodePage +cp65001 = 65001 + +-- | The UTF-16LE code page. +cp1200 :: CodePage +cp1200 = 1200 + +-- | The UTF-16BE code page. +cp1201 :: CodePage +cp1201 = 1201 + +-- | The UTF-32LE code page. +cp12000 :: CodePage +cp12000 = 12000 + +-- | The UTF-32BE code page. +cp12001 :: CodePage +cp12001 = 12001 + +-- | The Latin1 code page. +cp1252 :: CodePage +cp1252 = 1252 + +-- | Options that specify how 'withCodePage' and friends should work. +data Options = Options + { chatty :: Bool + -- ^ If 'True', emit a warning to @stderr@ indicating that the code page has + -- been changed. If 'False', don't emit any warnings. + , nonWindowsBehavior :: NonWindowsBehavior + -- ^ Configures how 'withCodePage' and friends should work on non-Windows + -- operating systems. + } + +-- | The default 'Options': +-- +-- @ +-- 'Options' +-- { 'chatty' = 'False' +-- , 'nonWindowsBehavior' = +-- 'nonWindowsFallbackCodePageEncoding' 'defaultFallbackCodePageEncoding' +-- } +-- @ +defaultOptions :: Options +defaultOptions = Options + { chatty = False + , nonWindowsBehavior = + nonWindowsFallbackCodePageEncoding defaultFallbackCodePageEncoding + } + +-- | Specifies how 'withCodePage' and friends should work on operating systems +-- other than Windows. +data NonWindowsBehavior + = NonWindowsDoNothing + -- ^ Don't do anything at all on non-Windows OSes. + | NonWindowsFallbackCodePageEncoding (CodePage -> TextEncoding) + -- ^ On non-Windows OSes, change the 'TextEncoding' by converting the + -- 'CodePage' argument to a 'TextEncoding' using the supplied function. + +-- | Don't do anything at all on non-Windows OSes. +nonWindowsDoNothing :: NonWindowsBehavior +nonWindowsDoNothing = NonWindowsDoNothing + +-- | On non-Windows OSes, change the 'TextEncoding' by converting the +-- 'CodePage' argument to a 'TextEncoding' using the supplied function. +nonWindowsFallbackCodePageEncoding + :: (CodePage -> TextEncoding) -> NonWindowsBehavior +nonWindowsFallbackCodePageEncoding = NonWindowsFallbackCodePageEncoding + +-- | Provides a best-effort attempt to convert a 'CodePage' to a 'TextEncoding' +-- on non-Windows OSes. Errors if given a 'CodePage' that it doesn't know how +-- to convert. +defaultFallbackCodePageEncoding :: CodePage -> TextEncoding +defaultFallbackCodePageEncoding cp + | cp == cp65001 + = utf8 + | cp == cp1200 + = utf16le + | cp == cp1201 + = utf16be + | cp == cp12000 + = utf32le + | cp == cp12001 + = utf32be + | cp == cp1252 + = latin1 + | otherwise + = error $ "Don't know fallback text encoding for CP" ++ show cp diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -12,11 +12,12 @@ import System.IO.CodePage -printUnicodeString :: IO () -printUnicodeString = do - putStrLn "κόσμε" - putStrLn "→" - putStrLn "☀☁☂☃☄" +printUnicodeStrings :: IO () +printUnicodeStrings = do + putStrLn "κόσμε" + putStrLn "→" + putStrLn "☀☁☂☃☄" main :: IO () -main = withCodePageVerbosity True 65001 printUnicodeString +main = withCP1252 $ + withCodePageOptions defaultOptions{chatty = True} cp65001 printUnicodeStrings