diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,2 @@ +0.1.0.0 chessai chessai1996@gmail.com Feb 2018 + * First version. Ascii and Utf8 support only. diff --git a/Data/ByteString/Ascii.hs b/Data/ByteString/Ascii.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Ascii.hs @@ -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 diff --git a/Data/ByteString/Utf8.hs b/Data/ByteString/Utf8.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Utf8.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. 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/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -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 diff --git a/bytestring-encodings.cabal b/bytestring-encodings.cabal new file mode 100644 --- /dev/null +++ b/bytestring-encodings.cabal @@ -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 diff --git a/tests/Ascii.hs b/tests/Ascii.hs new file mode 100644 --- /dev/null +++ b/tests/Ascii.hs @@ -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) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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 diff --git a/tests/Utf8.hs b/tests/Utf8.hs new file mode 100644 --- /dev/null +++ b/tests/Utf8.hs @@ -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)