code-page 0.1.3 → 0.2

raw patch · 6 files changed

+303/−94 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−2
• README.md +4/−1
• code-page.cabal +7/−2
• src/System/IO/CodePage.hs +140/−83
• src/System/IO/CodePage/Internal.hs +121/−0
• tests/Tests.hs +7/−6

@@ -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.

@@ -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.

@@ -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

@@ -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

@@ -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

@@ -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