62bacb12fdccee3b2dc529320a2be1b92c6e8317
[darcs-mirror-arbtt.git] / src / Data / MyText.hs
1 module Data.MyText where
2
3 import qualified Data.ByteString.UTF8 as BSU
4 import qualified Data.ByteString.Lazy as LBS
5 import qualified Data.ByteString as BS
6 import Data.Binary.Get
7 import Data.Binary
8 import Control.Applicative ((<$>))
9 import Control.Arrow (first)
10 import Prelude hiding (length, map, null)
11 import qualified Prelude
12 import GHC.Exts( IsString(..) )
13 import Control.DeepSeq
14 import Control.Monad
15
16 newtype Text = Text { toBytestring :: BSU.ByteString } deriving (Eq, Ord)
17
18 instance Show Text where
19     showsPrec i t = showsPrec i (toBytestring t)
20
21 instance Read Text where
22     readsPrec i s = Prelude.map (first Text) $ readsPrec i s 
23
24 instance IsString Text where
25     fromString = pack
26
27 -- Binary instance compatible with Binary String
28 instance Binary Text where
29     put = put . unpack
30     -- The following code exploits that the Binary Char instance uses UTF8 as well
31     -- The downside is that it quietly suceeds for broken input
32     get = do
33         n <- get :: Get Int
34         lbs <- lookAhead (getLazyByteString (4*fromIntegral n)) -- safe approximation
35         let bs = BS.concat $ LBS.toChunks $ lbs
36         let utf8bs = BSU.take n bs
37         unless (BSU.length utf8bs == n) $
38             fail $ "Coult not parse the expected " ++ show n ++ " utf8 characters."
39         skip (BS.length utf8bs)
40         return $ Text utf8bs
41
42 {- Possible speedup with a version of binary that provides access to the
43    internals, as the Char instance is actually UTF8, but the length bit is
44    chars, not bytes.
45 instance Binary Text where
46     put = put . unpack
47     get = do
48         n <- get :: Get Int
49         let go = do
50             s <- GI.get 
51             let utf8s = BSU.take n s
52             if BSU.length utf8s == n
53                 then GI.skip (B.length utf8s) >> return utf8s
54                 else GI.demandInput >> go
55         go
56 -}
57
58 instance NFData Text where
59     rnf (Text a) = a `seq` ()
60
61 length :: Text -> Int
62 length (Text bs) = BSU.length bs
63
64 decodeUtf8 :: BS.ByteString -> Text
65 decodeUtf8 = Text
66
67 encodeUtf8 :: Text -> BS.ByteString
68 encodeUtf8 = toBytestring
69
70 unpack :: Text -> String
71 unpack = BSU.toString . toBytestring
72
73 pack :: String -> Text
74 pack = Text . BSU.fromString
75
76 map :: (Char -> Char) -> Text -> Text
77 map f = pack . Prelude.map f . unpack
78
79 concat :: [Text] -> Text
80 concat = Text . BS.concat . Prelude.map toBytestring
81
82 null :: Text -> Bool
83 null = BS.null . toBytestring