text-short (empty) → 0.1
raw patch · 7 files changed
+516/−0 lines, 7 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, deepseq, hashable, quickcheck-instances, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, text-short
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cbits/cbits.c +141/−0
- src-test/Tests.hs +46/−0
- src/Data/Text/Short.hs +231/−0
- text-short.cabal +61/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for `text-short`++## 0.1++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Herbert Valerio Riedel++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 Herbert Valerio Riedel 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
+ cbits/cbits.c view
@@ -0,0 +1,141 @@+/*+ * Copyright (c) 2017, Herbert Valerio Riedel+ * + * 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 Herbert Valerio Riedel 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.+ */++#include <stdint.h>+#include <string.h>+#include <assert.h>++/* Count number of code-points in well-formed utf8 string */+size_t+hs_text_short_length(const uint8_t buf[], const size_t n)+{+ size_t j,l = 0;+ for (j = 0; j < n; j++)+ if ((buf[j] & 0xc0) != 0x80)+ l++;++ return l;+}++/* Validate UTF8 encoding++ 7 bits | 0xxxxxxx+11 bits | 110yyyyx 10xxxxxx +16 bits | 1110yyyy 10yxxxxx 10xxxxxx +21 bits | 11110yyy 10yyxxxx 10xxxxxx 10xxxxxx ++Valid code-points:++ [U+0000 .. U+D7FF] + [U+E000 .. U+10FFFF]++Return values:++ 0 -> ok+ 1 -> invalid byte/code-point+ 2 -> truncated++*/++int+hs_text_short_is_valid_utf8(const uint8_t buf[], const size_t n)+{+ size_t j = 0;++ while (j < n) {+ const uint8_t b0 = buf[j++];++ if (!(b0 & 0x80))+ continue;++ if ((b0 & 0xe0) == 0xc0) {+ if (!(b0 & 0x1e)) return 1; /* denorm */+ if (j >= n) return 2;+ + /* b1 */+ if ((buf[j++] & 0xc0) != 0x80) return 1;+ continue;+ }++ if ((b0 & 0xf0) == 0xe0) {+ if ((j+1) >= n) return 2;++ const uint8_t b1 = buf[j++];+ if ((b1 & 0xc0) != 0x80) return 1;+ if (!((b0 & 0x0f) | (b1 & 0x20))) return 1; /* denorm */+ /* UTF16 Surrogate pairs [U+D800 .. U+DFFF] */+ if ((b0 == 0xed) && (b1 & 0x20)) return 1;+ + /* b2 */+ if ((buf[j++] & 0xc0) != 0x80) return 1;+ + continue;+ }++ if ((b0 & 0xf8) == 0xf0) {+ if ((j+2) >= n) return 2;+ + const uint8_t b1 = buf[j++];+ if ((b1 & 0xc0) != 0x80) return 1;+ if (!((b0 & 0x07) | (b1 & 0x30))) return 1; /* denorm */+ /* make sure we're below U+10FFFF */+ if (b0 > 0xf4) return 1;+ if ((b0 == 0xf4) && (b1 & 0x30)) return 1;+ + /* b2 */+ if ((buf[j++] & 0xc0) != 0x80) return 1;+ /* b3 */+ if ((buf[j++] & 0xc0) != 0x80) return 1;++ continue;+ }+ + return 1;+ }++ assert(j == n);++ return 0;+}+++/* Test whether well-formed UTF8 string contains only ASCII code-points+ * Returns length of longest ASCII-code-point prefix.+ */+size_t+hs_text_short_is_ascii(const uint8_t buf[], const size_t n)+{+ size_t j;+ for (j = 0; j < n; j++)+ if (buf[j] & 0x80)+ return j;+}
+ src-test/Tests.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Main(main) where++import qualified Data.Text.Short as IUT+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit+import Test.QuickCheck.Instances ()+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.String as D.S+import Data.Binary+import Data.Char+import Data.Monoid++fromByteStringRef = either (const Nothing) (Just . IUT.fromText) . T.decodeUtf8'++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests,qcProps]++qcProps :: TestTree+qcProps = testGroup "Properties"+ [ QC.testProperty "length/fromText" $ \t -> IUT.length (IUT.fromText t) == T.length t+ , QC.testProperty "length/fromString" $ \s -> IUT.length (IUT.fromString s) == length s+ , QC.testProperty "toText.fromText" $ \t -> (IUT.toText . IUT.fromText) t == t+ , QC.testProperty "fromByteString" $ \b -> IUT.fromByteString b == fromByteStringRef b+ , QC.testProperty "fromByteString.toByteString" $ \t -> let ts = IUT.fromText t in (IUT.fromByteString . IUT.toByteString) ts == Just ts+ , QC.testProperty "toString.fromString" $ \s -> (IUT.toString . IUT.fromString) s == s+ , QC.testProperty "isAscii" $ \s -> IUT.isAscii (IUT.fromString s) == all isAscii s+ , QC.testProperty "isAscii2" $ \t -> IUT.isAscii (IUT.fromText t) == T.all isAscii t+ ]++unitTests = testGroup "Unit-tests"+ [ testCase "fromText mempty" $ IUT.fromText mempty @?= mempty+ , testCase "fromShortByteString [0xc0,0x80]" $ IUT.fromShortByteString "\xc0\x80" @?= Nothing+ , testCase "fromByteString [0xc0,0x80]" $ IUT.fromByteString "\xc0\x80" @?= Nothing+ , testCase "IsString U+D800" $ "\xFFFD" @?= (IUT.fromString "\xD800")+-- , testCase "IsString U+D800" $ (IUT.fromString "\xD800") @?= IUT.fromText ("\xD800" :: T.Text)++ , testCase "Binary.encode" $ encode ("Hello \8364 & \171581!\NUL" :: IUT.ShortText) @?= "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC2Hello \226\130\172 & \240\169\184\189!\NUL"+ , testCase "Binary.decode" $ decode ("\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC2Hello \226\130\172 & \240\169\184\189!\NUL") @?= ("Hello \8364 & \171581!\NUL" :: IUT.ShortText)+ ]
+ src/Data/Text/Short.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, MagicHash, UnliftedFFITypes, Trustworthy #-}++-- |+-- Module : Data.Text.Short+-- Copyright : © Herbert Valerio Riedel 2017+-- License : BSD3+--+-- Maintainer : hvr@gnu.org+-- Stability : stable+--+-- Memory-efficient representation of Unicode text strings.+module Data.Text.Short+ ( -- * The 'ShortText' type+ ShortText++ -- * Basic operations+ , Data.Text.Short.null+ , Data.Text.Short.length+ , Data.Text.Short.isAscii++ -- * Conversions+ -- ** 'String'+ , Data.Text.Short.fromString+ , toString++ -- ** 'T.Text'+ , fromText+ , toText++ -- ** 'BS.ByteString'+ , fromShortByteString+ , toShortByteString++ , fromByteString+ , toByteString++ , toBuilder++ ) where++import Control.DeepSeq (NFData)+-- import Control.Exception as E+import qualified Data.ByteString as BS+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as BSS+import qualified Data.ByteString.Short.Internal as BSSI+import Data.Char+import Data.Hashable (Hashable)+import Data.Semigroup+import qualified Data.String as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Foreign.C+import GHC.Exts (ByteArray#)+import qualified GHC.Foreign as GHC+import GHC.IO.Encoding+import System.IO.Unsafe+import Data.Binary+import qualified Data.ByteString.Builder as BB++-- | A compact representation of Unicode strings.+--+-- This type relates to 'T.Text' as 'ShortByteString' relates to 'BS.ByteString' by providing a more compact type. Please consult the documentation of "Data.ByteString.Short" for more information.+--+-- Currently, a boxed unshared 'T.Text' has a memory footprint of 6 words (i.e. 48 bytes on 64-bit systems) plus 2 or 4 bytes per code-point (due to the internal UTF-16 representation). Each 'T.Text' value which can share its payload with another 'T.Text' requires only 4 words additionally. Unlike 'BS.ByteString', 'T.Text' use unpinned memory.+--+-- In comparison, the footprint of a boxed 'ShortText' is only 4 words (i.e. 32 bytes on 64-bit systems) plus 1/2/3/4 bytes per code-point (due to the internal UTF-8 representation).+-- It can be shown that for realistic data <http://utf8everywhere.org/#asian UTF-16 has a space overhead of 50% over UTF-8>.+--+newtype ShortText = ShortText ShortByteString+ deriving (Eq,Ord,Monoid,Semigroup,Hashable,NFData)++instance Show ShortText where+ showsPrec p (ShortText b) = showsPrec p (decodeStringShort' utf8 b)+ show (ShortText b) = show (decodeStringShort' utf8 b)++instance Read ShortText where+ readsPrec p = map (\(x,s) -> (ShortText $ encodeStringShort utf8 x,s)) . readsPrec p++-- | Behaviour for @[U+D800 .. U+DFFF]@ matches the 'IsString' instance for 'T.Text'+instance S.IsString ShortText where+ fromString = fromString++-- | The 'Binary' encoding matches the one for 'T.Text'+#if MIN_VERSION_binary(0,8,1)+instance Binary ShortText where+ put = put . toShortByteString+ get = do+ sbs <- get+ case fromShortByteString sbs of+ Nothing -> fail "Binary.get(ShortText): Invalid UTF-8 stream"+ Just st -> return st+#else+-- fallback via 'ByteString' instance+instance Binary ShortText where+ put = put . toByteString+ get = do+ bs <- get+ case fromByteString bs of+ Nothing -> fail "Binary.get(ShortText): Invalid UTF-8 stream"+ Just st -> return st+#endif++-- | /O(1)/ Test whether a 'ShortText' is empty.+null :: ShortText -> Bool+null = BSS.null . toShortByteString++-- | /O(n)/ Count the number of Unicode code-points in a 'ShortText'.+length :: ShortText -> Int+length st = fromIntegral $ unsafePerformIO (c_text_short_length (toByteArray# st) (toCSize st))++foreign import ccall unsafe "hs_text_short_length" c_text_short_length :: ByteArray# -> CSize -> IO CSize++-- | /O(n)/ Test whether 'ShortText' contains only ASCII code-points (i.e. only U+0000 through U+007F).+isAscii :: ShortText -> Bool+isAscii st = (== sz) $ unsafePerformIO (c_text_short_is_ascii (toByteArray# st) sz)+ where+ sz = toCSize st++foreign import ccall unsafe "hs_text_short_is_ascii" c_text_short_is_ascii :: ByteArray# -> CSize -> IO CSize++----------------------------------------------------------------------------++toCSize :: ShortText -> CSize+toCSize = fromIntegral . BSS.length . toShortByteString++toByteArray# :: ShortText -> ByteArray#+toByteArray# (ShortText (BSSI.SBS ba#)) = ba#++-- | /O(0)/ Converts to UTF-8 encoded 'ShortByteString'+--+-- This operation has effectively no overhead, as it's currently merely a @newtype@-cast.+toShortByteString :: ShortText -> ShortByteString+toShortByteString (ShortText b) = b++-- | /O(n)/ Converts to UTF-8 encoded 'BS.ByteString'+toByteString :: ShortText -> BS.ByteString+toByteString = BSS.fromShort . toShortByteString++-- | Construct a 'BB.Builder' that encodes 'ShortText' as UTF-8.+toBuilder :: ShortText -> BB.Builder+toBuilder = BB.shortByteString . toShortByteString++-- | /O(n)/ Convert to 'String'+toString :: ShortText -> String+toString = decodeStringShort' utf8 . toShortByteString++-- | /O(n)/ Convert to 'T.Text'+--+-- This is currently not /O(1)/ because currently 'T.Text' uses UTF-16 as its internal representation.+-- In the event that 'T.Text' will change its internal representation to UTF-8 this operation will become /O(1)/.+toText :: ShortText -> T.Text+toText = T.decodeUtf8 . toByteString++----++-- | /O(n)/ Construct/pack from 'String'+--+-- Note: This function is total because it replaces the (invalid) code-points U+D800 through U+DFFF with the replacement character U+FFFD.+fromString :: String -> ShortText+fromString = ShortText . encodeStringShort utf8 . map r+ where+ r c | 0xd800 <= x && x < 0xe000 = '\xFFFD'+ | otherwise = c+ where+ x = ord c++-- | /O(n)/ Construct 'ShortText' from 'T.Text'+--+-- This is currently not /O(1)/ because currently 'T.Text' uses UTF-16 as its internal representation.+-- In the event that 'T.Text' will change its internal representation to UTF-8 this operation will become /O(1)/.+fromText :: T.Text -> ShortText+fromText = fromByteString' . T.encodeUtf8++-- | /O(n)/ Construct 'ShortText' from UTF-8 encoded 'ShortByteString'+--+-- This operation doesn't copy the input 'ShortByteString' but it+-- cannot be /O(1)/ because we need to validate the UTF-8 encoding.+--+-- Returns 'Nothing' in case of invalid UTF-8 encoding.+fromShortByteString :: ShortByteString -> Maybe ShortText+fromShortByteString sbs+ | isValidUtf8 st = Just st+ | otherwise = Nothing+ where+ st = ShortText sbs++-- | /O(n)/ Construct 'ShortText' from UTF-8 encoded 'BS.ByteString'+--+-- Returns 'Nothing' in case of invalid UTF-8 encoding.+fromByteString :: BS.ByteString -> Maybe ShortText+fromByteString = fromShortByteString . BSS.toShort++----------------------------------------------------------------------------++-- non-validating+fromByteString' :: BS.ByteString -> ShortText+fromByteString' = ShortText . BSS.toShort++++----------------------------------------------------------------------------++encodeString :: TextEncoding -> String -> BS.ByteString+encodeString te str = unsafePerformIO $ GHC.withCStringLen te str BS.packCStringLen++-- decodeString :: TextEncoding -> BS.ByteString -> Maybe String+-- decodeString te bs = cvtEx $ unsafePerformIO $ try $ BS.useAsCStringLen bs (GHC.peekCStringLen te)+-- where+-- cvtEx :: Either IOException a -> Maybe a+-- cvtEx = either (const Nothing) Just++decodeString' :: TextEncoding -> BS.ByteString -> String+decodeString' te bs = unsafePerformIO $ BS.useAsCStringLen bs (GHC.peekCStringLen te)++decodeStringShort' :: TextEncoding -> ShortByteString -> String+decodeStringShort' te = decodeString' te . BSS.fromShort++encodeStringShort :: TextEncoding -> String -> BSS.ShortByteString+encodeStringShort te = BSS.toShort . encodeString te+++isValidUtf8 :: ShortText -> Bool+isValidUtf8 st = (==0) $ unsafePerformIO (c_text_short_is_valid_utf8 (toByteArray# st) (toCSize st))++foreign import ccall unsafe "hs_text_short_is_valid_utf8" c_text_short_is_valid_utf8 :: ByteArray# -> CSize -> IO CInt++{- TODO:+{-# RULES "ShortText strlit" forall s . fromString (unpackCString# s) = fromAddr# #-}+...+-}
+ text-short.cabal view
@@ -0,0 +1,61 @@+name: text-short+version: 0.1+synopsis: Memory-efficient representation of Unicode text strings+license: BSD3+license-file: LICENSE+author: Herbert Valerio Riedel+maintainer: hvr@gnu.org+bug-reports: https://github.com/hvr/text-short/issues+category: Data+build-type: Simple+cabal-version: >=1.10+description: This package provides the 'ShortText' type which is suitable for keeping many short strings in memory. This is similiar to how 'ShortByteString' relates to 'ByteString'.+ .+ The main difference between 'Text' and 'ShortText' is that 'ShortText' uses UTF-8 instead of UTF-16 internally and also doesn't support slicing (thereby saving 2 words). Consequently, the memory footprint of a (boxed) 'ShortText' value is 4 words (2 words when unboxed) plus the length of the UTF-8 encoded payload.++extra-source-files: ChangeLog.md++Source-Repository head+ Type: git+ Location: https://github.com/hvr/text-short.git++library+ default-language: Haskell2010+ exposed-modules: Data.Text.Short+ build-depends: base >= 4.7 && < 4.11+ , bytestring >= 0.10.4 && < 0.11+ , hashable >= 1.2.6 && < 1.3+ , deepseq >= 1.3 && < 1.5+ , text >= 1.0 && < 1.3+ , binary >= 0.7.1 && < 0.9++ if !impl(ghc >= 8.0)+ build-depends: semigroups >= 0.18.2 && < 0.19++ hs-source-dirs: src++ default-language: Haskell2010+ other-extensions: CPP+ , GeneralizedNewtypeDeriving+ , MagicHash+ , UnliftedFFITypes+ , Trustworthy++ c-sources: cbits/cbits.c+ ghc-options: -Wall++test-suite tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: src-test+ main-is: Tests.hs++ build-depends: base+ , binary+ , text+ , text-short+ -- deps which don't inherit constraints from library stanza:+ , tasty >= 0.11.2 && < 0.12+ , tasty-quickcheck >= 0.8.4 && < 0.9+ , tasty-hunit >= 0.9.2 && < 0.10+ , quickcheck-instances >= 0.3.14 && < 0.4