text-short 0.1.1 → 0.1.2

raw patch · 10 files changed

+2801/−323 lines, 10 filesdep +ghc-primdep ~basedep ~hashabledep ~semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: base, hashable, semigroups, tasty, tasty-hunit, tasty-quickcheck

API changes (from Hackage documentation)

Files

• ChangeLog.md +65/−3
• cbits/cbits.c +563/−47
• cbits/memcmp.c +12/−0
• src-ghc708/PrimOps.hs +23/−0
• src-ghc804/PrimOps.hs +6/−0
• src-test/Tests.hs +191/−13
• src/Data/Text/Short.hs +292/−4
• src/Data/Text/Short/Internal.hs +1517/−246
• src/Data/Text/Short/Partial.hs +100/−0
• text-short.cabal +32/−10

@@ -1,10 +1,72 @@-# Revision history for `text-short`+## 0.1.2 -## 0.1+  * Add `IsList ShortText` and `PrintfArg ShortText` instances+  * Expose partial functions via new `Data.Text.Short.Partial` module -* First version. Released on an unsuspecting world.+        foldl1 :: (Char -> Char -> Char) -> ShortText -> Char+        foldl1' :: (Char -> Char -> Char) -> ShortText -> Char+        foldr1 :: (Char -> Char -> Char) -> ShortText -> Char+        head :: ShortText -> Char+        index :: ShortText -> Int -> Char+        init :: ShortText -> ShortText+        last :: ShortText -> Char+        tail :: ShortText -> ShortText +  * Add several `Data.Text` verbs to `Data.Text.Short` API++        (!?) :: ShortText -> Int -> Maybe Char+        all :: (Char -> Bool) -> ShortText -> Bool+        any :: (Char -> Bool) -> ShortText -> Bool+        append :: ShortText -> ShortText -> ShortText+        break :: (Char -> Bool) -> ShortText -> (ShortText, ShortText)+        breakEnd :: (Char -> Bool) -> ShortText -> (ShortText, ShortText)+        concat :: [ShortText] -> ShortText+        cons :: Char -> ShortText -> ShortText+        drop :: Int -> ShortText -> ShortText+        dropAround :: (Char -> Bool) -> ShortText -> ShortText+        dropEnd :: Int -> ShortText -> ShortText+        dropWhile :: (Char -> Bool) -> ShortText -> ShortText+        dropWhileEnd :: (Char -> Bool) -> ShortText -> ShortText+        empty :: ShortText+        filter :: (Char -> Bool) -> ShortText -> ShortText+        find :: (Char -> Bool) -> ShortText -> Maybe Char+        findIndex :: (Char -> Bool) -> ShortText -> Maybe Int+        foldl :: (a -> Char -> a) -> a -> ShortText -> a+        foldl' :: (a -> Char -> a) -> a -> ShortText -> a+        foldr :: (Char -> a -> a) -> a -> ShortText -> a+        indexEndMaybe :: ShortText -> Int -> Maybe Char+        indexMaybe :: ShortText -> Int -> Maybe Char+        intercalate :: ShortText -> [ShortText] -> ShortText+        intersperse :: Char -> ShortText -> ShortText+        isPrefixOf :: ShortText -> ShortText -> Bool+        isSuffixOf :: ShortText -> ShortText -> Bool+        pack :: [Char] -> ShortText+        replicate :: Int -> ShortText -> ShortText+        reverse :: ShortText -> ShortText+        singleton :: Char -> ShortText+        snoc :: ShortText -> Char -> ShortText+        span :: (Char -> Bool) -> ShortText -> (ShortText, ShortText)+        spanEnd :: (Char -> Bool) -> ShortText -> (ShortText, ShortText)+        splitAt :: Int -> ShortText -> (ShortText, ShortText)+        splitAtEnd :: Int -> ShortText -> (ShortText, ShortText)+        stripPrefix :: ShortText -> ShortText -> Maybe ShortText+        stripSuffix :: ShortText -> ShortText -> Maybe ShortText+        take :: Int -> ShortText -> ShortText+        takeEnd :: Int -> ShortText -> ShortText+        takeWhile :: (Char -> Bool) -> ShortText -> ShortText+        takeWhileEnd :: (Char -> Bool) -> ShortText -> ShortText+        uncons :: ShortText -> Maybe (Char, ShortText)+        unpack :: ShortText -> [Char]+        unsnoc :: ShortText -> Maybe (ShortText, Char)++  * Optimise low-level primitives+  * Add support for GHC 8.4+ ## 0.1.1  * Expose *unsafe* conversion API via `Data.Text.Short.Unsafe` module * Minor documentation improvement++## 0.1++* First version. Released on an unsuspecting world.

