Expose unpackCString#
[packages/text.git] / Data / Text / Show.hs
1 {-# LANGUAGE CPP, MagicHash #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 #if __GLASGOW_HASKELL__ >= 702
4 {-# LANGUAGE Trustworthy #-}
5 #endif
6
7 -- |
8 -- Module : Data.Text.Show
9 -- Copyright : (c) 2009-2015 Bryan O'Sullivan
10 --
11 -- License : BSD-style
12 -- Maintainer : bos@serpentine.com
13 -- Stability : experimental
14 -- Portability : GHC
15
16 module Data.Text.Show
17 (
18 singleton
19 , unpack
20 , unpackCString#
21 ) where
22
23 import Control.Monad.ST (ST)
24 import Data.Text.Internal (Text(..), empty_, safe)
25 import Data.Text.Internal.Fusion (stream, unstream)
26 import Data.Text.Internal.Unsafe.Char (unsafeWrite)
27 import GHC.Prim (Addr#)
28 import qualified Data.Text.Array as A
29 import qualified Data.Text.Internal.Fusion.Common as S
30
31 #if __GLASGOW_HASKELL__ >= 702
32 import qualified GHC.CString as GHC
33 #else
34 import qualified GHC.Base as GHC
35 #endif
36
37 instance Show Text where
38 showsPrec p ps r = showsPrec p (unpack ps) r
39
40 -- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
41 unpack :: Text -> String
42 unpack = S.unstreamList . stream
43 {-# INLINE [1] unpack #-}
44
45 -- | /O(n)/ Convert a literal string into a 'Text'. Subject to
46 -- fusion.
47 --
48 -- This is exposed solely for people writing GHC rewrite rules.
49 unpackCString# :: Addr# -> Text
50 unpackCString# addr# = unstream (S.streamCString# addr#)
51 {-# NOINLINE unpackCString# #-}
52
53 {-# RULES "TEXT literal" forall a.
54 unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
55 = unpackCString# a #-}
56
57 {-# RULES "TEXT literal UTF8" forall a.
58 unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
59 = unpackCString# a #-}
60
61 {-# RULES "TEXT empty literal"
62 unstream (S.map safe (S.streamList []))
63 = empty_ #-}
64
65 {-# RULES "TEXT singleton literal" forall a.
66 unstream (S.map safe (S.streamList [a]))
67 = singleton_ a #-}
68
69 -- | /O(1)/ Convert a character into a Text. Subject to fusion.
70 -- Performs replacement on invalid scalar values.
71 singleton :: Char -> Text
72 singleton = unstream . S.singleton . safe
73 {-# INLINE [1] singleton #-}
74
75 {-# RULES "TEXT singleton" forall a.
76 unstream (S.singleton (safe a))
77 = singleton_ a #-}
78
79 -- This is intended to reduce inlining bloat.
80 singleton_ :: Char -> Text
81 singleton_ c = Text (A.run x) 0 len
82 where x :: ST s (A.MArray s)
83 x = do arr <- A.new len
84 _ <- unsafeWrite arr 0 d
85 return arr
86 len | d < '\x10000' = 1
87 | otherwise = 2
88 d = safe c
89 {-# NOINLINE singleton_ #-}