-
Notifications
You must be signed in to change notification settings - Fork 267
/
Text.hs
134 lines (99 loc) · 3.36 KB
/
Text.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Unison.Util.Text where
import Data.Foldable (toList)
import Data.List (foldl', unfoldr)
import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Unison.Util.Bytes as B
import qualified Unison.Util.Rope as R
import Prelude hiding (drop, replicate, take)
-- Text type represented as a `Rope` of chunks
newtype Text = Text (R.Rope Chunk)
deriving stock (Eq, Ord)
deriving newtype (Semigroup, Monoid)
data Chunk = Chunk {-# UNPACK #-} !Int {-# UNPACK #-} !T.Text
empty :: Text
empty = Text mempty
one, singleton :: Char -> Text
one ch = Text (R.one (chunk (T.singleton ch)))
singleton = one
threshold :: Int
threshold = 512
replicate :: Int -> Text -> Text
replicate n t | size t * n < threshold = Text (R.one (chunk (T.replicate n (toText t))))
replicate 0 _ = mempty
replicate 1 t = t
replicate n t =
replicate (n `div` 2) t <> replicate (n - (n `div` 2)) t
chunkToText :: Chunk -> T.Text
chunkToText (Chunk _ t) = t
chunk :: T.Text -> Chunk
chunk t = Chunk (T.length t) t
take :: Int -> Text -> Text
take n (Text t) = Text (R.take n t)
drop :: Int -> Text -> Text
drop n (Text t) = Text (R.drop n t)
uncons :: Text -> Maybe (Char, Text)
uncons t | size t == 0 = Nothing
uncons t = (,drop 1 t) <$> at 0 t
unsnoc :: Text -> Maybe (Text, Char)
unsnoc t | size t == 0 = Nothing
unsnoc t = (take (size t - 1) t,) <$> at (size t - 1) t
at :: Int -> Text -> Maybe Char
at n (Text t) = R.index n t
size :: Text -> Int
size (Text t) = R.size t
reverse :: Text -> Text
reverse (Text t) = Text (R.reverse t)
fromUtf8 :: B.Bytes -> Either String Text
fromUtf8 bs =
case T.decodeUtf8' (B.toByteString bs) of
Right t -> Right (fromText t)
Left e -> Left (show e)
toUtf8 :: Text -> B.Bytes
toUtf8 (Text t) = B.Bytes (R.map (B.chunkFromByteString . T.encodeUtf8 . chunkToText) t)
fromText :: T.Text -> Text
fromText s | T.null s = mempty
fromText s = Text (go (chunk <$> T.chunksOf threshold s))
where
go = foldl' R.snoc mempty
pack :: String -> Text
pack = fromText . T.pack
{-# INLINE pack #-}
toString, unpack :: Text -> String
toString (Text bs) = toList bs >>= (T.unpack . chunkToText)
{-# INLINE toString #-}
{-# INLINE unpack #-}
unpack = toString
toText :: Text -> T.Text
toText (Text t) = T.concat (chunkToText <$> unfoldr R.uncons t)
{-# INLINE toText #-}
instance Eq Chunk where (Chunk n a) == (Chunk n2 a2) = n == n2 && a == a2
instance Ord Chunk where (Chunk _ a) `compare` (Chunk _ a2) = compare a a2
instance Semigroup Chunk where (<>) = mappend
instance Monoid Chunk where
mempty = Chunk 0 mempty
mappend l r = Chunk (R.size l + R.size r) (chunkToText l <> chunkToText r)
instance R.Sized Chunk where size (Chunk n _) = n
instance R.Drop Chunk where
drop k c@(Chunk n t)
| k >= n = mempty
| k <= 0 = c
| otherwise = Chunk (n - k) (T.drop k t)
instance R.Take Chunk where
take k c@(Chunk n t)
| k >= n = c
| k <= 0 = mempty
| otherwise = Chunk k (T.take k t)
instance R.Index Chunk Char where
unsafeIndex i (Chunk _ t) = T.index t i
instance R.Reverse Chunk where
reverse (Chunk n t) = Chunk n (T.reverse t)
instance R.Sized Text where size (Text t) = R.size t
instance Show Text where
show t = show (toText t)
instance IsString Text where
fromString = pack