git.iko.soy/text
on master help sign in
text/Data/Text/Unsafe.hs
123 lines 4.2 kB history raw
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2-- |
3-- Module : Data.Text.Unsafe
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5-- License : BSD-style
6-- Maintainer : bos@serpentine.com
7-- Stability : experimental
8-- Portability : portable
9--
10-- A module containing unsafe 'Text' operations, for very very careful
11-- use in heavily tested code.
12module Data.Text.Unsafe
13 (
14 inlineInterleaveST
15 , inlinePerformIO
16 , unsafeDupablePerformIO
17 , Iter(..)
18 , iter
19 , iter_
20 , reverseIter
21 , reverseIter_
22 , unsafeHead
23 , unsafeTail
24 , lengthWord16
25 , takeWord16
26 , dropWord16
27 ) where
29#if defined(ASSERTS)
30import Control.Exception (assert)
31#endif
32import Data.Text.Internal.Encoding.Utf16 (chr2)
33import Data.Text.Internal (Text(..))
34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
35import Data.Text.Internal.Unsafe.Char (unsafeChr)
36import qualified Data.Text.Array as A
37import GHC.IO (unsafeDupablePerformIO)
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
40-- omits the check for the empty case, so there is an obligation on
41-- the programmer to provide a proof that the 'Text' is non-empty.
42unsafeHead :: Text -> Char
43unsafeHead (Text arr off _len)
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
45 | otherwise = chr2 m n
46 where m = A.unsafeIndex arr off
47 n = A.unsafeIndex arr (off+1)
48{-# INLINE unsafeHead #-}
50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
51-- omits the check for the empty case, so there is an obligation on
52-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeTail :: Text -> Text
54unsafeTail t@(Text arr off len) =
55#if defined(ASSERTS)
56 assert (d <= len) $
57#endif
58 Text arr (off+d) (len-d)
59 where d = iter_ t 0
60{-# INLINE unsafeTail #-}
62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
64-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
65-- array, returning the current character and the delta to add to give
66-- the next offset to iterate at.
67iter :: Text -> Int -> Iter
68iter (Text arr off _len) i
69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
70 | otherwise = Iter (chr2 m n) 2
71 where m = A.unsafeIndex arr j
72 n = A.unsafeIndex arr k
73 j = off + i
74 k = j + 1
75{-# INLINE iter #-}
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
78-- delta to add to give the next offset to iterate at.
79iter_ :: Text -> Int -> Int
80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
81 | otherwise = 2
82 where m = A.unsafeIndex arr (off+i)
83{-# INLINE iter_ #-}
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
86-- returning the current character and the delta to add (i.e. a
87-- negative number) to give the next offset to iterate at.
88reverseIter :: Text -> Int -> (Char,Int)
89reverseIter (Text arr off _len) i
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
91 | otherwise = (chr2 n m, -2)
92 where m = A.unsafeIndex arr j
93 n = A.unsafeIndex arr k
94 j = off + i
95 k = j - 1
96{-# INLINE reverseIter #-}
98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99-- returning the delta to add (i.e. a negative number) to give the
100-- next offset to iterate at.
101reverseIter_ :: Text -> Int -> Int
102reverseIter_ (Text arr off _len) i
103 | m < 0xDC00 || m > 0xDFFF = -1
104 | otherwise = -2
105 where m = A.unsafeIndex arr (off+i)
106{-# INLINE reverseIter_ #-}
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
109-- is useful for sizing a target array appropriately before using
110-- 'unsafeCopyToPtr'.
111lengthWord16 :: Text -> Int
112lengthWord16 (Text _arr _off len) = len
113{-# INLINE lengthWord16 #-}
115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
116takeWord16 :: Int -> Text -> Text
117takeWord16 k (Text arr off _len) = Text arr off k
118{-# INLINE takeWord16 #-}
120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
121dropWord16 :: Int -> Text -> Text
122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
123{-# INLINE dropWord16 #-}