text-locale-encoding (empty) → 0.1

raw patch · 7 files changed

+471/−0 lines, 7 filesdep +basedep +bytestringdep +bytestring-handlesetup-changed

Dependencies added: base, bytestring, bytestring-handle, text

Files

Data/Text/Encoding/Locale.hs +132/−0
Data/Text/IO/Locale.hs +72/−0
Data/Text/Lazy/Encoding/Locale.hs +134/−0
Import.hs +62/−0
LICENSE +30/−0
Setup.hs +2/−0
text-locale-encoding.cabal +39/−0

+ Data/Text/Encoding/Locale.hs view

@@ -0,0 +1,132 @@+-- |+-- module: Data.Text.Encoding.Locale+-- copyright: © kudah 2013+-- license: BSD3+--+-- maintainer: kudahkukarek@gmail.com+-- stability: experimental+-- portability: GHC-only+--+-- This module provides functions to encode and decode 'Data.Text.Text' to/from+-- 'Data.ByteString.ByteString' using 'System.IO.TextEncoding'+--+-- For performance, Text\'s native decode\* functions are used if the conditions+-- are right (LF NewlineMode and UTF encoding).+{-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif+module Data.Text.Encoding.Locale+    (decodeLocale+    ,encodeLocale++    ,decodeLocale'+    ,encodeLocale'++    ,decodeFromHandle+    ,encodeFromHandle+    ) where+import Import++import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified Data.Text.Encoding as TE++import System.IO++import Data.ByteString.Handle++import qualified Data.List as L+import Data.Maybe++handleDecoder :: Maybe TextEncoding -> Maybe NewlineMode -> B.ByteString -> IO T.Text+handleDecoder menc mnlmode = \bs -> do+    h <- readHandle False (fromStrict bs)+    whenJust' menc $ hSetEncoding h+    whenJust' mnlmode $ hSetNewlineMode h+    TIO.hGetContents h++handleEncoder :: Maybe TextEncoding -> Maybe NewlineMode -> T.Text -> IO B.ByteString+handleEncoder menc mnlmode = \t -> do+    (res, ()) <- writeHandle False $ \h -> do+        whenJust' menc $ hSetEncoding h+        whenJust' mnlmode $ hSetNewlineMode h+        TIO.hPutStr h t+    return (toStrict res)++chooseDecoder :: Maybe TextEncoding -> Maybe NewlineMode -> B.ByteString -> IO T.Text+chooseDecoder menc mnlmode = \bs -> do+    if inputNL nlmode == LF+      -- decode* functions won't convert line ends+      then do+        enc <- maybe getLocale' return menc+        case L.stripPrefix "UTF-" (show enc) of+          Just s ->+            case s of+              "8" -> return (TE.decodeUtf8 bs)+              ('1':'6':x:'E':_)+                  | 'L' == x -> return (TE.decodeUtf16LE bs)+                  | 'B' == x -> return (TE.decodeUtf16BE bs)+              ('3':'2':x:'E':_)+                  | 'L' == x -> return (TE.decodeUtf32LE bs)+                  | 'B' == x -> return (TE.decodeUtf32BE bs)+              _ -> fallback bs+          _ -> fallback bs+      else+        fallback bs+  where+    nlmode = fromMaybe nativeNewlineMode mnlmode+    fallback = handleDecoder menc mnlmode++chooseEncoder :: Maybe TextEncoding -> Maybe NewlineMode -> T.Text -> IO B.ByteString+chooseEncoder menc mnlmode = \bs ->+    if outputNL nlmode == LF+      -- encode* functions won't convert line ends+      then do+        enc <- maybe getLocale' return menc+        case L.stripPrefix "UTF-" (show enc) of+          Just s ->+            case s of+              "8" -> return (TE.encodeUtf8 bs)+              ('1':'6':x:'E':_)+                  | 'L' == x -> return (TE.encodeUtf16LE bs)+                  | 'B' == x -> return (TE.encodeUtf16BE bs)+              ('3':'2':x:'E':_)+                  | 'L' == x -> return (TE.encodeUtf32LE bs)+                  | 'B' == x -> return (TE.encodeUtf32BE bs)+              _ -> fallback bs+          _ -> fallback bs+      else+        fallback bs+  where+    nlmode = fromMaybe nativeNewlineMode mnlmode+    fallback = handleEncoder menc mnlmode++-- | Decode 'B.ByteString' to 'T.Text' using current locale+decodeLocale :: B.ByteString -> IO T.Text+decodeLocale = chooseDecoder Nothing Nothing++-- | Encode 'T.Text' to 'B.ByteString' using current locale+encodeLocale :: T.Text -> IO B.ByteString+encodeLocale = chooseEncoder Nothing Nothing++-- | Decode 'B.ByteString' to 'T.Text' using supplied 'TextEncoding' and 'NewlineMode'+decodeLocale' :: TextEncoding -> NewlineMode -> B.ByteString -> IO T.Text+decodeLocale' enc nlmode = chooseDecoder (Just enc) (Just nlmode)++-- | Encode 'T.Text' to 'B.ByteString' using supplied 'TextEncoding' and 'NewlineMode'+encodeLocale' :: TextEncoding -> NewlineMode -> T.Text -> IO B.ByteString+encodeLocale' enc nlmode = chooseEncoder (Just enc) (Just nlmode)++-- | Decode 'B.ByteString' to 'T.Text' using 'Handle's 'TextEncoding' and 'NewlineMode'+decodeFromHandle :: Handle -> B.ByteString -> IO T.Text+decodeFromHandle h bs = do+    (enc, nlmode) <- hGetEncAndNlMode' h+    decodeLocale' enc nlmode bs++-- | Encode 'T.Text' to 'B.ByteString' using 'Handle's 'TextEncoding' and 'NewlineMode'+encodeFromHandle :: Handle -> T.Text -> IO B.ByteString+encodeFromHandle h t = do+    (enc, nlmode) <- hGetEncAndNlMode' h+    encodeLocale' enc nlmode t

