bytestring-encodings (empty) → 0.1.0.0
raw patch · 10 files changed
+581/−0 lines, 10 filesdep +basedep +bytestringdep +bytestring-encodingssetup-changed
Dependencies added: base, bytestring, bytestring-encodings, gauge, ghc-prim, hedgehog, text
Files
- ChangeLog.md +2/−0
- Data/ByteString/Ascii.hs +98/−0
- Data/ByteString/Utf8.hs +125/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- benchmark/Main.hs +37/−0
- bytestring-encodings.cabal +75/−0
- tests/Ascii.hs +102/−0
- tests/Main.hs +9/−0
- tests/Utf8.hs +111/−0
+ ChangeLog.md view
@@ -0,0 +1,2 @@+0.1.0.0 chessai chessai1996@gmail.com Feb 2018+ * First version. Ascii and Utf8 support only.
+ Data/ByteString/Ascii.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NoImplicitPrelude #-}++{-# OPTIONS_GHC -O2 #-}++module Data.ByteString.Ascii+ ( isAscii+ ) where++import Data.Bits ( (.&.) )+import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)+import Data.Word (Word8, Word64)+import GHC.Base+import GHC.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable (peek)++import qualified Data.ByteString as B++-- | Binary: 1000000010000000100000001000000010000000100000001000000010000000+-- Decimal: 9259542123273814144+m64 :: Word64+m64 = 0x8080808080808080++-- | Binary: 10000000+-- Decimal: 128+m8 :: Word8+m8 = 0x80++isAsciiPtrW64 :: Ptr Word64 -> Ptr Word64 -> IO Bool+isAsciiPtrW64 !p !q+ | p == q = pure True+ | otherwise = do+ c <- peek p+ if isAsciiW64 c+ then isAsciiPtrW64 (p `plusPtr` 8) q+ else pure False++isAsciiPtrW8 :: Ptr Word8 -> Ptr Word8 -> IO Bool+isAsciiPtrW8 !p !q+ | p == q = pure True+ | otherwise = do+ c <- peek p+ if isAsciiW8 c+ then isAsciiPtrW8 (p `plusPtr` 1) q+ else pure False++isAsciiW64 :: Word64 -> Bool+isAsciiW64 !w = w .&. m64 == 0++isAsciiW8 :: Word8 -> Bool+isAsciiW8 !w = w .&. m8 == 0++isAsciiSmall :: ByteString -> Bool+isAsciiSmall !b = B.all (< m8) b++alignPtrPos :: Ptr a -> Ptr a+alignPtrPos addr@(Ptr a) + = case remAddr# a 8# of+ 0# -> addr+ n -> Ptr (plusAddr# a (8# -# n))++alignPtrNeg :: Ptr a -> Ptr a+alignPtrNeg addr@(Ptr a)+ = case remAddr# a 8# of+ 0# -> addr+ n -> Ptr (plusAddr# a (negateInt# n))++-- | 'isAscii' can tell if a given 'ByteString' is ASCII-encoded.+isAscii :: ByteString -> Bool+isAscii (PS _ _ 0) = True+isAscii b@(PS fp (I# o#) len@(I# l#)) =+ accursedUnutterablePerformIO+ $ withForeignPtr fp+ $ \(Ptr addr) ->+ if len < 8+ then pure (isAsciiSmall b)+ else do+ let+ startPre, endPre, startPost, endPost :: Ptr Word8+ startMid, endMid :: Ptr Word64+ + startPre = Ptr (plusAddr# addr o#)+ endPre = alignPtrPos startPre+ startMid = castPtr endPre+ endMid = castPtr startPost+ startPost = alignPtrNeg endPost+ endPost = Ptr (plusAddr# addr (o# +# l#))+ + startIsAscii <- isAsciiPtrW8 startPre endPre + if startIsAscii+ then do+ endIsAscii <- isAsciiPtrW8 startPost endPost+ if endIsAscii+ then isAsciiPtrW64 startMid endMid+ else pure False+ else pure False
+ Data/ByteString/Utf8.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}++{-# OPTIONS_GHC -O2 #-}++module Data.ByteString.Utf8+ ( isUtf8 + , isUtf8' + ) where++import Data.Bits ( (.&.) )+import Data.ByteString.Ascii (isAscii)+import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)+import Data.Word (Word8)+import GHC.Base+import GHC.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable (peek)++data Utf8 = U8 | U16 | U24 | U32 | UNot+ deriving Eq++which :: Word8 -> Utf8+which c+ | isUtf8b8 c = U8+ | isUtf8b16 c = U16+ | isUtf8b24 c = U24+ | isUtf8b32 c = U32+ | otherwise = UNot++isUtf8Ptr :: Ptr Word8 -> Ptr Word8 -> IO Bool+isUtf8Ptr !p !q+ | p == q = pure True+ | otherwise = do+ c <- peek p++ case which c of+ U8 -> isUtf8Ptr (p `plusPtr` 1) q + U16 -> if q `minusPtr` p >= 2+ then + do d <- peek (p `plusPtr` 1) + if isUtf8OtherBytes d then isUtf8Ptr (p `plusPtr` 2) q else pure False+ else pure False+ U24 -> if q `minusPtr` p >= 3+ then+ do d <- peek (p `plusPtr` 1); e <- peek (p `plusPtr` 2)+ if (isUtf8OtherBytes d && isUtf8OtherBytes e) then isUtf8Ptr (p `plusPtr` 3) q else pure False+ else pure False+ U32 -> if q `minusPtr` p >= 4+ then+ do d <- peek (p `plusPtr` 1); e <- peek (p `plusPtr` 2); f <- peek (p `plusPtr` 3);+ if (isUtf8OtherBytes d && isUtf8OtherBytes e && isUtf8OtherBytes f) then isUtf8Ptr (p `plusPtr` 4) q else pure False+ else pure False+ UNot -> pure False++-- Hex: 0x80+-- Binary: 10000000+-- Decimal: 128+isUtf8b8 :: Word8 -> Bool+isUtf8b8 !w = w .&. 0x80 == 0++-- Hex: 0xE0 +-- Binary: 11100000+-- Decimal: 224+isUtf8b16 :: Word8 -> Bool+isUtf8b16 !w = w .&. 0xE0 == 0xC0++-- Hex: 0xF0+-- Binary: 11110000+-- Decimal: 240 +isUtf8b24 :: Word8 -> Bool+isUtf8b24 !w = w .&. 0xF0 == 0xE0+++-- Hex: 0xF8+-- Binary: 11111000+-- Decimal: 248+isUtf8b32 :: Word8 -> Bool+isUtf8b32 !w = w .&. 0xF8 == 0xF0++-- Hex: 0xC0+-- Binary: 11000000+-- Decimal: 192+isUtf8OtherBytes :: Word8 -> Bool+isUtf8OtherBytes !w = w .&. 0xC0 == 0x80++-- | 'isUtf8' firsts calls the very fast 'Data.ByteString.Ascii.isAscii' to see if+-- the data is ASCII (and thus UTF-8). Use this if you know most of your+-- data is ASCII-encoded.+-- If you know that most of your data is probably not UTF8-encoded, it is probably+-- best to use 'isUtf8'' to avoid this check.+isUtf8 :: ByteString -> Bool+isUtf8 (PS _ _ 0) = True+isUtf8 b@(PS fp (I# o#) (I# l#)) = if isAscii b then True else+ accursedUnutterablePerformIO+ $ withForeignPtr fp+ $ \(Ptr addr) ->+ do+ let+ start, end :: Ptr Word8+ start = Ptr (plusAddr# addr o#)+ end = Ptr (plusAddr# addr (o# +# l#))+ + isUtf8Ptr start end++-- | 'isUtf8'' does not call 'Data.ByteString.Ascii.isAscii. Use this if+-- you know most of your data is not ASCII-encoded.+-- If you know that most of your data is probably ASCII-encoded, it is+-- probably best to use 'isUtf8'.+isUtf8' :: ByteString -> Bool+isUtf8' (PS _ _ 0) = True+isUtf8' (PS fp (I# o#) (I# l#)) =+ accursedUnutterablePerformIO+ $ withForeignPtr fp+ $ \(Ptr addr) ->+ do+ let+ start, end :: Ptr Word8+ start = Ptr (plusAddr# addr o#)+ end = Ptr (plusAddr# addr (o# +# l#))+ + isUtf8Ptr start end
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2018 chessai++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Main.hs view
@@ -0,0 +1,37 @@+module Main (main) where++import Gauge.Main+import Data.ByteString.Ascii (isAscii)+import Data.ByteString.Utf8 (isUtf8)+import Data.ByteString (ByteString)+import qualified Data.List as L+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.Text.Encoding as TE++main :: IO ()+main = do+ let bs = BC.pack (L.take 50000 (L.cycle ['a'..'z']))+ bsAscii = bs+ bsUtf8 = BC.pack (L.take 50000 (L.cycle+ [ '¿', 'D', 'ó', 'n', 'd', 'e'+ ]))++ defaultMain+ [ + bgroup "ASCII: naive versus isAscii"+ [ bench "Data.ByteString.all" $ whnf standardIsAscii bs+ , bench "isAscii" $ whnf isAscii bs+ ]+ , bgroup "ASCII: Data.Text.Encoding.decodeUtf8 versus isUtf8" + [ bench "Data.Text.Encoding.decodeUtf8" $ whnf TE.decodeUtf8 bsAscii+ , bench "isUtf8" $ whnf isUtf8 bsAscii+ ]+ , bgroup "UTF-8: isUtf8"+ [ + bench "isUtf8" $ whnf isUtf8 bsUtf8 + ]+ ]++standardIsAscii :: ByteString -> Bool+standardIsAscii bs = B.all (\x -> x < 127) bs
+ bytestring-encodings.cabal view
@@ -0,0 +1,75 @@+name:+ bytestring-encodings+version:+ 0.1.0.0+synopsis:+ checks to see if a given bytestring adheres to a certain encoding +description:+ 'Data.ByteString.X' modules provide simple, efficient function 'isX :: ByteString -> Bool'+ which returns 'True' if a given ByteString adheres to a certain encoding X,+ and 'False' otherwise. +license:+ MIT+license-file:+ LICENSE+author:+ chessai+maintainer:+ chessai1996@gmail.com+copyright:+ chessai (c) 2018 +category:+ Data +build-type:+ Simple+extra-source-files:+ ChangeLog.md+cabal-version:+ >=1.10++source-repository head+ type: git+ location: https://github.com/chessai/bytestring-encodings++flag dev-wall-werror+ description: turn on -Wall -Werror for development purposes+ manual: True+ default: False++library+ exposed-modules:+ Data.ByteString.Ascii+ , Data.ByteString.Utf8 + build-depends:+ base >=4.10 && <4.11+ , bytestring + , ghc-prim + default-language: Haskell2010+ if flag(dev-wall-werror)+ ghc-options: -Wall -Werror++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ other-modules:+ Ascii+ Utf8 + build-depends:+ base+ , bytestring+ , bytestring-encodings+ , hedgehog + default-language: Haskell2010++benchmark microbenchmark+ type: exitcode-stdio-1.0+ build-depends:+ base+ , bytestring + , bytestring-encodings+ , gauge+ , text+ default-language: Haskell2010+ hs-source-dirs: benchmark+ main-is: Main.hs
+ tests/Ascii.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TemplateHaskell #-}++module Ascii + ( testAscii+ ) where++import Control.Applicative (liftA2)+import Data.Bits ((.&.), xor)+import Data.ByteString.Ascii (isAscii)+import Data.Word (Word8, Word64)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Internal as BI++sizedByteStringSucc :: Range.Size -> Gen B.ByteString+sizedByteStringSucc (Range.Size n) = do+ m <- Gen.enum 0 n+ fmap B.pack $ Gen.list (Range.constant 0 m) (randWord8)+ where+ randWord8 :: Gen Word8+ randWord8 = fmap (\w -> w .&. 0x7F) (Gen.word8 Range.constantBounded)++randSuccBS :: Gen B.ByteString+randSuccBS = do+ bs <- Gen.sized sizedByteStringSucc+ n <- Gen.enum 0 7+ pure (B.drop n bs) -- to give us some with non-0 offset++-- This should generate a 'ByteString' for which isAscii should short-circuit;+-- i.e. the check of any 'Word8' in the 'ByteString' should fail.+sizedByteString_ShortCircuit :: Range.Size -> Gen B.ByteString+sizedByteString_ShortCircuit (Range.Size n) = do+ m <- Gen.enum 0 n+ fmap B.pack $ Gen.list (Range.constant 0 m) (randWord8)+ where+ randWord8 :: Gen Word8+ randWord8 = fmap (\w -> if w > 127 then w else w `xor` 0xFF) (Gen.word8 Range.constantBounded)++-- a ByteString b for which isAscii b should never fail+noFailBS :: [Word8]+noFailBS = [0x7F,0x7F,0x7F,0x7F,0x7F,0x7F,0x7F,0x7F]++-- This makes sure we test past the first 8 bytes, and before the last 8 bytes, by generating a failing 'ByteString' of+-- length >= 1, then prepending and appending 'noFailBS' to it. +sizedByteStringFail :: Range.Size -> Gen B.ByteString+sizedByteStringFail (Range.Size n) = do+ m <- Gen.enum 1 (n+1)+ fmap B.pack $+ liftA2 (++) (pure noFailBS) $ + liftA2 (++) (Gen.list (Range.constant 8 (m+8)) randWord8) (pure noFailBS)+ where+ randWord8 :: Gen Word8+ randWord8 = fmap (\w -> if w > 127 then w else w `xor` 0xFF) (Gen.word8 Range.constantBounded)+ +randFailBS_ShortCircuit :: Gen B.ByteString+randFailBS_ShortCircuit = do+ bs <- Gen.sized sizedByteString_ShortCircuit + n <- Gen.enum 0 7+ pure (B.drop n bs) -- to give us some with non-0 offset++randFailBS :: Gen B.ByteString+randFailBS = do+ bs <- Gen.sized sizedByteStringFail + n <- Gen.enum 0 7+ pure (B.drop n bs) -- to give us some with non-0 offset ++showRawByteString :: B.ByteString -> String+showRawByteString bs@(BI.PS fptr off len) =+ "Payload: " ++ show (B.unpack bs) ++ ", ptr: " ++ show fptr ++ ", offset: " ++ show off ++ " len: " ++ show len++prop_noFail :: Property+prop_noFail =+ property $ do+ isAscii (B.pack noFailBS) === True++prop_isAsciiSucc :: Property+prop_isAsciiSucc =+ property $ do+ xs <- forAllWith showRawByteString randSuccBS+ isAscii xs === True++prop_isAsciiFail_ShortCircuit :: Property+prop_isAsciiFail_ShortCircuit =+ property $ do+ xs <- forAllWith showRawByteString randFailBS_ShortCircuit+ if B.length xs > 0+ then isAscii xs === False+ else isAscii xs === True++prop_isAsciiFail :: Property+prop_isAsciiFail =+ property $ do+ xs <- forAllWith showRawByteString randFailBS+ if B.length xs > 0+ then isAscii xs === False+ else isAscii xs === True++testAscii :: IO Bool+testAscii = checkParallel $$(discover)
+ tests/Main.hs view
@@ -0,0 +1,9 @@+module Main where++import qualified Ascii as Asc+import qualified Utf8 as Utf8++main :: IO Bool+main = do + Asc.testAscii+ Utf8.testUtf8
+ tests/Utf8.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Utf8+ ( testUtf8+ ) where++{-# OPTIONS_GHC -Wall #-}++import Control.Applicative (liftA2)+import Control.Monad (join, sequence)+import Data.Bits ((.&.), xor)+import Data.ByteString.Utf8 (isUtf8)+import Data.Char (chr)+import Data.Foldable (foldl')+import Data.Word (Word8)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Internal as BI++randWBS_Fail :: Gen B.ByteString+randWBS_Fail = do+ m <- Gen.enum 1 7+ case m of+ 1 -> g ( [ Gen.enum 0b10000000 0b11101111 -- Byte 1 <- [128..239]+ , Gen.enum 0b00000000 0b01000000 -- Byte 2 <- [ 0..127]+ , Gen.enum 0b00000000 0b01000000 -- Byte 3 <- [ 0..127]+ , Gen.enum 0b00000000 0b01000000 -- Byte 4 <- [ 0..127]+ ] :: [Gen Word8])+ 2 -> g ( [ Gen.enum 0b11111000 0b11111111 -- Byte 1 <- [248..255]+ , Gen.enum 0b11000000 0b11111111 -- Byte 2 <- [192..255]+ , Gen.enum 0b11000000 0b11111111 -- Byte 3 <- [192..255] + , Gen.enum 0b11000000 0b11111111 -- Byte 3 <- [192..255] + ] :: [Gen Word8])+ 3 -> g ( [ Gen.enum 0b10000000 0b10111111 -- Byte 1 <- [128..191]+ , Gen.enum 0b00000000 0b01000000 -- Byte 2 <- [ 0..127] + ] :: [Gen Word8])+ 4 -> g ( [ Gen.enum 0b11100000 0b11111111 -- Byte 1 <- [224..255]+ , Gen.enum 0b11000000 0b11111111 -- Byte 2 <- [192..255] + ] :: [Gen Word8])+ 5 -> g ( [ Gen.enum 0b10000000 0b11011111 -- Byte 1 <- [128..223]+ , Gen.enum 0b00000000 0b01000000 -- Byte 2 <- [ 0..127] + , Gen.enum 0b00000000 0b01000000 -- Byte 3 <- [ 0..127] + ] :: [Gen Word8])+ 6 -> g ( [ Gen.enum 0b11110000 0b11111111 -- Byte 1 <- [240..255]+ , Gen.enum 0b00000000 0b01000000 -- Byte 2 <- [ 0..127]+ , Gen.enum 0b00000000 0b01000000 -- Byte 2 <- [ 0..127]+ ] :: [Gen Word8])+ 7 -> g ( [ Gen.enum 0b11100000 0b11111111 + ] :: [Gen Word8])+ _ -> pure $ B.pack [0b01000000] + where+ g :: [Gen Word8] -> Gen B.ByteString+ g ls = foldl (liftA2 mappend) (pure B.empty) $ fmap (fmap B.singleton) ls ++randWBS_Succ :: Gen B.ByteString+randWBS_Succ = do+ m <- Gen.enum 1 4+ case m of+ 1 -> g ( [ Gen.enum 0b00000000 0b01000000+ ] :: [Gen Word8])+ 2 -> g ( [ Gen.enum 0b11000001 0b11011111+ , Gen.enum 0b10000000 0b10111111+ ] :: [Gen Word8])+ 3 -> g ( [ Gen.enum 0b11100000 0b11101111+ , Gen.enum 0b10000000 0b10111111+ , Gen.enum 0b10000000 0b10111111+ ] :: [Gen Word8])+ 4 -> g ( [ Gen.enum 0b11110000 0b11110111+ , Gen.enum 0b10000000 0b10111111+ , Gen.enum 0b10000000 0b10111111+ , Gen.enum 0b10000000 0b10111111] :: [Gen Word8])+ where+ g :: [Gen Word8] -> Gen B.ByteString+ g ls = foldl (liftA2 mappend) (pure B.empty) $ fmap (fmap B.singleton) ls + +sizedByteString_Fail :: Range.Size -> Gen B.ByteString+sizedByteString_Fail (Range.Size n) = do+ m <- Gen.enum 0 n+ fmap (foldl' B.append B.empty) $ Gen.list (Range.constant 0 m) randWBS_Fail++sizedByteString_Succ :: Range.Size -> Gen B.ByteString+sizedByteString_Succ (Range.Size n) = do+ m <- Gen.enum 0 n+ fmap (foldl' B.append B.empty) $ Gen.list (Range.constant 0 m) randWBS_Succ++showRawByteString :: B.ByteString -> String+showRawByteString bs@(BI.PS fptr off len) =+ "Payload: " ++ show (B.unpack bs) ++ ", ptr: " ++ show fptr ++ ", offset: " ++ show off ++ " len: " ++ show len++prop_isUtf8_Fail :: Property+prop_isUtf8_Fail =+ property $ do+ xs <- forAllWith showRawByteString (Gen.sized sizedByteString_Fail)+ if B.length xs > 0+ then isUtf8 xs === False+ else isUtf8 xs === True++prop_isUtf8_Succ :: Property+prop_isUtf8_Succ =+ property $ do+ xs <- forAllWith showRawByteString (Gen.sized sizedByteString_Succ)+ isUtf8 xs === True++testUtf8 :: IO Bool+testUtf8 = checkParallel $$(discover)