zenacy-unicode (empty) → 1.0.0
raw patch · 7 files changed
+385/−0 lines, 7 filesdep +HUnitdep +basedep +bytestring
Dependencies added: HUnit, base, bytestring, test-framework, test-framework-hunit, text, vector, word8, zenacy-unicode
Files
- CHANGES.md +5/−0
- LICENSE +20/−0
- README.md +34/−0
- src/Zenacy/Unicode.hs +182/−0
- test/TestSuite.hs +11/−0
- test/Zenacy/Unicode/Tests.hs +54/−0
- zenacy-unicode.cabal +79/−0
+ CHANGES.md view
@@ -0,0 +1,5 @@+# Change Log++## 1.0.0++* Initial FOSS release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Michael Williams++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,34 @@+# Zenacy Unicode++[![hackage-shield][]][hackage-version]+[![stackage-shield][]][stackage-version]+[![linux-shield][]][linux-build]+[![packdeps-shield][]][packdeps]++Zenacy Unicode includes tools for checking byte order marks (BOM) and+cleaning data to remove invalid bytes. These tools can help ensure that+data pulled from the web can be parsed and converted to text.++The following is an example of converting dubious data to a text.++```haskell+textDecode :: ByteString -> Text+textDecode b =+ case bomStrip b of+ (Nothing, s) -> T.decodeUtf8 $ unicodeCleanUTF8 s -- Assume UTF8+ (Just BOM_UTF8, s) -> T.decodeUtf8 $ unicodeCleanUTF8 s+ (Just BOM_UTF16_BE, s) -> T.decodeUtf16BE s+ (Just BOM_UTF16_LE, s) -> T.decodeUtf16LE s+ (Just BOM_UTF32_BE, s) -> T.decodeUtf32BE s+ (Just BOM_UTF32_LE, s) -> T.decodeUtf32LE s+```++[hackage-shield]: https://img.shields.io/hackage/v/zenacy-unicode.svg?label=Hackage+[hackage-version]: https://hackage.haskell.org/package/zenacy-unicode+[stackage-shield]: https://www.stackage.org/package/zenacy-unicode/badge/nightly?label=Stackage+[stackage-version]: https://www.stackage.org/package/zenacy-unicode+[linux-shield]: https://img.shields.io/travis/com/mlcfp/zenacy-unicode?label=Linux%20build+[linux-build]: https://travis-ci.org/mlcfp/zenacy-unicode+[packdeps-shield]: https://img.shields.io/hackage-deps/v/zenacy-unicode.svg?maxAge=3600+[packdeps]: http://packdeps.haskellers.com/feed?needle=zenacy-unicode+
+ src/Zenacy/Unicode.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tools to check and prepare data to be parsed as valid unicode.+--+-- The following is an example of converting dubious data to a text.+--+-- > textDecode :: ByteString -> Text+-- > textDecode b =+-- > case bomStrip b of+-- > (Nothing, s) -> T.decodeUtf8 $ unicodeCleanUTF8 s -- Assume UTF8+-- > (Just BOM_UTF8, s) -> T.decodeUtf8 $ unicodeCleanUTF8 s+-- > (Just BOM_UTF16_BE, s) -> T.decodeUtf16BE s+-- > (Just BOM_UTF16_LE, s) -> T.decodeUtf16LE s+-- > (Just BOM_UTF32_BE, s) -> T.decodeUtf32BE s+-- > (Just BOM_UTF32_LE, s) -> T.decodeUtf32LE s+module Zenacy.Unicode+ ( BOM(..)+ , bomStrings+ , bomStrip+ , unicodeCleanUTF8+ ) where++import Foreign+ ( castPtr+ , withForeignPtr+ )+import Control.Monad.ST+ ( ST+ , runST+ )+import Data.STRef+ ( STRef+ , newSTRef+ , readSTRef+ , writeSTRef+ )+import Data.ByteString+ ( ByteString+ )+import qualified Data.ByteString as S+ ( index+ , length+ , null+ , packCStringLen+ , pack+ , stripPrefix+ )+import Data.Vector.Storable.Mutable+ ( MVector(..)+ )+import qualified Data.Vector.Storable.Mutable as U+ ( new+ , length+ , write+ , grow+ , unsafeToForeignPtr0+ )+import Data.Word+ ( Word8+ )+import System.IO.Unsafe+ ( unsafePerformIO+ )++-- | Defines the unicode byte order mark.+data BOM+ = BOM_UTF8+ | BOM_UTF16_BE+ | BOM_UTF16_LE+ | BOM_UTF32_BE+ | BOM_UTF32_LE+ deriving (Eq, Ord, Show)++-- | Defines the byte order mark signatures.+bomStrings :: [(BOM,ByteString)]+bomStrings =+ [ ( BOM_UTF8, S.pack [ 0xEF, 0xBB, 0xBF ] )+ , ( BOM_UTF32_BE, S.pack [ 0x00, 0x00, 0xFE, 0xFF ] )+ , ( BOM_UTF32_LE, S.pack [ 0xFF, 0xFE, 0x00, 0x00 ] )+ -- The 16 bit codes need to be checked after the 32 bit codes,+ -- because the prefixes are similar.+ , ( BOM_UTF16_BE, S.pack [ 0xFE, 0xFF ] )+ , ( BOM_UTF16_LE, S.pack [ 0xFF, 0xFE ] )+ ]++-- | Remove the BOM from the start of a string.+bomStrip :: ByteString -> (Maybe BOM, ByteString)+bomStrip x =+ go bomStrings+ where+ go [] =+ (Nothing, x)+ go ((b,s):bs) =+ case S.stripPrefix s x of+ Just x' -> (Just b, x')+ Nothing -> go bs++-- | Removes bad characters and nulls from a UTF8 byte string.+unicodeCleanUTF8 :: ByteString -> ByteString+unicodeCleanUTF8 x =+ runST $ do+ v <- U.new 100+ go 0 0 v+ where+ go i j u+ | i == S.length x = do+ dataString u j+ | otherwise = do+ v <- if j + 3 < U.length u+ then pure u+ else U.grow u $ U.length u++ let c0 = S.index x (i + 0)+ c1 = S.index x (i + 1)+ c2 = S.index x (i + 2)+ c3 = S.index x (i + 3)++ if | (c0 >= 0x01 && c0 <= 0x7F) -> do+ U.write v (j + 0) c0+ go (i + 1) (j + 1) v++ | (c0 >= 0xC0 && c0 <= 0xDF) -> do+ if | i + 1 < S.length x &&+ (c1 >= 0x80 && c1 <= 0xBF) -> do+ U.write v (j + 0) c0+ U.write v (j + 1) c1+ go (i + 2) (j + 2) v+ | otherwise -> do+ rep (i + 1) j v++ | (c0 >= 0xE0 && c0 <= 0xEF) -> do+ if | i + 2 < S.length x &&+ (c1 >= 0x80 && c1 <= 0xBF) &&+ (c2 >= 0x80 && c2 <= 0xBF) -> do+ U.write v (j + 0) c0+ U.write v (j + 1) c1+ U.write v (j + 2) c2+ go (i + 3) (j + 3) v+ | (c1 >= 0x80 && c1 <= 0xBF) -> do+ rep (i + 2) j v+ | otherwise ->+ rep (i + 1) j v++ | (c0 >= 0xF0 && c0 <= 0xF7) -> do+ if | i + 3 < S.length x &&+ (c1 >= 0x80 && c1 <= 0xBF) &&+ (c2 >= 0x80 && c2 <= 0xBF) &&+ (c3 >= 0x80 && c3 <= 0xBF) -> do+ U.write v (j + 0) c0+ U.write v (j + 1) c1+ U.write v (j + 2) c2+ U.write v (j + 3) c3+ go (i + 4) (j + 4) v+ | (c1 >= 0x80 && c1 <= 0xBF) &&+ (c2 >= 0x80 && c2 <= 0xBF) -> do+ rep (i + 3) j v+ | (c1 >= 0x80 && c1 <= 0xBF) -> do+ rep (i + 2) j v+ | otherwise ->+ rep (i + 1) j v++ | otherwise -> do+ rep (i + 1) j v++ rep i j v = do+ U.write v (j + 0) 0xEF+ U.write v (j + 1) 0xBF+ U.write v (j + 2) 0xBD+ go i (j + 3) v++-- | Converts a storable vector to a byte string.+dataString :: MVector s Word8 -> Int -> ST s ByteString+dataString v n =+ pure $ unsafePerformIO $ do+ let (f, _) = U.unsafeToForeignPtr0 v+ withForeignPtr f $ \p ->+ S.packCStringLen (castPtr p, n)
+ test/TestSuite.hs view
@@ -0,0 +1,11 @@+module Main where++import Zenacy.Unicode.Tests+import Test.Framework+ ( defaultMain+ )++main :: IO ()+main = defaultMain+ [ testUnicode+ ]
+ test/Zenacy/Unicode/Tests.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Zenacy.Unicode.Tests+ ( testUnicode+ ) where++import Zenacy.Unicode+import Data.Monoid+ ( (<>)+ )+import Test.Framework+ ( Test+ , testGroup+ )+import Test.Framework.Providers.HUnit+ ( testCase+ )+import Test.HUnit+ ( assertBool+ , assertEqual+ , assertFailure+ )++testUnicode :: Test+testUnicode = testGroup "Zenacy.Unicode"+ [ testBom+ , testClean+ ]++testBom :: Test+testBom = testCase "unicode bom" $ do+ assertEqual "TEST 1" (Nothing, "a") $ bomStrip "a"+ assertEqual "TEST 2" (Just BOM_UTF8, "abc") $ bomStrip (utf8 <> "abc")+ assertEqual "TEST 3" (Just BOM_UTF16_BE, "abc") $ bomStrip (utf16be <> "abc")+ assertEqual "TEST 4" (Just BOM_UTF16_LE, "abc") $ bomStrip (utf16le <> "abc")+ assertEqual "TEST 5" (Just BOM_UTF32_BE, "abc") $ bomStrip (utf32be <> "abc")+ assertEqual "TEST 6" (Just BOM_UTF32_LE, "abc") $ bomStrip (utf32le <> "abc")+ where+ utf8 = "\xEF\xBB\xBF"+ utf16be = "\xFE\xFF"+ utf16le = "\xFF\xFE"+ utf32be = "\x00\x00\xFE\xFF"+ utf32le = "\xFF\xFE\x00\x00"++testClean :: Test+testClean = testCase "unicode clean" $ do+ assertEqual "TEST 1" "a" $ unicodeCleanUTF8 "a"+ assertEqual "TEST 2" "abc" $ unicodeCleanUTF8 "abc"+ assertEqual "TEST 3" "\xEF\xBF\xBD" $ unicodeCleanUTF8 "\x00"+ assertEqual "TEST 4" "\xEF\xBF\xBD" $ unicodeCleanUTF8 "\x92"+ assertEqual "TEST 5"+ "government\xEF\xBF\xBDs arguments" $+ unicodeCleanUTF8 "government\x92s arguments"
+ zenacy-unicode.cabal view
@@ -0,0 +1,79 @@+cabal-version: >= 1.10+version: 1.0.0+name:+ zenacy-unicode+synopsis:+ Unicode utilities for Haskell+description:+ Zenacy Unicode includes tools for checking byte order marks (BOM) and+ cleaning data to remove invalid bytes. These tools can help ensure that+ data pulled from the web can be parsed and converted to text.+homepage:+ https://github.com/mlcfp/zenacy-unicode+license:+ MIT+license-file:+ LICENSE+author:+ Michael Williams <mlcfp@icloud.com>+maintainer:+ Michael Williams <mlcfp@icloud.com>+copyright:+ Copyright (C) 2015-2020 Michael P Williams+category:+ Web+build-type:+ Simple+extra-source-files:+ README.md CHANGES.md++source-repository head+ type: git+ location: https://github.com/mlcfp/zenacy-unicode.git++library+ hs-source-dirs:+ src+ exposed-modules:+ Zenacy.Unicode+ build-depends:+ base == 4.*,+ bytestring >= 0.10.6.0 && < 0.11,+ vector >= 0.11 && < 0.13,+ word8 >= 0.1.2 && < 0.2++ ghc-options:+ -O3 -Wall+ -Wno-name-shadowing+ -Wno-unused-matches+ -Wno-unused-local-binds+ -Wno-unused-imports+ -Wno-unused-top-binds+ -Wno-incomplete-patterns+ default-extensions:+ default-language:+ Haskell2010++test-suite zenacy-unicode-test+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ TestSuite.hs+ build-depends:+ base == 4.*+ , bytestring+ , HUnit+ , test-framework+ , test-framework-hunit+ , text+ , zenacy-unicode+ default-extensions:+ ghc-options:+ -O3 -threaded -rtsopts -with-rtsopts=-N+ default-language:+ Haskell2010+ other-modules:+ Zenacy.Unicode.Tests+