+ Data/Text/IO/Locale.hs view

@@ -0,0 +1,72 @@+-- |+-- module: Data.Text.IO.Locale+-- copyright: © kudah 2013+-- license: BSD3+--+-- maintainer: kudahkukarek@gmail.com+-- stability: experimental+-- portability: GHC-only+--+-- This module offers much faster locale-aware I/O than "Data.Text.IO" due to+-- the usage of 'hPutBuf' to write the resulting 'Data.ByteString.ByteString'+-- all at once, while "Data.Text.IO" writes characters one at a time, taking the+-- 'Handle' lock each time. Since functions in this module take the lock just+-- once, they can safely be used from multiple threads without fear of messed up+-- output.+--+-- Functions in this module require at least twice as much memory as the+-- 'Data.Text.Text' they operate on to output it. For strings more than a half+-- of available RAM in size, this may result in memory exhaustion.+--+-- This module is intended to be imported @qualified@.+{-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif+module Data.Text.IO.Locale+    (putStr+    ,putStrLn+    ,hPutStr+    ,hPutStrLn+    ,writeFile+    ,appendFile+    ) where+import Prelude hiding (putStr, putStrLn, writeFile, appendFile)++import Data.Text.Encoding.Locale++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8 (hPutStrLn, putStrLn)+import qualified Data.Text as T++import System.IO hiding (hPutStr, hPutStrLn, putStr, putStrLn, writeFile, appendFile)++-- | Like 'Data.Text.IO.putStr', but writes the 'Text' all at once.+{-# INLINE putStr #-}+putStr :: T.Text -> IO ()+putStr t = B.putStr =<< encodeLocale t++-- | Like 'Data.Text.IO.putStrLn', but writes the 'Text' all at once.+{-# INLINE putStrLn #-}+putStrLn :: T.Text -> IO ()+putStrLn t = B8.putStrLn =<< encodeLocale t++-- | Like 'Data.Text.IO.hPutStr', but writes the 'Text' all at once.+{-# INLINE hPutStr #-}+hPutStr :: Handle -> T.Text -> IO ()+hPutStr h t = B.hPut h =<< encodeFromHandle h t++-- | Like 'Data.Text.IO.hPutStrLn', but writes the 'Text' all at once.+{-# INLINE hPutStrLn #-}+hPutStrLn :: Handle -> T.Text -> IO ()+hPutStrLn h t = B8.hPutStrLn h =<< encodeFromHandle h t++-- | Like 'Data.Text.IO.writeFile', but writes the 'Text' all at once.+{-# INLINE writeFile #-}+writeFile :: FilePath -> T.Text -> IO ()+writeFile f t = B.writeFile f =<< encodeLocale t++-- | Like 'Data.Text.IO.appendFile', but writes the 'Text' all at once.+{-# INLINE appendFile #-}+appendFile :: FilePath -> T.Text -> IO ()+appendFile f t = B.appendFile f =<< encodeLocale t

+ Data/Text/Lazy/Encoding/Locale.hs view

@@ -0,0 +1,134 @@+-- |+-- module: Data.Text.Encoding.Locale+-- copyright: © kudah 2013+-- license: BSD3+--+-- maintainer: kudahkukarek@gmail.com+-- stability: experimental+-- portability: GHC-only+--+-- This module provides functions to encode and decode 'Data.Text.Lazy.Text'+-- to/from 'Data.ByteString.Lazy.ByteString' using 'System.IO.TextEncoding'+--+-- For performance, Text\'s native decode\* functions are used if the conditions+-- are right (LF NewlineMode and UTF encoding).+{-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif+module Data.Text.Lazy.Encoding.Locale+    (decodeLocale+    ,encodeLocale++    ,decodeLocale'+    ,encodeLocale'++    ,decodeFromHandle+    ,encodeFromHandle+    ) where+import Import (getLocale'+              ,whenJust'+              ,hGetEncAndNlMode')++import qualified Data.ByteString.Lazy as L+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TLIO+import qualified Data.Text.Lazy.Encoding as TLE++import System.IO++import Data.ByteString.Handle++import qualified Data.List as L+import Data.Maybe++handleDecoder :: Maybe TextEncoding -> Maybe NewlineMode -> L.ByteString -> IO TL.Text+handleDecoder menc mnlmode = \bs -> do+    h <- readHandle False bs+    whenJust' menc $ hSetEncoding h+    whenJust' mnlmode $ hSetNewlineMode h+    TLIO.hGetContents h++handleEncoder :: Maybe TextEncoding -> Maybe NewlineMode -> TL.Text -> IO L.ByteString+handleEncoder menc mnlmode = \t -> do+    (res, ()) <- writeHandle False $ \h -> do+        whenJust' menc $ hSetEncoding h+        whenJust' mnlmode $ hSetNewlineMode h+        TLIO.hPutStr h t+    return res++chooseDecoder :: Maybe TextEncoding -> Maybe NewlineMode -> L.ByteString -> IO TL.Text+chooseDecoder menc mnlmode = \bs -> do+    if inputNL nlmode == LF+      -- decode* functions won't convert line ends+      then do+        enc <- maybe getLocale' return menc+        case L.stripPrefix "UTF-" (show enc) of+          Just s ->+            case s of+              "8" -> return (TLE.decodeUtf8 bs)+              ('1':'6':x:'E':_)+                  | 'L' == x -> return (TLE.decodeUtf16LE bs)+                  | 'B' == x -> return (TLE.decodeUtf16BE bs)+              ('3':'2':x:'E':_)+                  | 'L' == x -> return (TLE.decodeUtf32LE bs)+                  | 'B' == x -> return (TLE.decodeUtf32BE bs)+              _ -> fallback bs+          _ -> fallback bs+      else+        fallback bs+  where+    nlmode = fromMaybe nativeNewlineMode mnlmode+    fallback = handleDecoder menc mnlmode++chooseEncoder :: Maybe TextEncoding -> Maybe NewlineMode -> TL.Text -> IO L.ByteString+chooseEncoder menc mnlmode = \bs ->+    if outputNL nlmode == LF+      -- encode* functions won't convert line ends+      then do+        enc <- maybe getLocale' return menc+        case L.stripPrefix "UTF-" (show enc) of+          Just s ->+            case s of+              "8" -> return (TLE.encodeUtf8 bs)+              ('1':'6':x:'E':_)+                  | 'L' == x -> return (TLE.encodeUtf16LE bs)+                  | 'B' == x -> return (TLE.encodeUtf16BE bs)+              ('3':'2':x:'E':_)+                  | 'L' == x -> return (TLE.encodeUtf32LE bs)+                  | 'B' == x -> return (TLE.encodeUtf32BE bs)+              _ -> fallback bs+          _ -> fallback bs+      else+        fallback bs+  where+    nlmode = fromMaybe nativeNewlineMode mnlmode+    fallback = handleEncoder menc mnlmode++-- | Decode 'L.ByteString' to 'TL.Text' using current locale+decodeLocale :: L.ByteString -> IO TL.Text+decodeLocale = chooseDecoder Nothing Nothing++-- | Encode 'TL.Text' to 'L.ByteString' using current locale+encodeLocale :: TL.Text -> IO L.ByteString+encodeLocale = chooseEncoder Nothing Nothing++-- | Decode 'L.ByteString' to 'TL.Text' using supplied 'TextEncoding' and 'NewlineMode'+decodeLocale' :: TextEncoding -> NewlineMode -> L.ByteString -> IO TL.Text+decodeLocale' enc nlmode = chooseDecoder (Just enc) (Just nlmode)++-- | Encode 'TL.Text' to 'L.ByteString' using supplied 'TextEncoding' and 'NewlineMode'+encodeLocale' :: TextEncoding -> NewlineMode -> TL.Text -> IO L.ByteString+encodeLocale' enc nlmode = chooseEncoder (Just enc) (Just nlmode)++-- | Decode 'L.ByteString' to 'TL.Text' using 'Handle's 'TextEncoding' and 'NewlineMode'+decodeFromHandle :: Handle -> L.ByteString -> IO TL.Text+decodeFromHandle h bs = do+    (enc, nlmode) <- hGetEncAndNlMode' h+    decodeLocale' enc nlmode bs++-- | Encode 'TL.Text' to 'L.ByteString' using 'Handle's 'TextEncoding' and 'NewlineMode'+encodeFromHandle :: Handle -> TL.Text -> IO L.ByteString+encodeFromHandle h t = do+    (enc, nlmode) <- hGetEncAndNlMode' h+    encodeLocale' enc nlmode t

+ Import.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+module Import+    (getLocale'+    ,fromStrict+    ,toStrict+    ,whenJust'+    ,hGetEncAndNlMode'+    ) where+import GHC.IO.Handle.Types (Handle__(..))+import GHC.IO.Handle.Internals (withHandle_)+#if MIN_VERSION_base(4,5,0)+import GHC.IO.Encoding (getLocaleEncoding)+#else+import GHC.IO.Encoding (localeEncoding)+#endif++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++import System.IO++{-# INLINE getLocale' #-}+getLocale' :: IO TextEncoding+getLocale' =+#if MIN_VERSION_base(4,5,0)+    getLocaleEncoding+#else+    return localeEncoding+#endif++{-# INLINE fromStrict #-}+fromStrict :: B.ByteString -> L.ByteString+#if MIN_VERSION_bytestring(0,10,0)+fromStrict = L.fromStrict+#else+fromStrict x = L.fromChunks [x]+#endif++{-# INLINE toStrict #-}+toStrict :: L.ByteString -> B.ByteString+#if MIN_VERSION_bytestring(0,10,0)+toStrict = L.toStrict+#else+toStrict x = B.concat (L.toChunks x)+#endif++{-# INLINE whenJust' #-}+whenJust' :: Maybe a -> (a -> IO ()) -> IO ()+whenJust' m act =+    case m of+      Just a -> act a+      Nothing -> return ()++{-# INLINE hGetEncAndNlMode' #-}+hGetEncAndNlMode' :: Handle -> IO (TextEncoding, NewlineMode)+hGetEncAndNlMode' handle =+  withHandle_ "hGetNewlineMode'" handle $+    \Handle__{haCodec=mc, haInputNL=i, haOutputNL=o} -> do+        c <- case mc of+            Nothing -> getLocale'+            Just c -> return c+        return (c, NewlineMode{inputNL=i, outputNL=o})

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, kudah++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 kudah 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ text-locale-encoding.cabal view

@@ -0,0 +1,39 @@+name:          text-locale-encoding+version:       0.1+synopsis:      Encode and decode Text to/from ByteString using TextEncoding+homepage:      https://github.com/exbb2/text-locale-encoding+license:       BSD3+license-file:  LICENSE+author:        kudah+maintainer:    kudahkukarek@gmail.com+category:      Codec+build-type:    Simple+cabal-version: >= 1.8++source-repository head+    type: git+    location: https://github.com/exbb2/text-locale-encoding.git++flag trustworthy+  default: True+  manual: True++library+    exposed-modules:+        Data.Text.Encoding.Locale+        Data.Text.Lazy.Encoding.Locale+        Data.Text.IO.Locale++    other-modules:+        Import++    build-depends:+         base == 4.*+        ,bytestring-handle == 0.1.*+        ,bytestring+        ,text++    ghc-options: -Wall++    if impl(ghc>=7.2)+        cpp-options: -DTRUSTWORTHY=1