diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1 [YYYY.MM.DD] + +* Initial commit. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Ryan Scott + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ryan Scott nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,19 @@ +# `code-page` +[![Hackage](https://img.shields.io/hackage/v/code-page.svg)][Hackage: code-page] +[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/code-page.svg)](http://packdeps.haskellers.com/reverse/code-page) +[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] +[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] +[![Linux build](https://img.shields.io/travis/RyanGlScott/code-page.svg)](https://travis-ci.org/RyanGlScott/code-page) +[![Windows build](https://ci.appveyor.com/api/projects/status/kaxqsgm2xx66l2q5?svg=true)](https://ci.appveyor.com/project/RyanGlScott/code-page) + +[Hackage: code-page]: + http://hackage.haskell.org/package/code-page + "code-page package on Hackage" +[Haskell.org]: + http://www.haskell.org + "The Haskell Programming Language" +[tl;dr Legal: BSD3]: + https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 + "BSD 3-Clause License (Revised)" + +Windows code page library for Haskell diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/code-page.cabal b/code-page.cabal new file mode 100644 --- /dev/null +++ b/code-page.cabal @@ -0,0 +1,60 @@ +name: code-page +version: 0.1 +synopsis: Windows code page library for Haskell +description: 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. +homepage: https://github.com/RyanGlScott/code-page +bug-reports: https://github.com/RyanGlScott/code-page/issues +license: BSD3 +license-file: LICENSE +author: Ryan Scott +maintainer: Ryan Scott +stability: Provisional +copyright: (C) 2016 Ryan Scott +category: System +build-type: Simple +extra-source-files: CHANGELOG.md, README.md, include/*.h +cabal-version: >=1.10 +tested-with: GHC == 7.0.4 + , GHC == 7.2.2 + , GHC == 7.4.2 + , GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.1 + +source-repository head + type: git + location: https://github.com/RyanGlScott/code-page + +library + exposed-modules: System.IO.CodePage + System.Win32.CodePage + build-depends: base >= 4.3 && < 5 + build-tools: hsc2hs + if os(windows) + cpp-options: "-DWINDOWS" + build-depends: Win32 + + hs-source-dirs: src + include-dirs: include + includes: windows_cconv.h + default-language: Haskell2010 + ghc-options: -Wall + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Tests.hs + + build-depends: base >= 4.3 && < 5 + , code-page == 0.1 + + hs-source-dirs: tests + default-language: Haskell2010 diff --git a/include/windows_cconv.h b/include/windows_cconv.h new file mode 100644 --- /dev/null +++ b/include/windows_cconv.h @@ -0,0 +1,12 @@ +#ifndef WINDOWS_CCONV_H +#define WINDOWS_CCONV_H + +#if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +#elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +#else +# error Unknown mingw32 arch +#endif + +#endif diff --git a/src/System/IO/CodePage.hs b/src/System/IO/CodePage.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/CodePage.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} + +{-| +Module: System.IO.CodePage +Copyright: (C) 2016 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: Portable + +Exports functions which adjust code pages on Windows, and do nothing on other +operating systems. +-} +module System.IO.CodePage ( + withCP65001 + , withCP1200 + , withCP1201 + , withCP12000 + , withCP12001 + , withCodePage + , withCodePageVerbosity + + , CodePage + , cp65001 + , cp1200 + , cp1201 + , cp12000 + , cp12001 + ) where + +#ifdef WINDOWS +import Control.Exception (bracket_) +import Control.Monad (when) +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) +#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 + +-- | Sets the code page for an action to UTF-8 as necessary. +withCP65001 :: IO a -> IO a +withCP65001 = withCodePage cp65001 + +-- | Sets the code page for an action to UTF-16LE as necessary. +withCP1200 :: IO a -> IO a +withCP1200 = withCodePage cp1200 + +-- | Sets the code page for an action to UTF-16BE as necessary. +withCP1201 :: IO a -> IO a +withCP1201 = withCodePage cp1201 + +-- | Sets the code page for an action to UTF-32LE as necessary. +withCP12000 :: IO a -> IO a +withCP12000 = withCodePage cp12000 + +-- | Sets the code page for an action to UTF-32BE as necessary. +withCP12001 :: IO a -> IO a +withCP12001 = withCodePage cp12001 + +-- | Sets the code page for an action as necessary. +withCodePage :: CodePage -> IO a -> IO a +withCodePage = withCodePageVerbosity False + +-- | 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 +-- been changed. ('withCodePage' sets this argument to 'False'.) + +-- 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 +#ifdef WINDOWS +withCodePageVerbosity chatty cp inner = do + origCPI <- getConsoleCP + origCPO <- getConsoleOutputCP + mbOrigStdinEnc <- hGetEncoding stdin + mbOrigStdoutEnc <- hGetEncoding stdout + mbOrigStderrEnc <- hGetEncoding stderr + + let setInput = origCPI /= cp + setOutput = origCPO /= cp + fixInput + | setInput = bracket_ + (do + setConsoleCP cp + hSetEncoding stdin expected + ) + (do + setConsoleCP origCPI + mapM_ (hSetEncoding stdin) mbOrigStdinEnc + ) + | otherwise = id + fixOutput + | setInput = bracket_ + (do + setConsoleOutputCP cp + hSetEncoding stdout expected + hSetEncoding stderr expected + ) + (do + setConsoleOutputCP origCPO + mapM_ (hSetEncoding stdout) mbOrigStdoutEnc + mapM_ (hSetEncoding stderr) mbOrigStderrEnc + ) + | otherwise = id + + 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 + ] +#else +withCodePageVerbosity _ _ inner = inner +#endif diff --git a/src/System/Win32/CodePage.hsc b/src/System/Win32/CodePage.hsc new file mode 100644 --- /dev/null +++ b/src/System/Win32/CodePage.hsc @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +{-| +Module: System.Win32.CodePage +Copyright: (C) 2016 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: Portable + +On Windows, this exports functions for getting, setting, and analyzing code pages. +On other operating systems, this exports nothing. +-} +module System.Win32.CodePage ( +#ifdef WINDOWS + -- * The 'CodePage' type + CodePage + + -- * Getting and setting code pages + , getConsoleCP + , getConsoleOutputCP + , setConsoleCP + , setConsoleOutputCP + , getACP + , getOEMCP + + -- * Code page encodings + , codePageEncoding + , mkCodePageEncoding + + -- * Valid code pages + , isValidCodePage + , installedCodePages + , supportedCodePages + + -- * 'CodePage'-aware Unicode conversion + , stringToUnicode +#endif + ) where + +#ifdef WINDOWS +import Data.IORef +import Data.List + +import Foreign.C.String +import Foreign.Ptr + +import GHC.IO.Encoding.CodePage + +import System.Win32.Console +import System.Win32.NLS +import System.Win32.Types + +# include +## include "windows_cconv.h" + +type CODEPROC_ENUMW = LPWSTR -> IO BOOL + +foreign import WINDOWS_CCONV "windows.h EnumSystemCodePagesW" + c_EnumSystemCodePagesW :: FunPtr CODEPROC_ENUMW -> DWORD -> IO BOOL + +str_EnumSystemCodePagesW :: String +str_EnumSystemCodePagesW = "EnumSystemCodePagesW" + +foreign import WINDOWS_CCONV "wrapper" + mkCodeProcEnumW :: CODEPROC_ENUMW -> IO (FunPtr CODEPROC_ENUMW) + +cP_INSTALLED, cP_SUPPORTED :: DWORD +cP_INSTALLED = #{const CP_INSTALLED} +cP_SUPPORTED = #{const CP_SUPPORTED} + +-- | Enumerates all installed code pages in sorted order. +installedCodePages :: IO [CodePage] +installedCodePages = systemCodePages cP_INSTALLED + +-- | Enumerates all supported code pages in sorted order. +supportedCodePages :: IO [CodePage] +supportedCodePages = systemCodePages cP_SUPPORTED + +systemCodePages :: DWORD -> IO [CodePage] +systemCodePages flags = do + cpRef <- newIORef [] + fptr <- mkCodeProcEnumW $ \cpLPWStr -> do + cpStr <- peekCWString cpLPWStr + modifyIORef cpRef (read cpStr :) + return True + failIfFalse_ str_EnumSystemCodePagesW $ c_EnumSystemCodePagesW fptr flags + freeHaskellFunPtr fptr + modifyIORef cpRef sort + readIORef cpRef +#endif diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,22 @@ +{-| +Module: Tests +Copyright: (C) 2016 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: Portable + +Ensures that functions from "System.IO.CodePage" work properly. +-} +module Main (main) where + +import System.IO.CodePage + +printUnicodeString :: IO () +printUnicodeString = do + putStrLn "κόσμε" + putStrLn "→" + putStrLn "☀☁☂☃☄" + +main :: IO () +main = withCodePageVerbosity True 65001 printUnicodeString