@@ -1,23 +1,23 @@ /*  * 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@@ -31,28 +31,326 @@  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  */ +#if !defined(NDEBUG)+# warning assert(3) checks enabled+#endif+ #include <stdint.h>+#include <stdbool.h> #include <string.h>+#include <stdlib.h> #include <assert.h>+#include <HsFFI.h> +#if !defined(SIZEOF_VOID_P)+# error <HsFFI.h> SIZEOF_VOID_P not defined+#endif++#if (SIZEOF_VOID_P) == 8+const static bool is_64bit = true;+#elif (SIZEOF_VOID_P) == 4+const static bool is_64bit = false;+#else+# error unexpected SIZEOF_VOID_P value+#endif++#if (WORDS_BIGENDIAN)+const static bool is_bigendian = true;+#else+const static bool is_bigendian = false;+#endif++#if defined(__GNUC__)+# define likely(x)     __builtin_expect(!!(x),1)+# define unlikely(x)   __builtin_expect(!!(x),0)+#else+# define likely(x)     (x)+# define unlikely(x)   (x)+#endif++/* test whether octet in UTF-8 steam is not a continuation byte, i.e. a leading byte */+#define utf8_lead_p(octet) (((octet) & 0xc0) != 0x80)++/* 0 <= x <= 0x110000 */+typedef HsWord codepoint_t;+ /* 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;+  size_t j = 0;+  size_t l = 0;++  /* Both GCC & Clang are able to optimise the code below quite well at -O3 */   for (j = 0; j < n; j++)-    if ((buf[j] & 0xc0) != 0x80)+    if (utf8_lead_p(buf[j]))       l++;    return l; } +/* Locate offset of j-th code-point in well-formed utf8 string+ *+ */+size_t+hs_text_short_index_ofs(const uint8_t buf[], const size_t n, const size_t i)+{+  if (!n)+    return n;++  size_t m = 0;+  size_t j = 0;++  for (;;) {+    assert(m >= 0);+    assert(j <= i);+    assert(j <= m);++    if (j == i)+      return m; /* found */++    if (i-j >= n-m)+      return n; /* i-th char is >= buf+n */++    assert(m < n);+    const uint8_t b0 = buf[m];++    if (!(b0 & 0x80))+      m += 1;   /* 0_______ */+    else+      switch(b0 >> 4) {+      case 0xf: /* 11110___ */+        m += 4;+        break;+      case 0xe: /* 1110____ */+        m += 3;+        break;+      default:  /* 110_____ */+        m += 2;+        break;+      }++    j += 1;+  }++  assert(0);+}++/* Locate offset of j-th code-point (in reverse direction) in+ * well-formed utf8 string starting at end of buffer.+ *+ * The 0-th character from the end is the last character in the utf8+ * string (if it exists).+ *+ * Returns original 'n' if out of bounds.+ *+ */+size_t+hs_text_short_index_ofs_rev(const uint8_t buf[], const size_t n, const size_t i)+{+  size_t m = n;+  size_t j = i;++  for (;;) {+    assert(m <= n);+    assert(j >= 0);++    if (j >= m)+      return n; /* i-th char is < buf */++    /* if (m == i-j) /\* suffix is made up only of ASCII chars, so we can shortcut *\/ */+    /*   return 0; */++    /* scan until octet does not match 10_ */+    assert(m > 0);+    if (!(buf[--m] & 0x80))+      goto l_cont;++    assert(m > 0);+    if (utf8_lead_p(buf[--m])) {+      assert ((buf[m] & 0xe0) == 0xc0); /* 110_ */+      goto l_cont;+    }++    assert(m > 0);+    if (utf8_lead_p(buf[--m])) {+      assert ((buf[m] & 0xf0) == 0xe0); /* 1110_ */+      goto l_cont;+    }++    /* this must be a non-10_ octet in a well-formed stream */+    assert(m > 0);+    m -= 1;++    assert ((buf[m] & 0xf8) == 0xf0); /* 11110_ */++  l_cont:+    assert(utf8_lead_p(buf[m]));++    if (!j)+      return m; /* found */++    j -= 1;+  }++  assert(0);+}++/* Decode UTF8 code units into code-point+ * Assumes buf[] points to start of a valid UTF8-encoded code-point+ */+static inline uint32_t+hs_text_short_decode_cp(const uint8_t buf[])+{+  /*  7 bits | 0xxxxxxx+   * 11 bits | 110yyyyx  10xxxxxx+   * 16 bits | 1110yyyy  10yxxxxx  10xxxxxx+   * 21 bits | 11110yyy  10yyxxxx  10xxxxxx  10xxxxxx+   */++  const uint8_t b0 = buf[0];++  if (!(b0 & 0x80))+    return b0;++  uint32_t cp = 0;++  switch(b0 >> 4) {+  case 0xf: /* 11110___ */+    assert((b0 & 0xf8) == 0xf0);+    assert(!utf8_lead_p(buf[1]));+    assert(!utf8_lead_p(buf[2]));+    assert(!utf8_lead_p(buf[3]));+    cp  = ((uint32_t)(b0     & 0x07)) << (6+6+6);+    cp |= ((uint32_t)(buf[1] & 0x3f)) << (6+6);+    cp |= ((uint32_t)(buf[2] & 0x3f)) << 6;+    cp |=             buf[3] & 0x3f;+    assert (cp > 0xffff); assert (cp < 0x110000);+    return cp;++  case 0xe: /* 1110____ */+    assert(!utf8_lead_p(buf[1]));+    assert(!utf8_lead_p(buf[2]));+    cp  = ((uint32_t)(b0     & 0x0f)) << (6+6);+    cp |= ((uint32_t)(buf[1] & 0x3f)) << 6;+    cp |=             buf[2] & 0x3f;+    assert (cp > 0x7ff); assert (cp < 0x10000);+    assert (cp < 0xd800 || cp > 0xdfff);+    return cp;++  default:  /* 110_____ */+    assert((b0 & 0xe0) == 0xc0);+    assert(!utf8_lead_p(buf[1]));+    cp  = ((uint32_t)(b0     & 0x1f)) << 6;+    cp |=             buf[1] & 0x3f;+    assert (cp > 0x7f); assert (cp < 0x800);+    return cp;+  }+}++/* decode codepoint starting at buf[ofs] */+codepoint_t+hs_text_short_ofs_cp(const uint8_t buf[], const size_t ofs)+{+  return hs_text_short_decode_cp(buf+ofs);+}++/* reverse-decode codepoint starting at offset right after a code-point */+codepoint_t+hs_text_short_ofs_cp_rev(const uint8_t *buf, const size_t ofs)+{+  /*  7 bits | 0xxxxxxx+   * 11 bits | 110yyyyx  10xxxxxx+   * 16 bits | 1110yyyy  10yxxxxx  10xxxxxx+   * 21 bits | 11110yyy  10yyxxxx  10xxxxxx  10xxxxxx+   */++  buf = buf + ofs - 1;++  /* this octet is either 10_ or 0_ */+  uint32_t cp = *buf;++  if (!(cp & 0x80))+    return cp;++  assert (!utf8_lead_p(cp));+  cp &= 0x3f;++  /* this octet is either 10_ or 110_ */+  {+    const uint8_t b = *(--buf);+    assert (!utf8_lead_p(b) || ((b & 0xe0) == 0xc0));++    cp |=  (b & 0x3f) << 6;++    if (b & 0x40) {+      assert (cp > 0x7f); assert (cp < 0x800);+      return cp;+    }+  }++  /* this octet is either 10_ or 1110_ */+  {+    const uint8_t b = *(--buf);+    assert (!utf8_lead_p(b) || ((b & 0xf0) == 0xe0));++    if (b & 0x40) {+      cp |= (b & 0xf) << 12;++      assert (cp > 0x7ff); assert (cp < 0x10000);+      assert (cp < 0xd800 || cp > 0xdfff);+      return cp;+    }++    cp |= (b & 0x3f) << 12;+  }++  /* this octet must be 11110_ */+  const uint8_t b = *(buf-1);+  assert ((b & 0xf8) == 0xf0);++  cp |= (b & 0x7) << 18;++  assert (cp > 0xffff); assert (cp < 0x110000);+  return cp;+}++/* Retrieve i-th code-point in (valid) UTF8 stream+ *+ * Returns -1 if out of bounds+ */+codepoint_t+hs_text_short_index_cp(const uint8_t buf[], const size_t n, const size_t i)+{+  const size_t ofs = hs_text_short_index_ofs(buf, n, i);++  if (ofs >= n)+    return -1;++  return hs_text_short_decode_cp(&buf[ofs]);+}++/* Retrieve i-th code-point in (valid) UTF8 stream+ *+ * Returns -1 if out of bounds+ */+codepoint_t+hs_text_short_index_cp_rev(const uint8_t buf[], const size_t n, const size_t i)+{+  const size_t ofs = hs_text_short_index_ofs_rev(buf, n, i);++  if (ofs >= n)+    return -1;++  return hs_text_short_decode_cp(&buf[ofs]);+}+ /* Validate UTF8 encoding   7 bits | 0xxxxxxx-11 bits | 110yyyyx  10xxxxxx -16 bits | 1110yyyy  10yxxxxx  10xxxxxx -21 bits | 11110yyy  10yyxxxx  10xxxxxx  10xxxxxx +11 bits | 110yyyyx  10xxxxxx+16 bits | 1110yyyy  10yxxxxx  10xxxxxx+21 bits | 11110yyy  10yyxxxx  10xxxxxx  10xxxxxx  Valid code-points: @@ -60,10 +358,14 @@  Return values: - 0 -> ok- 1 -> invalid byte/code-point- 2 -> truncated+  0 -> ok +  1 -> invalid byte/code-point++ -1 -> truncated (1 byte missing)+ -2 -> truncated (2 byte missing)+ -3 -> truncated (3 byte missing)+ */  int@@ -75,50 +377,66 @@     const uint8_t b0 = buf[j++];      if (!(b0 & 0x80))-      continue;+      continue; /* b0 elem [ 0x00 .. 0x7f ] */ -    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 & 0xe0) == 0xc0) { /* [ 0xc0 .. 0xdf ] */+      if (!(b0 & 0x1e)) return 1; /* 0xc0 or 0xc1; denorm */+      if (j >= n) return -1;++      goto l_trail1; /* b1 */     } -    if ((b0 & 0xf0) == 0xe0) {-      if ((j+1) >= n) return 2;+    if ((b0 & 0xf0) == 0xe0) { /* [ 0xe0 .. 0xef ] */+      if ((j+1) >= n) return (n-(j+2));        const uint8_t b1 = buf[j++];-      if ((b1 & 0xc0) != 0x80) return 1;+      if (utf8_lead_p(b1)) return 1; /* b1 elem [ 0x80 .. 0xbf ] */++      /* if b0==0xe0: b1 elem [ 0xa0 .. 0xbf ] */       if (!((b0 & 0x0f) | (b1 & 0x20))) return 1; /* denorm */+       /* UTF16 Surrogate pairs [U+D800 .. U+DFFF] */+      /* if b0==0xed: b1 elem [ 0x80 .. 0x9f ] */       if ((b0 == 0xed) && (b1 & 0x20)) return 1;-      -      /* b2 */-      if ((buf[j++] & 0xc0) != 0x80) return 1;-        -      continue;++      goto l_trail1; /* b2 */     } -    if ((b0 & 0xf8) == 0xf0) {-      if ((j+2) >= n) return 2;-      +    if ((b0 & 0xfc) == 0xf0) { /* [ 0xf0 .. 0xf3 ] */+      if ((j+2) >= n) return (n-(j+3));+       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;-      ++      if (utf8_lead_p(b1))         /* b1 elem [ 0x80 .. 0xbf ] */+        return 1;++      if (!((b0 & 0x03) | (b1 & 0x30))) /* if b0==0xf0: b1 elem [ 0x90 .. 0xbf ] */+        return 1;++      goto l_trail2; /* b1, b2 */+    }++    if (b0 == 0xf4) {+      if ((j+2) >= n) return (n-(j+3));++      /* b1 */+      if ((buf[j++] & 0xf0) != 0x80) return 1;+      /* b1 elem [ 0x80 .. 0x8f ] */++    l_trail2:       /* b2 */-      if ((buf[j++] & 0xc0) != 0x80) return 1;+      if (utf8_lead_p(buf[j++])) return 1;+      /* b2 elem [ 0x80 .. 0xbf ] */++    l_trail1:       /* b3 */-      if ((buf[j++] & 0xc0) != 0x80) return 1;+      if (utf8_lead_p(buf[j++])) return 1;+      /* b3 elem [ 0x80 .. 0xbf ] */        continue;     }-    ++    /* invalid b0 byte */     return 1;   } @@ -128,14 +446,212 @@ }  -/* Test whether well-formed UTF8 string contains only ASCII code-points- * Returns length of longest ASCII-code-point prefix.+/* Returns length of longest ASCII-code-point prefix.  */ size_t-hs_text_short_is_ascii(const uint8_t buf[], const size_t n)+hs_text_short_ascii_length(const uint8_t buf[], const size_t n) {-  size_t j;-  for (j = 0; j < n; j++)+  size_t j = 0;++  if (is_64bit) {+    /* "vectorized" optimisation checking 8 octets at once+     *+     * NB: A 64-bit aligned buffer is assumed. This is assumption is+     * justified when the buffer is the payload of a `ByteArray#`.+     */+    const uint64_t *buf64 = (const uint64_t*)buf;++    for (; (j+7) < n; j+=8, ++buf64)+      if (*buf64 & UINT64_C(0x8080808080808080))+        break;+  } else {+    /* "vectorized" optimisation checking 4 octets at once */+    const uint32_t *buf32 = (const uint32_t*)buf;++    for (; (j+3) < n; j+=4, ++buf32)+      if (*buf32 & UINT64_C(0x80808080))+        break;+  }++  for (; j < n; ++j)     if (buf[j] & 0x80)       return j;++  return j;+}++/* Test whether well-formed UTF8 string contains only ASCII code-points+ * returns 0 if not ASCII+ *+ * This code assumes a naturally aligned buf[]+ */+int+hs_text_short_is_ascii(const uint8_t buf[], const size_t n)+{+  size_t j = 0;++  if (n < 2)+    return 1;++  if (is_64bit) {+    /* "vectorized" optimisation checking 8 octets at once+     *+     * NB: A 64-bit aligned buffer is assumed. This is assumption is+     * justified when the buffer is the payload of a `ByteArray#`.+     *+     */+    const uint64_t *buf64 = (const uint64_t*)buf;++    for (; (j+7) < n; j+=8, ++buf64)+      if (*buf64 & UINT64_C(0x8080808080808080))+        return 0;++    if (j < n) {+      const int maskshift = (8 - (n - j)) << 3;+      const uint64_t mask = is_bigendian ? (UINT64_C(0x8080808080808080) << maskshift)  /* big endian */+                                         : (UINT64_C(0x8080808080808080) >> maskshift); /* little endian */++      if (*buf64 & mask)+        return 0;+    }+  } else {+    /* "vectorized" optimisation checking 4 octets at once */+    const uint32_t *buf32 = (const uint32_t*)buf;++    for (; (j+3) < n; j+=4, ++buf32)+      if (*buf32 & UINT64_C(0x80808080))+        return 0;++    for (; j < n; ++j)+      if (buf[j] & 0x80)+        return 0;+  }++  return 1;+}++/*+ * Compute length of (transcoded) mutf8 literal+ *+ * If the mutf8 literal does not contain either surrogates nor escaped+ * NULs, a positive length is returned which matches what strlen(3)+ * would have returned.+ *+ * Otherwise, a negated size is returned which corresponds to the size+ * of a the mutf8->utf8 transcoded string.+ *+ */+HsInt+hs_text_short_mutf8_strlen(const uint8_t buf[])+{+  size_t j = 0;+  size_t nulls = 0;+  bool surr_seen = false;++  for (;;) {+    const uint8_t b0 = buf[j];++    if (unlikely(!b0))+      break;++    if (likely(!(b0 & 0x80)))+      j += 1;   /* 0_______ */+    else+      switch(b0 >> 4) {+      case 0xf: /* 11110___ */+        j += 4;+        break;+      case 0xe: /* 1110____ */+        /* UTF16 Surrogate pairs [U+D800 .. U+DFFF] */+        if (unlikely(!surr_seen && (b0 == 0xed) && (buf[j+1] & 0x20)))+          surr_seen = true;+        j += 3;+        break;+      default:  /* 110_____ */+        /* escaped NUL */+        if (unlikely((b0 == 0xc0) && (buf[j+1] == 0x80)))+          nulls += 1;+        j += 2;+        break;+      }+  } /* for */+++  if ((nulls > 0) || surr_seen)+    return -(HsInt)(j - nulls);++  return j;+}++/* Transcode Modified UTF-8 to proper UTF-8+ *+ * This involves+ *+ *  1. Unescape denormal 2-byte NULs (0xC0 0x80)+ *  2. Rewrite surrogate pairs to U+FFFD+ */+void+hs_text_short_mutf8_trans(const uint8_t src0[], uint8_t dst0[])+{+  const uint8_t *src = src0;+  uint8_t *dst = dst0;++  for (;;) {+    const uint8_t b0 = *src++;+    assert(utf8_lead_p(b0));++    if (likely(!(b0 & 0x80))) { /* 0_______ */+      if (unlikely(!b0))+        break;++      *dst++ = b0;+      continue;+    }++    switch(b0 >> 4) {+    case 0xf: /* 11110___ */+      assert(!utf8_lead_p(src[0]));+      assert(!utf8_lead_p(src[1]));+      assert(!utf8_lead_p(src[2]));+      *dst++ = b0;+      *dst++ = *src++;+      *dst++ = *src++;+      *dst++ = *src++;+      break;++    case 0xe: { /* 1110____ */+      const uint8_t b1 = *src++;+      const uint8_t b2 = *src++;+      assert(!utf8_lead_p(b1));+      assert(!utf8_lead_p(b2));+      if (unlikely((b0 == 0xed) && (b1 & 0x20))) {+        /* UTF16 Surrogate pairs [U+D800 .. U+DFFF]+         * -> translate into U+FFFD+         */+        *dst++ = 0xef;+        *dst++ = 0xbf;+        *dst++ = 0xbd;+      } else {+        *dst++ = b0;+        *dst++ = b1;+        *dst++ = b2;+      }+      break;+    }+    default: { /* 110_____ */+      const uint8_t b1 = *src++;+      assert(!utf8_lead_p(b1));+      if (unlikely((b0 == 0xc0) && (b1 == 0x80))) {+        /* escaped/denormal U+0000 -> normalize */+        *dst++ = 0x00;+      } else {+        *dst++ = b0;+        *dst++ = b1;+      }+      break;+    }+    } /* switch */+  } /* for */++  assert(labs(hs_text_short_mutf8_strlen(src0)) == (dst - dst0)); }

@@ -0,0 +1,12 @@+#include <string.h>++int+hs_text_short_memcmp(const void *s1, const size_t s1ofs, const void *s2, const size_t s2ofs, const size_t n)+{+  if (!n) return 0;++  const void *s1_ = s1+s1ofs;+  const void *s2_ = s2+s2ofs;++  return (s1_ == s2_) ? 0 : memcmp(s1_, s2_, n);+}

