@@ -9,7 +9,11 @@ module Data.Utf8
99 where
1010
1111
12+import Data.Binary (Binary(..), Get)
13+import Data.Binary.Put (putBuilder)
14+import Data.Binary.Get.Internal (readN)
1215import Data.Bits ((.&.), shiftR)
16+import qualified Data.ByteString.Internal as B
1317import qualified Data.ByteString.Builder.Internal as B
1418import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)
1519import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
@@ -25,7 +29,7 @@ import GHC.Exts
2529 , writeWord8Array#, writeWord16Array#
2630 )
2731import GHC.IO
28−import GHC.ST (ST(ST))
32+import GHC.ST (ST(ST), runST)
2933import GHC.Prim
3034import GHC.Word (Word8(W8#), Word16(W16#))
3135
@@ -54,6 +58,64 @@ instance Eq Utf8 where
5458
5559
5660
61+-- COMPARE
62+
63+
64+instance Ord Utf8 where
65+ compare (Utf8 ba1#) (Utf8 ba2#) =
66+ let
67+ !len1# = sizeofByteArray# ba1#
68+ !len2# = sizeofByteArray# ba2#
69+ !len# = if isTrue# (len1# <# len2#) then len1# else len2#
70+ !cmp# = compareByteArrays# ba1# 0# ba2# 0# len#
71+ in
72+ case () of
73+ _ | isTrue# (cmp# <# 0#) -> LT
74+ | isTrue# (cmp# ># 0#) -> GT
75+ | isTrue# (len1# <# len2#) -> LT
76+ | isTrue# (len1# ># len2#) -> GT
77+ | True -> EQ
78+
79+
80+
81+-- BINARY
82+
83+
84+instance Binary Utf8 where
85+ put utf8@(Utf8 ba#) =
86+ put (I# (sizeofByteArray# ba#)) <> putBuilder (toBuilder utf8)
87+ get =
88+ get >>= getUtf8
89+
90+
91+{-# INLINE getUtf8 #-}
92+getUtf8 :: Int -> Get Utf8
93+getUtf8 n =
94+ if n > 0 then
95+ readN n (fromByteString n)
96+ else
97+ return empty
98+
99+
100+-- TODO add inline?
101+fromByteString :: Int -> B.ByteString -> Utf8
102+fromByteString len (B.PS fptr offset _) =
103+ unsafeDupablePerformIO
104+ (
105+ do mba <- stToIO (newByteArray len)
106+ stToIO (copyFromPtr (unsafeForeignPtrToPtr fptr `plusPtr` offset) mba 0 len)
107+ touchForeignPtr fptr
108+ stToIO (unsafeFreeze mba)
109+ )
110+
111+
112+{-# NOINLINE empty #-}
113+empty :: Utf8
114+empty =
115+ runST (unsafeFreeze =<< newByteArray 0)
116+
117+
118+
57119-- CHUNKS
58120
59121