@@ -0,0 +1,23 @@+{-# LANGUAGE MagicHash        #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE Unsafe           #-}++module PrimOps ( compareByteArrays# ) where++import           Foreign.C.Types  (CInt (..), CSize (..))+import           GHC.Exts         (Int (I#))+import           GHC.Exts         (ByteArray#, Int#)+import           System.IO.Unsafe (unsafeDupablePerformIO)++-- | Emulate GHC 8.4's 'GHC.Prim.compareByteArrays#'+compareByteArrays# :: ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#+compareByteArrays# ba1# ofs1# ba2# ofs2# n#+    = unI (fromIntegral (unsafeDupablePerformIO (c_memcmp ba1# ofs1 ba2# ofs2 n)))+  where+    unI (I# i#) = i#+    ofs1 = fromIntegral (I# ofs1#)+    ofs2 = fromIntegral (I# ofs2#)+    n    = fromIntegral (I# n#)++foreign import ccall unsafe "hs_text_short_memcmp"+   c_memcmp :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt

@@ -0,0 +1,6 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Unsafe    #-}++module PrimOps ( compareByteArrays# ) where++import           GHC.Exts (compareByteArrays#)

@@ -1,46 +1,224 @@+{-# LANGUAGE OverloadedLists   #-} {-# 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+import           Data.Binary+import           Data.Char+import           Data.Maybe+import           Data.Monoid+import qualified Data.String               as D.S+import qualified Data.Text                 as T+import qualified Data.Text.Encoding        as T+import qualified Data.Text.Short           as IUT+import qualified Data.Text.Short.Partial   as IUT+import           Test.QuickCheck.Instances ()+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck     as QC+import           Text.Show.Functions       ()  fromByteStringRef = either (const Nothing) (Just . IUT.fromText) . T.decodeUtf8'  main :: IO ()-main = defaultMain tests+main = defaultMain (adjustOption (QuickCheckTests 50000 `max`) $ tests)  tests :: TestTree tests = testGroup "Tests" [unitTests,qcProps] +-- ShortText w/ in-bounds index+data STI = STI IUT.ShortText Int+         deriving (Eq,Show)++newtype ST = ST IUT.ShortText+           deriving (Eq,Show)++instance Arbitrary STI where+  arbitrary = do+    t <- arbitrary+    i <- choose (0, T.length t - 1)+    return $! STI (IUT.fromText t) i++instance Arbitrary ST where+  arbitrary = fmap (ST . IUT.fromText) arbitrary+  shrink (ST st) = map (ST . IUT.fromText) (shrink (IUT.toText st))+ 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 "length/append"     $ \(ST t1) (ST t2) -> IUT.length t1 + IUT.length t2 == IUT.length (IUT.append t1 t2)+  , QC.testProperty "compare" $ \t1 t2 -> IUT.fromText t1 `compare` IUT.fromText t2  == t1 `compare` t2+  , QC.testProperty "(==)" $ \t1 t2 -> (IUT.fromText t1 == IUT.fromText t2)  == (t1 == t2)+  , QC.testProperty "(!?)" $ \t ->+      let t' = IUT.fromText t+      in and ([ mapMaybe (t' IUT.!?) ([0 .. T.length t -1 ] :: [Int]) == T.unpack t+              , mapMaybe (t' IUT.!?) [-5 .. -1] == []+              , mapMaybe (t' IUT.!?) [T.length t .. T.length t + 5] == []+              ] :: [Bool])+  , QC.testProperty "indexEndMaybe" $ \t ->+      let t' = IUT.fromText t+      in and ([ mapMaybe (IUT.indexEndMaybe t') [0 .. T.length t -1 ] == T.unpack (T.reverse t)+              , mapMaybe (IUT.indexEndMaybe t') [-5 .. -1] == []+              , mapMaybe (IUT.indexEndMaybe t') [T.length t .. T.length t + 5] == []+              ] :: [Bool])   , 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+  , QC.testProperty "splitAt" $ \t ->+      let t' = IUT.fromText t+          mapBoth f (x,y) = (f x, f y)+      in and [ mapBoth IUT.toText (IUT.splitAt i t') == T.splitAt i t | i <- [-5 .. 5+T.length t ] ]++  , QC.testProperty "intersperse" $ \t c -> IUT.intersperse c (IUT.fromText t) == IUT.fromText (T.intersperse c t)+  , QC.testProperty "intercalate" $ \t1 t2 -> IUT.intercalate (IUT.fromText t1) (map IUT.fromText t2) == IUT.fromText (T.intercalate t1 t2)+  , QC.testProperty "reverse.singleton" $ \c -> IUT.reverse (IUT.singleton c) == IUT.singleton c+  , QC.testProperty "reverse"     $ \t -> IUT.reverse (IUT.fromText t) == IUT.fromText (T.reverse t)+  , QC.testProperty "filter"      $ \p t -> IUT.filter p (IUT.fromText t) == IUT.fromText (T.filter p t)+  , QC.testProperty "replicate"   $ \n t -> IUT.replicate n (IUT.fromText t) == IUT.fromText (T.replicate n t)+  , QC.testProperty "dropAround"  $ \p t -> IUT.dropAround p (IUT.fromText t) == IUT.fromText (T.dropAround p t)++  , QC.testProperty "foldl"       $ \f z t -> IUT.foldl f (z :: Char) (IUT.fromText t) == T.foldl f (z :: Char) t+  , QC.testProperty "foldl #2"    $ \t -> IUT.foldl (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t+  , QC.testProperty "foldl #3"    $ \t -> IUT.foldl (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t)++  , QC.testProperty "foldl'"      $ \f z t -> IUT.foldl' f (z :: Char) (IUT.fromText t) == T.foldl' f (z :: Char) t+  , QC.testProperty "foldl' #2"   $ \t -> IUT.foldl' (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t+  , QC.testProperty "foldl' #3"   $ \t -> IUT.foldl' (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t)++  , QC.testProperty "foldr"       $ \f z t -> IUT.foldr f (z :: Char) (IUT.fromText t) == T.foldr f (z :: Char) t+  , QC.testProperty "foldr #2"    $ \t -> IUT.foldr (\_ n -> (n+1)) 0 (IUT.fromText t) == T.length t+  , QC.testProperty "foldr #3"    $ \t -> IUT.foldr (:) [] (IUT.fromText t) == T.unpack t++  , QC.testProperty "foldr1"      $ \f t -> (not (T.null t)) ==> IUT.foldr1 f (IUT.fromText t) == T.foldr1 f t+  , QC.testProperty "foldl1"      $ \f t -> (not (T.null t)) ==> IUT.foldl1 f (IUT.fromText t) == T.foldl1 f t+  , QC.testProperty "foldl1'"     $ \f t -> (not (T.null t)) ==> IUT.foldl1' f (IUT.fromText t) == T.foldl1' f t++  , QC.testProperty "splitAtEnd" $ \t ->+      let t' = IUT.fromText t+          n' = IUT.length t'+      in and [ (IUT.splitAt (n'-i) t') == IUT.splitAtEnd i t' | i <- [-5 .. 5+n' ] ]++  , QC.testProperty "find" $ \t -> IUT.find Data.Char.isAscii (IUT.fromText t) == T.find Data.Char.isAscii t+  , QC.testProperty "findIndex" $ \t -> IUT.findIndex Data.Char.isAscii (IUT.fromText t) == T.findIndex Data.Char.isAscii t++  , QC.testProperty "isSuffixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isSuffixOf` IUT.fromText t2  == t1 `T.isSuffixOf` t2+  , QC.testProperty "isPrefixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isPrefixOf` IUT.fromText t2  == t1 `T.isPrefixOf` t2++  , QC.testProperty "stripPrefix" $ \t1 t2 -> IUT.stripPrefix (IUT.fromText t1) (IUT.fromText t2) ==+                                                fmap IUT.fromText (T.stripPrefix t1 t2)++  , QC.testProperty "stripSuffix" $ \t1 t2 -> IUT.stripSuffix (IUT.fromText t1) (IUT.fromText t2) ==+                                                fmap IUT.fromText (T.stripSuffix t1 t2)++  , QC.testProperty "stripPrefix 2" $ \(STI t i) ->+      let (pfx,sfx) = IUT.splitAt i t+      in IUT.stripPrefix pfx t == Just sfx++  , QC.testProperty "stripSuffix 2" $ \(STI t i) ->+      let (pfx,sfx) = IUT.splitAt i t+      in IUT.stripSuffix sfx t == Just pfx++  , QC.testProperty "cons" $ \c t -> IUT.singleton c <> IUT.fromText t == IUT.cons c (IUT.fromText t)+  , QC.testProperty "snoc" $ \c t -> IUT.fromText t <> IUT.singleton c == IUT.snoc (IUT.fromText t) c++  , QC.testProperty "uncons" $ \c t -> IUT.uncons (IUT.singleton c <> IUT.fromText t) == Just (c, IUT.fromText t)++  , QC.testProperty "unsnoc" $ \c t -> IUT.unsnoc (IUT.fromText t <> IUT.singleton c) == Just (IUT.fromText t, c)++  , QC.testProperty "break" $ \t -> let (l,r)   = IUT.break Data.Char.isAscii (IUT.fromText t)+                                    in  T.break Data.Char.isAscii t == (IUT.toText l,IUT.toText r)++  , QC.testProperty "span"  $ \t -> let (l,r)   = IUT.span Data.Char.isAscii (IUT.fromText t)+                                    in  T.span Data.Char.isAscii t == (IUT.toText l,IUT.toText r)++  , QC.testProperty "breakEnd" $ \t -> let (l,r)   = IUT.breakEnd Data.Char.isAscii (IUT.fromText t)+                                       in  t_breakEnd Data.Char.isAscii t == (IUT.toText l,IUT.toText r)++  , QC.testProperty "spanEnd"  $ \t -> let (l,r)   = IUT.spanEnd Data.Char.isAscii (IUT.fromText t)+                                       in  t_spanEnd Data.Char.isAscii t == (IUT.toText l,IUT.toText r)++  , QC.testProperty "splitAt/isPrefixOf" $ \t ->+      let t' = IUT.fromText t+      in and [ IUT.isPrefixOf (fst (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]+  , QC.testProperty "splitAt/isSuffixOf" $ \t ->+      let t' = IUT.fromText t+      in and [ IUT.isSuffixOf (snd (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]   ] +t_breakEnd p t = t_spanEnd (not . p) t+t_spanEnd  p t = (T.dropWhileEnd p t, T.takeWhileEnd p 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 "fromByteString [0xf0,0x90,0x80,0x80]" $ IUT.fromByteString "\xf0\x90\x80\x80" @?= Just "\x10000"+  , testCase "fromByteString [0xf4,0x90,0x80,0x80]" $ IUT.fromByteString "\244\144\128\128" @?= 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)-  ]+  , testCase "singleton" $ [ c | c <- [minBound..maxBound], IUT.singleton c /= IUT.fromText (T.singleton c) ] @?= []++  , testCase "splitAtEnd" $ IUT.splitAtEnd 1 "€€" @?= ("€","€")++  , testCase "literal0" $ IUT.unpack testLit0 @?= []+  , testCase "literal1" $ IUT.unpack testLit1 @?= ['€','\0','€','\0']+  , testCase "literal2" $ IUT.unpack testLit2 @?= ['\xFFFD','\xD7FF','\xFFFD','\xE000']+  , testCase "literal3" $ IUT.unpack testLit3 @?= ['\1'..'\x7f']+  , testCase "literal4" $ IUT.unpack testLit4 @?= map toEnum [0,1,126,127,128,129,130,256,2046,2047,2048,2049,2050,65530,65531,65532,65533,65534,65533,65535,65536,65537,65538,1114110,1114111]+  , testCase "literal5" $ IUT.unpack testLit5 @?= map toEnum [28961]+  , testCase "literal6" $ IUT.unpack testLit6 @?= map toEnum [0]+  , testCase "literal7" $ IUT.unpack testLit7 @?= map toEnum [66328]+  , testCase "literal8" $ IUT.unpack testLit8 @?= map toEnum [127]++    -- list literals+  , testCase "literal9"  $ [] @?= ("" :: IUT.ShortText)+  , testCase "literal10" $ ['¤','€','$'] @?= ("¤€$" :: IUT.ShortText)+  , testCase "literal12" $ IUT.unpack ['\xD800','\xD7FF','\xDFFF','\xE000'] @?= ['\xFFFD','\xD7FF','\xFFFD','\xE000']+ ]++-- isScalar :: Char -> Bool+-- isScalar c = c < '\xD800' || c >= '\xE000'+++{-# NOINLINE testLit0 #-}+testLit0 :: IUT.ShortText+testLit0 = ""++{-# NOINLINE testLit1 #-}+testLit1 :: IUT.ShortText+testLit1 = "€\NUL€\NUL"++{-# NOINLINE testLit2 #-}+testLit2 :: IUT.ShortText+testLit2 = "\xD800\xD7FF\xDFFF\xE000"++{-# NOINLINE testLit3 #-}+testLit3 :: IUT.ShortText+testLit3 = "\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL"++{-# NOINLINE testLit4 #-}+testLit4 :: IUT.ShortText+testLit4 = "\NUL\SOH~\DEL\128\129\130\256\2046\2047\2048\2049\2050\65530\65531\65532\65533\65534\65533\65535\65536\65537\65538\1114110\1114111"++{-# NOINLINE testLit5 #-}+testLit5 :: IUT.ShortText+testLit5 = "無"++{-# NOINLINE testLit6 #-}+testLit6 :: IUT.ShortText+testLit6 = "\NUL"++{-# NOINLINE testLit7 #-}+testLit7 :: IUT.ShortText+testLit7 = "𐌘"++{-# NOINLINE testLit8 #-}+testLit8 :: IUT.ShortText+testLit8 = "\x7f"

@@ -8,25 +8,99 @@ -- Stability   : stable -- -- Memory-efficient representation of Unicode text strings.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.Text.Short as TS+-- > import qualified Data.Text.Short (ShortText)+--+-- This modules deliberately omits (common) partial functions, which+-- can be found in "Data.Text.Short.Partial" instead.+--+-- @since 0.1 module Data.Text.Short     ( -- * The 'ShortText' type       ShortText        -- * Basic operations+      -- ** Construction+    , empty+    , singleton+    , pack+    , append+    , concat+    , cons+    , snoc+    , replicate++      -- ** Deconstruction+    , unpack+    , uncons+    , unsnoc++      -- ** Querying & predicates     , null     , length     , isAscii+    , all+    , any+    , find+    , isPrefixOf+    , isSuffixOf +      -- ** Lookup & indexing+    , (!?)+    , indexMaybe+    , indexEndMaybe+    , findIndex++      -- * Splitting 'ShortText's+      -- ** Basic functions+    , take+    , takeEnd+    , drop+    , dropEnd+    , takeWhile+    , takeWhileEnd+    , dropWhile+    , dropWhileEnd++    , dropAround++      -- ** Pair-valued functions+    , splitAt+    , splitAtEnd+    , span+    , break+    , spanEnd+    , breakEnd++      -- ** Suffix & Prefix operations+    , stripPrefix+    , stripSuffix++      -- * Transformations+    , intersperse+    , intercalate+    , reverse+    , filter++      -- * Folds+    , foldl+    , foldl'+    , foldr+       -- * Conversions       -- ** 'String'     , fromString     , toString -      -- ** 'T.Text'+      -- ** 'Text'     , fromText     , toText -      -- ** 'BS.ByteString'+      -- ** 'ByteString'     , fromShortByteString     , toShortByteString @@ -37,5 +111,219 @@      ) where -import Data.Text.Short.Internal-import Prelude ()+import           Data.Semigroup+import           Data.Text.Short.Internal+import           Prelude                  ()++-- | \(\mathcal{O}(n)\) Variant of 'span' with negated predicate.+--+-- >>> break (> 'c') "abcdabcd"+-- ("abc","dabcd")+--+-- prop> break p t == span (not . p) t+--+-- prop> fst (break p t) <> snd (break p t) == t+--+-- @since 0.1.2+break :: (Char -> Bool) -> ShortText -> (ShortText,ShortText)+break p st = span (not . p) st++-- | \(\mathcal{O}(n)\) Variant of 'spanEnd' with negated predicate.+--+-- >>> breakEnd (< 'c') "abcdabcd"+-- ("abcdab","cd")+--+-- prop> breakEnd p t == spanEnd (not . p) t+--+-- prop> fst (breakEnd p t) <> snd (breakEnd p t) == t+--+-- @since 0.1.2+breakEnd :: (Char -> Bool) -> ShortText -> (ShortText,ShortText)+breakEnd p st = spanEnd (not . p) st++-- | \(\mathcal{O}(n)\) Index /i/-th code-point in 'ShortText'.+--+-- Infix operator alias of 'indexMaybe'+--+-- >>> "abcdefg" !? 2+-- Just 'c'+--+-- @since 0.1.2+(!?) :: ShortText -> Int -> Maybe Char+(!?) = indexMaybe++-- | \(\mathcal{O}(n)\) Test whether /any/ code points in 'ShortText' satisfy a predicate.+--+-- >>> any (> 'c') "abcdabcd"+-- True+--+-- >>> any (const True) ""+-- False+--+-- >>> any (== 'c') "abdabd"+-- False+--+-- prop> any p t == not (all (not . p) t)+--+-- @since 0.1.2+any :: (Char -> Bool) -> ShortText -> Bool+any p st = case find p st of+             Nothing -> False+             Just _  -> True++-- | \(\mathcal{O}(n)\) Concatenate two 'ShortText's+--+-- This is a type-specialised alias of '<>'.+--+-- >>> append "foo" "bar"+-- "foobar"+--+-- prop> length (append t1 t2) == length t1 + length t2+--+-- @since 0.1.2+append :: ShortText -> ShortText -> ShortText+append = (<>)++-- | \(\mathcal{O}(n)\) Concatenate list of 'ShortText's+--+-- This is a type-specialised alias of 'mconcat'.+--+-- >>> concat []+-- ""+--+-- >>> concat ["foo","bar","doo"]+-- "foobardoo"+--+-- @since 0.1.2+concat :: [ShortText] -> ShortText+concat = mconcat++-- | \(\mathcal{O}(0)\) The /empty/ 'ShortText'.+--+-- This is a type-specialised alias of 'mempty'.+--+-- >>> empty+-- ""+--+-- >>> null empty+-- True+--+-- @since 0.1.2+empty :: ShortText+empty = mempty++-- | \(\mathcal{O}(n)\) Construct a 'ShortText' from a list of 'Char's.+--+-- This is an alias for 'fromString'.+--+-- @since 0.1.2+pack :: [Char] -> ShortText+pack = fromString++-- | \(\mathcal{O}(n)\) Convert 'ShortText' into a list of 'Char's.+--+-- This is an alias for 'toString'.+--+-- prop> (pack . unpack) t == t+--+-- @since 0.1.2+unpack :: ShortText -> [Char]+unpack = toString++-- | \(\mathcal{O}(n)\) Take prefix of given length or return whole 'ShortText' if too short.+--+-- >>> take 3 "abcdef"+-- "abc"+--+-- >>> take 3 "ab"+-- "ab"+--+-- @since 0.1.2+take :: Int -> ShortText -> ShortText+take n = fst . splitAt n++-- | \(\mathcal{O}(n)\) Take suffix of given length or return whole 'ShortText' if too short.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+--+-- >>> takeEnd 3 "ab"+-- "ab"+--+-- @since 0.1.2+takeEnd :: Int -> ShortText -> ShortText+takeEnd n = snd . splitAtEnd n++-- | \(\mathcal{O}(n)\) Take remove prefix of given length from 'ShortText' or return 'empty' 'ShortText' if too short.+--+-- >>> drop 4 "abcdef"+-- "ef"+--+-- >>> drop 4 "ab"+-- ""+--+-- @since 0.1.2+drop :: Int -> ShortText -> ShortText+drop n = snd . splitAt n++-- | \(\mathcal{O}(n)\) Take remove suffix of given length from 'ShortText' or return 'empty' 'ShortText' if too short.+--+-- >>> drop 4 "abcdefghi"+-- "efghi"+--+-- >>> drop 4 "ab"+-- ""+--+-- @since 0.1.2+dropEnd :: Int -> ShortText -> ShortText+dropEnd n = fst . splitAtEnd n++-- | \(\mathcal{O}(n)\) Take longest prefix satisfying given predicate.+--+-- prop> takeWhile p t == fst (span p t)+--+-- >>> takeWhile (< 'c') "abcdabcd"+-- "ab"+--+-- @since 0.1.2+takeWhile :: (Char -> Bool) -> ShortText -> ShortText+takeWhile p = fst . span p++-- | \(\mathcal{O}(n)\) Take longest suffix satisfying given predicate.+--+-- prop> takeWhileEnd p t == snd (spanEnd p t)+--+-- >>> takeWhileEnd (>= 'c') "abcdabcd"+-- "cd"+--+-- @since 0.1.2+takeWhileEnd :: (Char -> Bool) -> ShortText -> ShortText+takeWhileEnd p = snd . spanEnd p++-- | \(\mathcal{O}(n)\) Remove longest prefix satisfying given predicate.+--+-- prop> dropWhile p t == snd (span p t)+--+-- >>> dropWhile (< 'c') "abcdabcd"+-- "cdabcd"+--+-- @since 0.1.2+dropWhile :: (Char -> Bool) -> ShortText -> ShortText+dropWhile p = snd . span p++-- | \(\mathcal{O}(n)\) Remove longest suffix satisfying given predicate.+--+-- prop> dropWhileEnd p t == fst (spanEnd p t)+--+-- >>> dropWhileEnd (>= 'c') "abcdabcd"+-- "abcdab"+--+-- @since 0.1.2+dropWhileEnd :: (Char -> Bool) -> ShortText -> ShortText+dropWhileEnd p = fst . spanEnd p++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Text.Show.Functions ()+-- >>> import qualified Test.QuickCheck.Arbitrary as QC+-- >>> instance QC.Arbitrary ShortText where { arbitrary = fmap fromString QC.arbitrary }

@@ -1,246 +1,1517 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, MagicHash, UnliftedFFITypes, Unsafe #-}---- |--- Module      : Data.Text.Short.Internal--- Copyright   : © Herbert Valerio Riedel 2017--- License     : BSD3------ Maintainer  : hvr@gnu.org--- Stability   : stable------ Memory-efficient representation of Unicode text strings.-module Data.Text.Short.Internal-    ( -- * The 'ShortText' type-      ShortText(..)--      -- * Basic operations-    , Data.Text.Short.Internal.null-    , Data.Text.Short.Internal.length-    , Data.Text.Short.Internal.isAscii--      -- * Conversions-      -- ** 'String'-    , Data.Text.Short.Internal.fromString-    , toString--      -- ** 'T.Text'-    , fromText-    , toText--      -- ** 'BS.ByteString'-    , fromShortByteString-    , fromShortByteStringUnsafe-    , toShortByteString--    , fromByteString-    , fromByteStringUnsafe-    , 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---- | \(\mathcal{O}(1)\) Test whether a 'ShortText' is empty.-null :: ShortText -> Bool-null = BSS.null . toShortByteString---- | \(\mathcal{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---- | \(\mathcal{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#---- | \(\mathcal{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---- | \(\mathcal{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---- | \(\mathcal{O}(n)\) Convert to 'String'-toString :: ShortText -> String-toString = decodeStringShort' utf8 . toShortByteString---- | \(\mathcal{O}(n)\) Convert to 'T.Text'------ This is currently not \(\mathcal{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 \(\mathcal{O}(1)\).-toText :: ShortText -> T.Text-toText = T.decodeUtf8 . toByteString---------- | \(\mathcal{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---- | \(\mathcal{O}(n)\) Construct 'ShortText' from 'T.Text'------ This is currently not \(\mathcal{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 \(\mathcal{O}(1)\).-fromText :: T.Text -> ShortText-fromText = fromByteStringUnsafe . T.encodeUtf8---- | \(\mathcal{O}(n)\) Construct 'ShortText' from UTF-8 encoded 'ShortByteString'------ This operation doesn't copy the input 'ShortByteString' but it--- cannot be \(\mathcal{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---- | \(\mathcal{O}(0)\) Construct 'ShortText' from UTF-8 encoded 'ShortByteString'------ This operation has effectively no overhead, as it's currently merely a @newtype@-cast.------ __WARNING__: Unlike the safe 'fromShortByteString' conversion, this--- conversion is /unsafe/ as it doesn't validate the well-formedness of the--- UTF-8 encoding.-fromShortByteStringUnsafe :: ShortByteString -> ShortText-fromShortByteStringUnsafe = ShortText---- | \(\mathcal{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---- | \(\mathcal{O}(n)\) Construct 'ShortText' from UTF-8 encoded 'BS.ByteString'------ This operation is \(\mathcal{O}(n)\) because the 'BS.ByteString' needs to be--- copied into an unpinned 'ByteArray#'.------ __WARNING__: Unlike the safe 'fromByteString' conversion, this--- conversion is /unsafe/ as it doesn't validate the well-formedness of the--- UTF-8 encoding.-fromByteStringUnsafe :: BS.ByteString -> ShortText-fromByteStringUnsafe = 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# #-}-...--}+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE UnliftedFFITypes           #-}+{-# LANGUAGE Unsafe                     #-}+{-# LANGUAGE ViewPatterns               #-}++-- |+-- Module      : Data.Text.Short.Internal+-- Copyright   : © Herbert Valerio Riedel 2017+-- License     : BSD3+--+-- Maintainer  : hvr@gnu.org+-- Stability   : stable+--+-- Memory-efficient representation of Unicode text strings.+--+-- @since 0.1+module Data.Text.Short.Internal+    ( -- * The 'ShortText' type+      ShortText(..)++      -- * Basic operations+    , null+    , length+    , isAscii+    , splitAt+    , splitAtEnd+    , indexEndMaybe+    , indexMaybe+    , isPrefixOf+    , stripPrefix+    , isSuffixOf+    , stripSuffix++    , cons+    , snoc+    , uncons+    , unsnoc++    , findIndex+    , find+    , all++    , span+    , spanEnd++    , intersperse+    , intercalate+    , reverse+    , replicate++    , filter+    , dropAround++    , foldl+    , foldl'+    , foldr+    , foldl1+    , foldl1'+    , foldr1++      -- * Conversions+      -- ** 'Char'+    , singleton++      -- ** 'String'+    , Data.Text.Short.Internal.fromString+    , toString++      -- ** 'T.Text'+    , fromText+    , toText++      -- ** 'BS.ByteString'+    , fromShortByteString+    , fromShortByteStringUnsafe+    , toShortByteString++    , fromByteString+    , fromByteStringUnsafe+    , toByteString++    , toBuilder++      -- * misc+      -- ** For Haddock++    , BS.ByteString+    , T.Text+    , module Prelude++      -- ** Internals+    , isValidUtf8+    ) where++import           Control.DeepSeq                (NFData)+import           Control.Monad.ST               (stToIO)+import           Data.Binary+import           Data.Bits+import qualified Data.ByteString                as BS+import qualified Data.ByteString.Builder        as BB+import           Data.ByteString.Short          (ShortByteString)+import qualified Data.ByteString.Short          as BSS+import qualified Data.ByteString.Short.Internal as BSSI+import           Data.Char                      (ord)+import           Data.Hashable                  (Hashable)+import qualified Data.List                      as List+import           Data.Maybe                     (fromMaybe, isNothing)+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.Base                       (assert, unsafeChr)+import qualified GHC.CString                    as GHC+import           GHC.Exts                       (Addr#, ByteArray#, Int (I#),+                                                 Int#, MutableByteArray#,+                                                 Ptr (..), RealWorld, Word (W#))+import qualified GHC.Exts+import qualified GHC.Foreign                    as GHC+import           GHC.IO.Encoding+import           GHC.ST+import           Prelude                        hiding (all, any, break, concat,+                                                 drop, dropWhile, filter, foldl,+                                                 foldl1, foldr, foldr1, head,+                                                 init, last, length, null,+                                                 replicate, reverse, span,+                                                 splitAt, tail, take, takeWhile)+import           System.IO.Unsafe+import           Text.Printf                    (PrintfArg, formatArg,+                                                 formatString)++import qualified PrimOps++-- | A compact representation of Unicode strings.+--+-- A 'ShortText' value is a sequence of Unicode scalar values, as defined in+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >;+-- This means that a 'ShortText' is a list of (scalar) Unicode code-points (i.e. code-points in the range @[U+00 .. U+D7FF] ∪ [U+E000 .. U+10FFFF]@).+--+-- 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, or 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>.+--+-- @since 0.1+newtype ShortText = ShortText ShortByteString+                  deriving (Monoid,Data.Semigroup.Semigroup,Hashable,NFData)++instance Eq ShortText where+  {-# INLINE (==) #-}+  (==) x y+    | lx /= ly  = False+    | lx ==  0  = True+    | otherwise = case PrimOps.compareByteArrays# (toByteArray# x) 0# (toByteArray# y) 0# n# of+                    0# -> True+                    _  -> False+    where+      !lx@(I# n#) = toLength x+      !ly = toLength y++instance Ord ShortText where+  compare t1 t2+    | n == 0  = compare n1 n2+    | otherwise = case PrimOps.compareByteArrays# ba1# 0# ba2# 0# n# of+        r# | I# r# < 0 -> LT+           | I# r# > 0 -> GT+           | n1 < n2   -> LT+           | n1 > n2   -> GT+           | otherwise -> EQ+    where+      ba1# = toByteArray# t1+      ba2# = toByteArray# t2+      !n1 = toLength t1+      !n2 = toLength t2+      !n@(I# n#) = n1 `min` n2++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++-- | @since 0.1.2+instance PrintfArg ShortText where+  formatArg txt = formatString $ toString txt++-- | 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++-- | \(\mathcal{O}(1)\) Test whether a 'ShortText' is empty.+--+-- >>> null ""+-- True+--+-- prop> null (singleton c) == False+--+-- prop> null t == (length t == 0)+--+-- @since 0.1+null :: ShortText -> Bool+null = BSS.null . toShortByteString++-- | \(\mathcal{O}(n)\) Count the number of Unicode code-points in a 'ShortText'.+--+-- >>> length "abcd€"+-- 5+--+-- >>> length ""+-- 0+--+-- prop> length t >= 0+--+-- @since 0.1+length :: ShortText -> Int+length st = fromIntegral $ unsafeDupablePerformIO (c_text_short_length (toByteArray# st) (toCSize st))++foreign import ccall unsafe "hs_text_short_length" c_text_short_length :: ByteArray# -> CSize -> IO CSize++-- | \(\mathcal{O}(n)\) Test whether 'ShortText' contains only ASCII code-points (i.e. only U+0000 through U+007F).+--+-- This is a more efficient version of @'all' 'Data.Char.isAscii'@.+--+-- >>> isAscii ""+-- True+--+-- >>> isAscii "abc\NUL"+-- True+--+-- >>> isAscii "abcd€"+-- False+--+-- prop> isAscii t == all (< '\x80') t+--+-- @since 0.1+isAscii :: ShortText -> Bool+isAscii st = (/= 0) $ unsafeDupablePerformIO (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 CInt++-- | \(\mathcal{O}(n)\) Test whether /all/ code points in 'ShortText' satisfy a predicate.+--+-- >>> all (const False) ""+-- True+--+-- >>> all (> 'c') "abcdabcd"+-- False+--+-- >>> all (/= 'c') "abdabd"+-- True+--+-- @since 0.1.2+all :: (Char -> Bool) -> ShortText -> Bool+all p st = isNothing (findOfs (not . p) st (B 0))++-- | \(\mathcal{O}(n)\) Return the left-most codepoint in 'ShortText' that satisfies the given predicate.+--+-- >>> find (> 'b') "abcdabcd"+-- Just 'c'+--+-- >>> find (> 'b') "ababab"+-- Nothing+--+-- @since 0.1.2+find :: (Char -> Bool) -> ShortText -> Maybe Char+find p st = go 0+  where+    go !ofs+      | ofs >= sz  = Nothing+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq`+                        if p c+                        then Just c+                        else go ofs'++    !sz = toB st++-- | \(\mathcal{O}(n)\) Return the index of the left-most codepoint in 'ShortText' that satisfies the given predicate.+--+-- >>> findIndex (> 'b') "abcdabcdef"+-- Just 2+--+-- >>> findIndex (> 'b') "ababab"+-- Nothing+--+-- prop> (indexMaybe t =<< findIndex p t) == find p t+--+-- @since 0.1.2+findIndex :: (Char -> Bool) -> ShortText -> Maybe Int+findIndex p st = go 0 0+  where+    go !ofs !i+      | ofs >= sz  = Nothing+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq`+                        if p c+                        then Just i+                        else go ofs' (i+1)++    !sz = toB st++-- internal helper+{-# INLINE findOfs #-}+findOfs :: (Char -> Bool) -> ShortText -> B -> Maybe B+findOfs p st = go+  where+    go :: B -> Maybe B+    go !ofs | ofs >= sz  = Nothing+    go !ofs | p c       = Just ofs+            | otherwise = go ofs'+      where+        (c,ofs') = decodeCharAtOfs st ofs++    !sz = toB st++{-# INLINE findOfsRev #-}+findOfsRev :: (Char -> Bool) -> ShortText -> B -> Maybe B+findOfsRev p st = go+  where+    go (B 0) = Nothing+    go !ofs+      | p (cp2ch cp) = Just ofs+      | otherwise    = go (ofs-cpLen cp)+      where+        !cp = readCodePointRev st ofs++-- | \(\mathcal{O}(n)\) Split 'ShortText' into longest prefix satisfying the given predicate and the remaining suffix.+--+-- >>> span (< 'c') "abcdabcd"+-- ("ab","cdabcd")+--+-- prop> fst (span p t) <> snd (span p t) == t+--+-- @since 0.1.2+span :: (Char -> Bool) -> ShortText -> (ShortText,ShortText)+span p st+  | Just ofs <- findOfs (not . p) st (B 0) = splitAtOfs ofs st+  | otherwise = (st,mempty)++-- | \(\mathcal{O}(n)\) Split 'ShortText' into longest suffix satisfying the given predicate and the preceding prefix.+--+-- >>> spanEnd (> 'c') "abcdabcd"+-- ("abcdabc","d")+--+-- prop> fst (spanEnd p t) <> snd (spanEnd p t) == t+--+-- @since 0.1.2+spanEnd :: (Char -> Bool) -> ShortText -> (ShortText,ShortText)+spanEnd p st+  | Just ofs <- findOfsRev (not . p) st (toB st) = splitAtOfs ofs st+  | otherwise = (mempty,st)++----------------------------------------------------------------------------++toCSize :: ShortText -> CSize+toCSize = fromIntegral . BSS.length . toShortByteString++toB :: ShortText -> B+toB = fromIntegral . BSS.length . toShortByteString++toLength :: ShortText -> Int+toLength st = I# (toLength# st)++toLength# :: ShortText -> Int#+toLength# st = GHC.Exts.sizeofByteArray# (toByteArray# st)++toByteArray# :: ShortText -> ByteArray#+toByteArray# (ShortText (BSSI.SBS ba#)) = ba#++-- | \(\mathcal{O}(0)\) Converts to UTF-8 encoded 'ShortByteString'+--+-- This operation has effectively no overhead, as it's currently merely a @newtype@-cast.+--+-- @since 0.1+toShortByteString :: ShortText -> ShortByteString+toShortByteString (ShortText b) = b++-- | \(\mathcal{O}(n)\) Converts to UTF-8 encoded 'BS.ByteString'+--+-- @since 0.1+toByteString :: ShortText -> BS.ByteString+toByteString = BSS.fromShort . toShortByteString++-- | Construct a 'BB.Builder' that encodes 'ShortText' as UTF-8.+--+-- @since 0.1+toBuilder :: ShortText -> BB.Builder+toBuilder = BB.shortByteString . toShortByteString++-- | \(\mathcal{O}(n)\) Convert to 'String'+--+-- prop> (fromString . toString) t == t+--+-- __Note__: See documentation of 'fromString' for why @('toString' . 'fromString')@ is not an identity function.+--+-- @since 0.1+toString :: ShortText -> String+-- NOTE: impl below beats+--   toString = decodeStringShort' utf8 . toShortByteString+-- except for smallish strings+toString st = go 0+  where+    go !ofs+      | ofs >= sz  = []+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` (c : go ofs')++    !sz = toB st++----------------------------------------------------------------------------+-- Folds++-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with+-- the binary operator and an initial in forward direction (i.e. from+-- left to right).+--+-- >>> foldl (\_ _ -> True) False ""+-- False+--+-- >>> foldl (\s c -> c : s) ['.'] "abcd"+-- "dcba."+--+-- @since 0.1.2+foldl :: (a -> Char -> a) -> a -> ShortText -> a+foldl f z st = go 0 z+  where+    go !ofs acc+      | ofs >= sz  = acc+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` go ofs' (f acc c)++    !sz = toB st++-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with the binary operator.+--+-- >>> foldl1 max "abcdcba"+-- 'd'+--+-- >>> foldl1 const "abcd"+-- 'a'+--+-- >>> foldl1 (flip const) "abcd"+-- 'd'+--+-- __Note__: Will throw an 'error' exception if index is out of bounds.+--+-- @since 0.1.2+foldl1 :: (Char -> Char -> Char) -> ShortText -> Char+foldl1 f st+  | sz == 0    = error "foldl1: empty ShortText"+  | otherwise  = go c0sz c0+  where+    go !ofs acc+      | ofs >= sz  = acc+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` go ofs' (f acc c)+    !sz = toB st+    (c0,c0sz) = decodeCharAtOfs st (B 0)++-- | \(\mathcal{O}(n)\) Strict version of 'foldl'.+--+-- @since 0.1.2+foldl' :: (a -> Char -> a) -> a -> ShortText -> a+foldl' f !z st = go 0 z+  where+    go !ofs !acc+      | ofs >= sz  = acc+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` go ofs' (f acc c)++    !sz = toB st++-- | \(\mathcal{O}(n)\) Strict version of 'foldl1'.+--+-- @since 0.1.2+foldl1' :: (Char -> Char -> Char) -> ShortText -> Char+foldl1' f st+  | sz == 0    = error "foldl1: empty ShortText"+  | otherwise  = go c0sz c0+  where+    go !ofs !acc+      | ofs >= sz  = acc+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` go ofs' (f acc c)+    !sz = toB st+    (c0,c0sz) = decodeCharAtOfs st (B 0)++-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with+-- the binary operator and an initial in reverse direction (i.e. from+-- right to left).+--+-- >>> foldr (\_ _ -> True) False ""+-- False+--+-- >>> foldr (:) ['.'] "abcd"+-- "abcd."+--+-- @since 0.1.2+foldr :: (Char -> a -> a) -> a -> ShortText -> a+foldr f z st = go 0+  where+    go !ofs+      | ofs >= sz  = z+      | otherwise  = let (c,ofs') = decodeCharAtOfs st ofs+                     in c `seq` ofs' `seq` f c (go ofs')++    !sz = toB st++-- | \(\mathcal{O}(n)\) Reduces the characters of the 'ShortText' with the binary operator.+--+-- >>> foldr1 max "abcdcba"+-- 'd'+--+-- >>> foldr1 const "abcd"+-- 'a'+--+-- >>> foldr1 (flip const) "abcd"+-- 'd'+--+-- __Note__: Will throw an 'error' exception if index is out of bounds.+--+-- @since 0.1.2+foldr1 :: (Char -> Char -> Char) -> ShortText -> Char+foldr1 f st+  | sz == 0    = error "foldr1: empty ShortText"+  | otherwise  = go 0+  where+    go !ofs = let (c,ofs') = decodeCharAtOfs st ofs+              in c `seq` ofs' `seq`+                 (if ofs' >= sz then c else f c (go ofs'))++    !sz = toB st++-- | \(\mathcal{O}(n)\) Convert to 'T.Text'+--+-- prop> (fromText . toText) t == t+--+-- prop> (toText . fromText) t == t+--+-- This is currently not \(\mathcal{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 \(\mathcal{O}(1)\).+--+-- @since 0.1+toText :: ShortText -> T.Text+toText = T.decodeUtf8 . toByteString++----++-- | \(\mathcal{O}(n)\) Construct/pack from 'String'+--+-- >>> fromString []+-- ""+--+-- >>> fromString ['a','b','c']+-- "abc"+--+-- >>> fromString ['\55295','\55296','\57343','\57344'] -- U+D7FF U+D800 U+DFFF U+E000+-- "\55295\65533\65533\57344"+--+-- __Note__: This function is total because it replaces the (invalid) code-points U+D800 through U+DFFF with the replacement character U+FFFD.+--+-- @since 0.1+fromString :: String -> ShortText+fromString []  = mempty+fromString [c] = singleton c+fromString s = ShortText . encodeStringShort utf8 . map r $ s+  where+    r c | isSurr (ord c) = '\xFFFD'+        | otherwise      = c++-- | \(\mathcal{O}(n)\) Construct 'ShortText' from 'T.Text'+--+-- This is currently not \(\mathcal{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 \(\mathcal{O}(1)\).+--+-- @since 0.1+fromText :: T.Text -> ShortText+fromText = fromByteStringUnsafe . T.encodeUtf8++-- | \(\mathcal{O}(n)\) Construct 'ShortText' from UTF-8 encoded 'ShortByteString'+--+-- This operation doesn't copy the input 'ShortByteString' but it+-- cannot be \(\mathcal{O}(1)\) because we need to validate the UTF-8 encoding.+--+-- Returns 'Nothing' in case of invalid UTF-8 encoding.+--+-- >>> fromShortByteString "\x00\x38\xF0\x90\x8C\x9A" -- U+00 U+38 U+1031A+-- Just "\NUL8\66330"+--+-- >>> fromShortByteString "\xC0\x80" -- invalid denormalised U+00+-- Nothing+--+-- >>> fromShortByteString "\xED\xA0\x80" -- U+D800 (non-scalar code-point)+-- Nothing+--+-- >>> fromShortByteString "\xF4\x8f\xbf\xbf" -- U+10FFFF+-- Just "\1114111"+--+-- >>> fromShortByteString "\xF4\x90\x80\x80" -- U+110000 (invalid)+-- Nothing+--+-- prop> fromShortByteString (toShortByteString t) == Just t+--+-- @since 0.1+fromShortByteString :: ShortByteString -> Maybe ShortText+fromShortByteString sbs+  | isValidUtf8 st  = Just st+  | otherwise       = Nothing+  where+    st = ShortText sbs++-- | \(\mathcal{O}(0)\) Construct 'ShortText' from UTF-8 encoded 'ShortByteString'+--+-- This operation has effectively no overhead, as it's currently merely a @newtype@-cast.+--+-- __WARNING__: Unlike the safe 'fromShortByteString' conversion, this+-- conversion is /unsafe/ as it doesn't validate the well-formedness of the+-- UTF-8 encoding.+--+-- @since 0.1.1+fromShortByteStringUnsafe :: ShortByteString -> ShortText+fromShortByteStringUnsafe = ShortText++-- | \(\mathcal{O}(n)\) Construct 'ShortText' from UTF-8 encoded 'BS.ByteString'+--+-- 'fromByteString' accepts (or rejects) the same input data as 'fromShortByteString'.+--+-- Returns 'Nothing' in case of invalid UTF-8 encoding.+--+-- @since 0.1+fromByteString :: BS.ByteString -> Maybe ShortText+fromByteString = fromShortByteString . BSS.toShort++-- | \(\mathcal{O}(n)\) Construct 'ShortText' from UTF-8 encoded 'BS.ByteString'+--+-- This operation is \(\mathcal{O}(n)\) because the 'BS.ByteString' needs to be+-- copied into an unpinned 'ByteArray#'.+--+-- __WARNING__: Unlike the safe 'fromByteString' conversion, this+-- conversion is /unsafe/ as it doesn't validate the well-formedness of the+-- UTF-8 encoding.+--+-- @since 0.1.1+fromByteStringUnsafe :: BS.ByteString -> ShortText+fromByteStringUnsafe = 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 -> Int+-- isValidUtf8' st = fromIntegral $ unsafeDupablePerformIO (c_text_short_is_valid_utf8 (toByteArray# st) (toCSize st))++isValidUtf8 :: ShortText -> Bool+isValidUtf8 st = (==0) $ unsafeDupablePerformIO (c_text_short_is_valid_utf8 (toByteArray# st) (toCSize st))++type CCodePoint = Word++foreign import ccall unsafe "hs_text_short_is_valid_utf8" c_text_short_is_valid_utf8 :: ByteArray# -> CSize -> IO CInt++foreign import ccall unsafe "hs_text_short_index_cp" c_text_short_index :: ByteArray# -> CSize -> CSize -> IO CCodePoint++-- | \(\mathcal{O}(n)\) Lookup /i/-th code-point in 'ShortText'.+--+-- Returns 'Nothing' if out of bounds.+--+-- prop> indexMaybe (singleton c) 0 == Just c+--+-- prop> indexMaybe t 0 == fmap fst (uncons t)+--+-- prop> indexMaybe mempty i == Nothing+--+-- @since 0.1.2+indexMaybe :: ShortText -> Int -> Maybe Char+indexMaybe st i+  | i < 0      = Nothing+  | otherwise  = cp2chSafe cp+  where+    cp = CP $ unsafeDupablePerformIO (c_text_short_index (toByteArray# st) (toCSize st) (fromIntegral i))++-- | \(\mathcal{O}(n)\) Lookup /i/-th code-point from the end of 'ShortText'.+--+-- Returns 'Nothing' if out of bounds.+--+-- prop> indexEndMaybe (singleton c) 0 == Just c+--+-- prop> indexEndMaybe t 0 == fmap snd (unsnoc t)+--+-- prop> indexEndMaybe mempty i == Nothing+--+-- @since 0.1.2+indexEndMaybe :: ShortText -> Int -> Maybe Char+indexEndMaybe st i+  | i < 0      = Nothing+  | otherwise  = cp2chSafe cp+  where+    cp = CP $ unsafeDupablePerformIO (c_text_short_index_rev (toByteArray# st) (toCSize st) (fromIntegral i))++foreign import ccall unsafe "hs_text_short_index_cp_rev" c_text_short_index_rev :: ByteArray# -> CSize -> CSize -> IO CCodePoint+++-- | \(\mathcal{O}(n)\) Split 'ShortText' into two halves.+--+-- @'splitAtOfs n t@ returns a pair of 'ShortText' with the following properties:+--+-- prop> length (fst (splitAt n t)) == min (length t) (max 0 n)+--+-- prop> fst (splitAt n t) <> snd (splitAt n t) == t+--+-- >>> splitAt 2 "abcdef"+-- ("ab","cdef")+--+-- >>> splitAt 10 "abcdef"+-- ("abcdef","")+--+-- >>> splitAt (-1) "abcdef"+-- ("","abcdef")+--+-- @since 0.1.2+splitAt :: Int -> ShortText -> (ShortText,ShortText)+splitAt i st+  | i <= 0    = (mempty,st)+  | otherwise = splitAtOfs ofs st+  where+    ofs   = csizeToB $+            unsafeDupablePerformIO (c_text_short_index_ofs (toByteArray# st) stsz (fromIntegral i))+    stsz  = toCSize st++-- | \(\mathcal{O}(n)\) Split 'ShortText' into two halves.+--+-- @'splitAtEnd' n t@ returns a pair of 'ShortText' with the following properties:+--+-- prop> length (snd (splitAtEnd n t)) == min (length t) (max 0 n)+--+-- prop> fst (splitAtEnd n t) <> snd (splitAtEnd n t) == t+--+-- prop> splitAtEnd n t == splitAt (length t - n) t+--+-- >>> splitAtEnd 2 "abcdef"+-- ("abcd","ef")+--+-- >>> splitAtEnd 10 "abcdef"+-- ("","abcdef")+--+-- >>> splitAtEnd (-1) "abcdef"+-- ("abcdef","")+--+-- @since 0.1.2+splitAtEnd :: Int -> ShortText -> (ShortText,ShortText)+splitAtEnd i st+  | i <= 0      = (st,mempty)+  | ofs >= stsz = (mempty,st)+  | otherwise   = splitAtOfs ofs st+  where+    ofs   = csizeToB $+            unsafeDupablePerformIO (c_text_short_index_ofs_rev (toByteArray# st) (toCSize st) (fromIntegral (i-1)))+    stsz  = toB st++{-# INLINE splitAtOfs #-}+splitAtOfs :: B -> ShortText -> (ShortText,ShortText)+splitAtOfs ofs st+  | ofs  == 0    = (mempty,st)+  | ofs  >  stsz = (st,mempty)+  | otherwise    = (slice st 0 ofs, slice st ofs (stsz-ofs))+  where+    !stsz  = toB st++foreign import ccall unsafe "hs_text_short_index_ofs" c_text_short_index_ofs :: ByteArray# -> CSize -> CSize -> IO CSize++foreign import ccall unsafe "hs_text_short_index_ofs_rev" c_text_short_index_ofs_rev :: ByteArray# -> CSize -> CSize -> IO CSize+++-- | \(\mathcal{O}(n)\) Inverse operation to 'cons'+--+-- Returns 'Nothing' for empty input 'ShortText'.+--+-- prop> uncons (cons c t) == Just (c,t)+--+-- >>> uncons ""+-- Nothing+--+-- >>> uncons "fmap"+-- Just ('f',"map")+--+-- @since 0.1.2+uncons :: ShortText -> Maybe (Char,ShortText)+uncons st+  | null st    = Nothing+  | len2 == 0  = Just (c0, mempty)+  | otherwise  = Just (c0, slice st ofs len2)+  where+    c0  = cp2ch cp0+    cp0 = readCodePoint st 0+    ofs = cpLen cp0+    len2 = toB st - ofs++-- | \(\mathcal{O}(n)\) Inverse operation to 'snoc'+--+-- Returns 'Nothing' for empty input 'ShortText'.+--+-- prop> unsnoc (snoc t c) == Just (t,c)+--+-- >>> unsnoc ""+-- Nothing+--+-- >>> unsnoc "fmap"+-- Just ("fma",'p')+--+-- @since 0.1.2+unsnoc :: ShortText -> Maybe (ShortText,Char)+unsnoc st+  | null st    = Nothing+  | len1 == 0  = Just (mempty, c0)+  | otherwise  = Just (slice st 0 len1, c0)+  where+    c0  = cp2ch cp0+    cp0 = readCodePointRev st stsz+    stsz = toB st+    len1 = stsz - cpLen cp0++-- | \(\mathcal{O}(n)\) Tests whether the first 'ShortText' is a prefix of the second 'ShortText'+--+-- >>> isPrefixOf "ab" "abcdef"+-- True+--+-- >>> isPrefixOf "ac" "abcdef"+-- False+--+-- prop> isPrefixOf "" t == True+--+-- prop> isPrefixOf t t == True+--+-- @since 0.1.2+isPrefixOf :: ShortText -> ShortText -> Bool+isPrefixOf x y+  | lx > ly = False+  | lx == 0 = True+  | otherwise = case PrimOps.compareByteArrays# (toByteArray# x) 0# (toByteArray# y) 0# n# of+                  0# -> True+                  _  -> False+  where+    !lx@(I# n#) = toLength x+    !ly = toLength y++-- | \(\mathcal{O}(n)\) Strip prefix from second 'ShortText' argument.+--+-- Returns 'Nothing' if first argument is not a prefix of the second argument.+--+-- >>> stripPrefix "text-" "text-short"+-- Just "short"+--+-- >>> stripPrefix "test-" "text-short"+-- Nothing+--+-- @since 0.1.2+stripPrefix :: ShortText -> ShortText -> Maybe ShortText+stripPrefix pfx t+  | isPrefixOf pfx t = Just $! snd (splitAtOfs (toB pfx) t)+  | otherwise        = Nothing++-- | \(\mathcal{O}(n)\) Tests whether the first 'ShortText' is a suffix of the second 'ShortText'+--+-- >>> isSuffixOf "ef" "abcdef"+-- True+--+-- >>> isPrefixOf "df" "abcdef"+-- False+--+-- prop> isSuffixOf "" t == True+--+-- prop> isSuffixOf t t == True+--+-- @since 0.1.2+isSuffixOf :: ShortText -> ShortText -> Bool+isSuffixOf x y+  | lx > ly = False+  | lx == 0 = True+  | otherwise = case PrimOps.compareByteArrays# (toByteArray# x) 0# (toByteArray# y) ofs2# n# of+                  0# -> True+                  _  -> False+  where+    !(I# ofs2#) = ly - lx+    !lx@(I# n#) = toLength x+    !ly = toLength y++-- | \(\mathcal{O}(n)\) Strip suffix from second 'ShortText' argument.+--+-- Returns 'Nothing' if first argument is not a suffix of the second argument.+--+-- >>> stripSuffix "-short" "text-short"+-- Just "text"+--+-- >>> stripSuffix "-utf8" "text-short"+-- Nothing+--+-- @since 0.1.2+stripSuffix :: ShortText -> ShortText -> Maybe ShortText+stripSuffix sfx t+  | isSuffixOf sfx t = Just $! fst (splitAtOfs pfxLen t)+  | otherwise        = Nothing+  where+    pfxLen = toB t - toB sfx++----------------------------------------------------------------------------++-- | \(\mathcal{O}(n)\) Insert character between characters of 'ShortText'.+--+-- >>> intersperse '*' "_"+-- "_"+--+-- >>> intersperse '*' "MASH"+-- "M*A*S*H"+--+-- @since 0.1.2+intersperse :: Char -> ShortText -> ShortText+intersperse c st+  | null st = mempty+  | sn == 1 = st+  | otherwise = create newsz $ \mba -> do+      let !cp0 = readCodePoint st 0+          !cp0sz = cpLen cp0+      writeCodePointN cp0sz mba 0 cp0+      go mba (sn - 1) cp0sz cp0sz+  where+    newsz = ssz + ((sn-1) `mulB` csz)+    ssz = toB st+    sn  = length st+    csz = cpLen cp+    cp  = ch2cp c++    go :: MBA s -> Int -> B -> B -> ST s ()+    go _   0 !_  !_   = return ()+    go mba n ofs ofs2 = do+      let !cp1 = readCodePoint st ofs2+          !cp1sz = cpLen cp1+      writeCodePointN csz   mba ofs cp+      writeCodePointN cp1sz mba (ofs+csz) cp1+      go mba (n-1) (ofs+csz+cp1sz) (ofs2+cp1sz)++-- | \(\mathcal{O}(n)\) Insert 'ShortText' inbetween list of 'ShortText's.+--+-- >>> intercalate ", " []+-- ""+--+-- >>> intercalate ", " ["foo"]+-- "foo"+--+-- >>> intercalate ", " ["foo","bar","doo"]+-- "foo, bar, doo"+--+-- prop> intercalate "" ts == concat ts+--+-- @since 0.1.2+intercalate :: ShortText -> [ShortText] -> ShortText+intercalate _ []  = mempty+intercalate _ [t] = t+intercalate sep ts+  | null sep   = mconcat ts+  | otherwise  = mconcat (List.intersperse sep ts)++-- | \(\mathcal{O}(n*m)\) Replicate a 'ShortText'.+--+-- A repetition count smaller than 1 results in an empty string result.+--+-- >>> replicate 3 "jobs!"+-- "jobs!jobs!jobs!"+--+-- >>> replicate 10000 ""+-- ""+--+-- >>> replicate 0 "nothing"+-- ""+--+-- prop> length (replicate n t) == max 0 n * length t+--+-- @since 0.1.2+replicate :: Int -> ShortText -> ShortText+replicate n0 t+  | n0 < 1     = mempty+  | null t    = mempty+  | otherwise = create (n0 `mulB` sz) (go 0)+  where+    go :: Int -> MBA s -> ST s ()+    go j mba+      | j == n0    = return ()+      | otherwise  = do+          copyByteArray t 0 mba (j `mulB` sz) sz+          go (j+1) mba++    sz = toB t++-- | \(\mathcal{O}(n)\) Reverse characters in 'ShortText'.+--+-- >>> reverse "star live desserts"+-- "stressed evil rats"+--+-- prop> reverse (singleton c) == singleton c+--+-- prop> reverse (reverse t) == t+--+-- @since 0.1.2+reverse :: ShortText -> ShortText+reverse st+  | null st   = mempty+  | sn == 1   = st+  | otherwise = create sz $ go sn 0+  where+    sz = toB st+    sn = length st++    go :: Int -> B -> MBA s -> ST s ()+    go 0 !_  _   = return ()+    go i ofs mba = do+      let !cp   = readCodePoint st ofs+          !cpsz = cpLen cp+          !ofs' = ofs+cpsz+      writeCodePointN cpsz mba (sz - ofs') cp+      go (i-1) ofs' mba+++-- | \(\mathcal{O}(n)\) Remove characters from 'ShortText' which don't satisfy given predicate.+--+-- >>> filter (`notElem` ['a','e','i','o','u']) "You don't need vowels to convey information!"+-- "Y dn't nd vwls t cnvy nfrmtn!"+--+-- prop> filter (const False) t == ""+--+-- prop> filter (const True) t == t+--+-- prop> length (filter p t) <= length t+--+-- prop> filter p t == pack [ c | c <- unpack t, p c ]+--+-- @since 0.1.2+filter :: (Char -> Bool) -> ShortText -> ShortText+filter p t+  = case (mofs1,mofs2) of+      (Nothing,   _)       -> t -- no non-accepted characters found+      (Just 0,    Nothing) -> mempty -- no accepted characters found+      (Just ofs1, Nothing) -> slice t 0 ofs1 -- only prefix accepted+      (Just ofs1, Just ofs2) -> createShrink (t0sz-(ofs2-ofs1)) $ \mba -> do+        -- copy accepted prefix+        copyByteArray t 0 mba 0 ofs1+        -- [ofs1 .. ofs2) are a non-accepted region+        -- filter rest after ofs2+        t1sz <- go mba ofs2 ofs1+        return t1sz+  where+    mofs1 = findOfs (not . p) t (B 0) -- first non-accepted Char+    mofs2 = findOfs p t (fromMaybe (B 0) mofs1) -- first accepted Char++    t0sz = toB t++    go :: MBA s -> B -> B -> ST s B+    go mba !t0ofs !t1ofs+      | t0ofs >= t0sz = return t1ofs+      | otherwise = let !cp = readCodePoint t t0ofs+                        !cpsz = cpLen cp+                    in if p (cp2ch cp)+                       then writeCodePointN cpsz mba t1ofs cp >>+                            go mba (t0ofs+cpsz) (t1ofs+cpsz)+                       else go mba (t0ofs+cpsz) t1ofs -- skip code-point++-- | \(\mathcal{O}(n)\) Strip characters from the beginning end and of 'ShortText' which satisfy given predicate.+--+-- >>> dropAround (== ' ') "   white   space   "+-- "white   space"+--+-- >>> dropAround (> 'a') "bcdefghi"+-- ""+--+-- @since 0.1.2+dropAround :: (Char -> Bool) -> ShortText -> ShortText+dropAround p t0 = case (mofs1,mofs2) of+                    (Nothing,_) -> mempty+                    (Just ofs1,Just ofs2)+                      | ofs1 == 0, ofs2 == t0sz  -> t0+                      | ofs1 < ofs2  -> create (ofs2-ofs1) $ \mba -> do+                          copyByteArray t0 ofs1 mba (B 0) (ofs2-ofs1)+                    (_,_) -> error "dropAround: the impossible happened"+  where+    mofs1 = findOfs    (not . p) t0 (B 0)+    mofs2 = findOfsRev (not . p) t0 t0sz+    t0sz = toB t0++----------------------------------------------------------------------------++-- | Construct a new 'ShortText' from an existing one by slicing+--+-- NB: The 'CSize' arguments refer to byte-offsets+slice :: ShortText -> B -> B -> ShortText+slice st ofs len+  | ofs < 0    = error "invalid offset"+  | len < 0    = error "invalid length"+  | len' == 0  = mempty+  | otherwise  = create len' $ \mba -> copyByteArray st ofs' mba 0 len'+  where+    len0 = toB st+    len' = max 0 (min len (len0-ofs))+    ofs' = max 0 ofs++----------------------------------------------------------------------------+-- low-level MutableByteArray# helpers++-- | Byte offset (or size) in bytes+--+-- This currently wraps an 'Int' because this is what GHC's primops+-- currently use for byte offsets/sizes.+newtype B = B { unB :: Int }+          deriving (Ord,Eq,Num)++{- TODO: introduce operators for 'B' to avoid 'Num' -}++mulB :: Int -> B -> B+mulB n (B b) = B (n*b)++csizeFromB :: B -> CSize+csizeFromB = fromIntegral . unB++csizeToB :: CSize -> B+csizeToB = B . fromIntegral++data MBA s = MBA# { unMBA# :: MutableByteArray# s }++{-# INLINE create #-}+create :: B -> (forall s. MBA s -> ST s ()) -> ShortText+create n go = runST $ do+  mba <- newByteArray n+  go mba+  unsafeFreeze mba++{-# INLINE createShrink #-}+createShrink :: B -> (forall s. MBA s -> ST s B) -> ShortText+createShrink n go = runST $ do+  mba <- newByteArray n+  n' <- go mba+  if n' < n+    then unsafeFreezeShrink mba n'+    else unsafeFreeze mba++{-# INLINE unsafeFreeze #-}+unsafeFreeze :: MBA s -> ST s ShortText+unsafeFreeze (MBA# mba#)+  = ST $ \s -> case GHC.Exts.unsafeFreezeByteArray# mba# s of+                 (# s', ba# #) -> (# s', ShortText (BSSI.SBS ba#) #)++{-# INLINE copyByteArray #-}+copyByteArray :: ShortText -> B -> MBA s -> B -> B -> ST s ()+copyByteArray (ShortText (BSSI.SBS src#)) (B (I# src_off#)) (MBA# dst#) (B (I# dst_off#)) (B (I# len#))+  = ST $ \s -> case GHC.Exts.copyByteArray# src# src_off# dst# dst_off# len# s of+                 s' -> (# s', () #)++{-# INLINE newByteArray #-}+newByteArray :: B -> ST s (MBA s)+newByteArray (B (I# n#))+  = ST $ \s -> case GHC.Exts.newByteArray# n# s of+                 (# s', mba# #) -> (# s', MBA# mba# #)++{-# INLINE writeWord8Array #-}+writeWord8Array :: MBA s -> B -> Word -> ST s ()+writeWord8Array (MBA# mba#) (B (I# i#)) (W# w#)+  = ST $ \s -> case GHC.Exts.writeWord8Array# mba# i# w# s of+                 s' -> (# s', () #)+{- not needed yet+{-# INLINE indexWord8Array #-}+indexWord8Array :: ShortText -> B -> Word+indexWord8Array (ShortText (BSSI.SBS ba#)) (B (I# i#)) = W# (GHC.Exts.indexWord8Array# ba# i#)+-}++{-# INLINE copyAddrToByteArray #-}+copyAddrToByteArray :: Ptr a -> MBA RealWorld -> B -> B -> ST RealWorld ()+copyAddrToByteArray (Ptr src#) (MBA# dst#) (B (I# dst_off#)) (B (I# len#))+  = ST $ \s -> case GHC.Exts.copyAddrToByteArray# src# dst# dst_off# len# s of+                 s' -> (# s', () #)++----------------------------------------------------------------------------+-- unsafeFreezeShrink++#if __GLASGOW_HASKELL__ >= 710+-- for GHC versions which have the 'shrinkMutableByteArray#' primop+{-# INLINE unsafeFreezeShrink #-}+unsafeFreezeShrink :: MBA s -> B -> ST s ShortText+unsafeFreezeShrink mba n = do+  shrink mba n+  unsafeFreeze mba++{-# INLINE shrink #-}+shrink :: MBA s -> B -> ST s ()+shrink (MBA# mba#) (B (I# i#))+  = ST $ \s -> case GHC.Exts.shrinkMutableByteArray# mba# i# s of+                 s' -> (# s', () #)+#else+-- legacy code for GHC versions which lack `shrinkMutableByteArray#` primop+{-# INLINE unsafeFreezeShrink #-}+unsafeFreezeShrink :: MBA s -> B -> ST s ShortText+unsafeFreezeShrink mba0 n = do+  mba' <- newByteArray n+  copyByteArray2 mba0 0 mba' 0 n+  unsafeFreeze mba'++{-# INLINE copyByteArray2 #-}+copyByteArray2 :: MBA s -> B -> MBA s -> B -> B -> ST s ()+copyByteArray2 (MBA# src#) (B (I# src_off#)) (MBA# dst#) (B (I# dst_off#)) (B( I# len#))+  = ST $ \s -> case GHC.Exts.copyMutableByteArray# src# src_off# dst# dst_off# len# s of+                 s' -> (# s', () #)+#endif++----------------------------------------------------------------------------+-- Helpers for encoding code points into UTF-8 code units+--+--   7 bits| <    0x80 | 0xxxxxxx+--  11 bits| <   0x800 | 110yyyyx  10xxxxxx+--  16 bits| < 0x10000 | 1110yyyy  10yxxxxx  10xxxxxx+--  21 bits|           | 11110yyy  10yyxxxx  10xxxxxx  10xxxxxx++-- | Unicode Code-point+--+-- Keeping it as a 'Word' is more convenient for bit-ops and FFI+newtype CP = CP Word++{-# INLINE ch2cp #-}+ch2cp :: Char -> CP+ch2cp (ord -> ci)+  | isSurr ci  = CP 0xFFFD+  | otherwise  = CP (fromIntegral ci)++{-# INLINE isSurr #-}+isSurr :: (Num i, Bits i) => i -> Bool+isSurr ci = ci .&. 0xfff800 == 0xd800++{-# INLINE cp2ch #-}+cp2ch :: CP -> Char+cp2ch (CP w) = (w < 0x110000) `assert` unsafeChr (fromIntegral w)++-- used/needed by index-lookup functions to encode out of bounds+cp2chSafe :: CP -> Maybe Char+cp2chSafe cp+  | cpNull cp = Nothing+  | otherwise = Just $! cp2ch cp+  where+    cpNull :: CP -> Bool+    cpNull (CP w) = w >= 0x110000++{-# INLINE cpLen #-}+cpLen :: CP -> B+cpLen (CP cp)+  | cp <    0x80  = B 1+  | cp <   0x800  = B 2+  | cp < 0x10000  = B 3+  | otherwise     = B 4++-- convenience wrapper; unsafe like readCodePoint+{-# INLINE decodeCharAtOfs #-}+decodeCharAtOfs :: ShortText -> B -> (Char,B)+decodeCharAtOfs st ofs = (c,ofs')+  where+    c    = cp2ch cp+    ofs' = ofs + cpLen cp+    cp   = readCodePoint st ofs+{- pure version of decodeCharAtOfs, but unfortunately significantly slower++decodeCharAtOfs st ofs+  | b0 < 0x80 = (cp2ch $ CP b0,ofs + B 1)+  | otherwise = case b0 `unsafeShiftR` 4 of+                  0xf -> (cp2ch $ CP go4, ofs + B 4)+                  0xe -> (cp2ch $ CP go3, ofs + B 3)+                  _   -> (cp2ch $ CP go2, ofs + B 2)+  where+    b0    = buf 0+    buf j = indexWord8Array st (ofs+j)++    go2 =     ((b0    .&. 0x1f) `unsafeShiftL` 6)+          .|.  (buf 1 .&. 0x3f)++    go3 =     ((b0    .&. 0x0f) `unsafeShiftL` (6+6))+          .|. ((buf 1 .&. 0x3f) `unsafeShiftL` 6)+          .|.  (buf 2 .&. 0x3f)++    go4 =     ((b0    .&. 0x07) `unsafeShiftL` (6+6+6))+          .|. ((buf 1 .&. 0x3f) `unsafeShiftL` (6+6))+          .|. ((buf 2 .&. 0x3f) `unsafeShiftL` 6)+          .|.  (buf 3 .&. 0x3f)+-}+++-- | \(\mathcal{O}(1)\) Construct 'ShortText' from single codepoint.+--+-- prop> singleton c == pack [c]+--+-- prop> length (singleton c) == 1+--+-- >>> singleton 'A'+-- "A"+--+-- >>> map singleton ['\55295','\55296','\57343','\57344'] -- U+D7FF U+D800 U+DFFF U+E000+-- ["\55295","\65533","\65533","\57344"]+--+-- __Note__: This function is total because it replaces the (invalid) code-points U+D800 through U+DFFF with the replacement character U+FFFD.+--+-- @since 0.1.2+singleton :: Char -> ShortText+singleton = singleton' . ch2cp++singleton' :: CP -> ShortText+singleton' cp@(CP cpw)+  | cpw <    0x80  = create 1 $ \mba -> writeCodePoint1 mba 0 cp+  | cpw <   0x800  = create 2 $ \mba -> writeCodePoint2 mba 0 cp+  | cpw < 0x10000  = create 3 $ \mba -> writeCodePoint3 mba 0 cp+  | otherwise      = create 4 $ \mba -> writeCodePoint4 mba 0 cp++-- | \(\mathcal{O}(n)\) Prepend a character to a 'ShortText'.+--+-- prop> cons c t == singleton c <> t+--+-- @since 0.1.2+cons :: Char -> ShortText -> ShortText+cons (ch2cp -> cp@(CP cpw)) sfx+  | n == 0         = singleton' cp+  | cpw <    0x80  = create (n+1) $ \mba -> writeCodePoint1 mba 0 cp >> copySfx 1 mba+  | cpw <   0x800  = create (n+2) $ \mba -> writeCodePoint2 mba 0 cp >> copySfx 2 mba+  | cpw < 0x10000  = create (n+3) $ \mba -> writeCodePoint3 mba 0 cp >> copySfx 3 mba+  | otherwise      = create (n+4) $ \mba -> writeCodePoint4 mba 0 cp >> copySfx 4 mba+  where+    !n = toB sfx++    copySfx :: B -> MBA s -> ST s ()+    copySfx ofs mba = copyByteArray sfx 0 mba ofs n++-- | \(\mathcal{O}(n)\) Append a character to the ond of a 'ShortText'.+--+-- prop> snoc t c == t <> singleton c+--+-- @since 0.1.2+snoc :: ShortText -> Char -> ShortText+snoc pfx (ch2cp -> cp@(CP cpw))+  | n == 0         = singleton' cp+  | cpw <    0x80  = create (n+1) $ \mba -> copyPfx mba >> writeCodePoint1 mba n cp+  | cpw <   0x800  = create (n+2) $ \mba -> copyPfx mba >> writeCodePoint2 mba n cp+  | cpw < 0x10000  = create (n+3) $ \mba -> copyPfx mba >> writeCodePoint3 mba n cp+  | otherwise      = create (n+4) $ \mba -> copyPfx mba >> writeCodePoint4 mba n cp+  where+    !n = toB pfx++    copyPfx :: MBA s -> ST s ()+    copyPfx mba = copyByteArray pfx 0 mba 0 n++{-+writeCodePoint :: MBA s -> Int -> Word -> ST s ()+writeCodePoint mba ofs cp+  | cp <    0x80  = writeCodePoint1 mba ofs cp+  | cp <   0x800  = writeCodePoint2 mba ofs cp+  | cp < 0x10000  = writeCodePoint3 mba ofs cp+  | otherwise     = writeCodePoint4 mba ofs cp+-}++writeCodePointN :: B -> MBA s -> B -> CP -> ST s ()+writeCodePointN 1 = writeCodePoint1+writeCodePointN 2 = writeCodePoint2+writeCodePointN 3 = writeCodePoint3+writeCodePointN 4 = writeCodePoint4+writeCodePointN _ = undefined++writeCodePoint1 :: MBA s -> B -> CP -> ST s ()+writeCodePoint1 mba ofs (CP cp) =+  writeWord8Array mba ofs cp++writeCodePoint2 :: MBA s -> B -> CP -> ST s ()+writeCodePoint2 mba ofs (CP cp) = do+  writeWord8Array mba  ofs    (0xc0 .|. (cp `unsafeShiftR` 6))+  writeWord8Array mba (ofs+1) (0x80 .|. (cp                     .&. 0x3f))++writeCodePoint3 :: MBA s -> B -> CP -> ST s ()+writeCodePoint3 mba ofs (CP cp) = do+  writeWord8Array mba  ofs    (0xe0 .|.  (cp `unsafeShiftR` 12))+  writeWord8Array mba (ofs+1) (0x80 .|. ((cp `unsafeShiftR` 6)  .&. 0x3f))+  writeWord8Array mba (ofs+2) (0x80 .|.  (cp                    .&. 0x3f))++writeCodePoint4 :: MBA s -> B -> CP -> ST s ()+writeCodePoint4 mba ofs (CP cp) = do+  writeWord8Array mba  ofs    (0xf0 .|.  (cp `unsafeShiftR` 18))+  writeWord8Array mba (ofs+1) (0x80 .|. ((cp `unsafeShiftR` 12) .&. 0x3f))+  writeWord8Array mba (ofs+2) (0x80 .|. ((cp `unsafeShiftR` 6)  .&. 0x3f))+  writeWord8Array mba (ofs+3) (0x80 .|. (cp                     .&. 0x3f))++-- beware: UNSAFE!+readCodePoint :: ShortText -> B -> CP+readCodePoint st (csizeFromB -> ofs)+  = CP $ unsafeDupablePerformIO (c_text_short_ofs_cp (toByteArray# st) ofs)++foreign import ccall unsafe "hs_text_short_ofs_cp" c_text_short_ofs_cp :: ByteArray# -> CSize -> IO CCodePoint++readCodePointRev :: ShortText -> B -> CP+readCodePointRev st (csizeFromB -> ofs)+  = CP $ unsafeDupablePerformIO (c_text_short_ofs_cp_rev (toByteArray# st) ofs)++foreign import ccall unsafe "hs_text_short_ofs_cp_rev" c_text_short_ofs_cp_rev :: ByteArray# -> CSize -> IO CCodePoint++----------------------------------------------------------------------------+-- string & list literals++-- | __Note__: Surrogate pairs (@[U+D800 .. U+DFFF]@) character literals are replaced by U+FFFD.+--+-- @since 0.1.2+instance GHC.Exts.IsList ShortText where+    type (Item ShortText) = Char+    fromList = fromString+    toList   = toString++-- | __Note__: Surrogate pairs (@[U+D800 .. U+DFFF]@) in string literals are replaced by U+FFFD.+--+-- This matches the behaviour of 'IsString' instance for 'T.Text'.+instance S.IsString ShortText where+    fromString = fromStringLit++-- i.e., don't inline before Phase 0+{-# INLINE [0] fromStringLit #-}+fromStringLit :: String -> ShortText+fromStringLit = fromString++{-# RULES "ShortText empty literal" fromStringLit "" = mempty #-}++-- TODO: this doesn't seem to fire+{-# RULES "ShortText singleton literal" forall c . fromStringLit [c] = singleton c #-}++{-# RULES "ShortText literal ASCII" forall s . fromStringLit (GHC.unpackCString# s) = fromLitAsciiAddr# s #-}++{-# RULES "ShortText literal UTF-8" forall s . fromStringLit (GHC.unpackCStringUtf8# s) = fromLitMUtf8Addr# s #-}++{-# NOINLINE fromLitAsciiAddr# #-}+fromLitAsciiAddr# :: Addr# -> ShortText+fromLitAsciiAddr# (Ptr -> ptr) = unsafeDupablePerformIO $ do+  sz <- csizeToB `fmap` c_strlen ptr++  case sz `compare` 0 of+    EQ -> return mempty -- should not happen if rules fire correctly+    GT -> stToIO $ do+      mba <- newByteArray sz+      copyAddrToByteArray ptr mba 0 sz+      unsafeFreeze mba+    LT -> return (error "fromLitAsciiAddr#")+          -- NOTE: should never happen unless strlen(3) overflows (NB: CSize+          -- is unsigned; the overflow would occur when converting to+          -- 'B')++foreign import ccall unsafe "strlen" c_strlen :: CString -> IO CSize++-- GHC uses an encoding resembling Modified UTF-8 for non-ASCII string-literals+{-# NOINLINE fromLitMUtf8Addr# #-}+fromLitMUtf8Addr# :: Addr# -> ShortText+fromLitMUtf8Addr# (Ptr -> ptr) = unsafeDupablePerformIO $ do+  sz <- B `fmap` c_text_short_mutf8_strlen ptr++  case sz `compare` 0 of+    EQ -> return mempty -- should not happen if rules fire correctly+    GT -> stToIO $ do+      mba <- newByteArray sz+      copyAddrToByteArray ptr mba 0 sz+      unsafeFreeze mba+    LT -> do+      mba <- stToIO (newByteArray (abs sz))+      c_text_short_mutf8_trans ptr (unMBA# mba)+      stToIO (unsafeFreeze mba)++foreign import ccall unsafe "hs_text_short_mutf8_strlen" c_text_short_mutf8_strlen :: CString -> IO Int++foreign import ccall unsafe "hs_text_short_mutf8_trans" c_text_short_mutf8_trans :: CString -> MutableByteArray# RealWorld -> IO ()++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text.Short (pack, unpack, concat)+-- >>> import Text.Show.Functions ()+-- >>> import qualified Test.QuickCheck.Arbitrary as QC+-- >>> import Test.QuickCheck.Instances ()+-- >>> instance QC.Arbitrary ShortText where { arbitrary = fmap fromString QC.arbitrary }

@@ -0,0 +1,100 @@+{-# LANGUAGE Trustworthy #-}++-- |+-- Module      : Data.Text.Short.Partial+-- Copyright   : © Herbert Valerio Riedel 2018+-- License     : BSD3+--+-- Maintainer  : hvr@gnu.org+-- Stability   : stable+--+-- Partial functions vocabulary+--+-- This module provides common partial functions for operating on 'ShortText'.+--+-- The use of these functions is discouraged as they tend to be error-prone.+--+-- @since 0.1.2+module Data.Text.Short.Partial+    ( head+    , tail+    , init+    , last+    , index++    , foldl1+    , foldl1'+    , foldr1+    ) where++import           Data.Text.Short+import           Data.Text.Short.Internal+import           Prelude                  ()++-- | \(\mathcal{O}(1)\) Returns first character of a non-empty 'ShortText'+--+-- >>> head "abcd"+-- 'a'+--+-- __Note__: Will throw an 'error' exception for empty 'ShortText's.+-- Consider using the total functions 'uncons' or 'indexMaybe'+-- instead.+--+-- @since 0.1.2+head :: ShortText -> Char+head = maybe (error "head: empty ShortText") fst . uncons++-- | \(\mathcal{O}(n)\) Drop first character from non-empty 'ShortText'.+--+-- >>> tail "abcd"+-- "bcd"+--+-- __Note__: Will throw an 'error' exception for empty 'ShortText's.+-- Consider using the total functions 'uncons' or 'drop' instead.+--+-- @since 0.1.2+tail :: ShortText -> ShortText+tail = maybe (error "tail: empty ShortText") snd . uncons++-- | \(\mathcal{O}(n)\) Drop last character from non-empty 'ShortText'.+--+-- >>> tail "abcd"+-- "bcd"+--+-- __Note__: Will throw an 'error' exception for empty 'ShortText's.+-- Consider using the total functions 'unsnoc' or 'dropEnd' instead.+--+-- @since 0.1.2+init :: ShortText -> ShortText+init = maybe (error "init: empty ShortText") fst . unsnoc++-- | \(\mathcal{O}(1)\) Return last character from non-empty 'ShortText'.+--+-- >>> last "abcd"+-- 'd'+--+-- __Note__: Will throw an 'error' exception for empty 'ShortText's.+-- Consider using the total functions 'unsnoc' or 'indexEndMaybe'+-- instead.+--+-- @since 0.1.2+last :: ShortText -> Char+last = maybe (error "last: empty ShortText") snd . unsnoc++-- | \(\mathcal{O}(n)\) Retrieve \(i\)-th character (code-point)+--+-- >>> index "abcd" 1+-- 'b'+--+-- __Note__: Will throw an 'error' exception if index is out of+-- bounds.  Consider using the total functions 'indexMaybe' or+-- 'indexEndMaybe' instead.+--+-- @since 0.1.2+index :: ShortText -> Int -> Char+index st i = case indexMaybe st i of+               Nothing -> error "index: not within ShortText"+               Just c  -> c++-- $setup+-- >>> :set -XOverloadedStrings

@@ -1,7 +1,7 @@-cabal-version:       1.12+cabal-version:       1.18  name:                text-short-version:             0.1.1+version:             0.1.2 synopsis:            Memory-efficient representation of Unicode text strings license:             BSD3 license-file:        LICENSE@@ -12,32 +12,46 @@ build-type:          Simple 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.+                     The main difference between 'Text' and 'ShortText' is that 'ShortText' uses UTF-8 instead of UTF-16 internally and also doesn't support zero-copy 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. +tested-with:         GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 extra-source-files:  ChangeLog.md  Source-Repository head     Type:              git     Location:          https://github.com/hvr/text-short.git -library-  default-language:    Haskell2010+flag asserts+  description: Enable runtime-checks via @assert@+  default: False+  manual: True +library   exposed-modules:     Data.Text.Short+                       Data.Text.Short.Partial                        Data.Text.Short.Unsafe    other-modules:       Data.Text.Short.Internal -  build-depends:       base        >= 4.7    && < 4.11+  build-depends:       base        >= 4.7    && < 4.12                      , 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+                     , ghc-prim    >= 0.3.1  && < 0.6    if !impl(ghc >= 8.0)      build-depends: semigroups >= 0.18.2 && < 0.19 +  -- GHC version specific PrimOps+  if impl(ghc >= 8.4)+     hs-source-dirs:   src-ghc804+  else+     c-sources:        cbits/memcmp.c+     hs-source-dirs:   src-ghc708+  other-modules:       PrimOps+   hs-source-dirs:      src    default-language:    Haskell2010@@ -49,10 +63,16 @@                      , Unsafe    c-sources: cbits/cbits.c++  if flag(asserts)+     ghc-options: -fno-ignore-asserts+  else+     cc-options: -DNDEBUG=1+   ghc-options: -Wall+  cc-options: -O3 -Wall  test-suite tests-  default-language:    Haskell2010   type:                exitcode-stdio-1.0   hs-source-dirs:      src-test   main-is:             Tests.hs@@ -62,7 +82,9 @@                , 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+               , tasty                >= 1.0.0  && < 1.1+               , tasty-quickcheck     >= 0.10   && < 0.11+               , tasty-hunit          >= 0.10.0 && < 0.11                , quickcheck-instances >= 0.3.14 && < 0.4++  default-language:    Haskell2010