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
|
-- | Some kind of dynamic string, or dequeue string, if you like, that
-- supports efficient concatenation on both sides if you don't make your
-- chunks too weird.
module DString (
DString,
pack, unpack, singleton, length, take, drop, null, head, concat, hPutStr
) where
import Prelude hiding (length, take, drop, null, head, concat)
import Data.Foldable (toList)
import qualified Data.Sequence as S
import Data.Sequence (ViewL((:<)))
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
import System.IO (Handle)
newtype DString = DString (S.Seq T.Text)
deriving (Show)
instance Eq DString where
DString s == DString s' = T.concat (toList s) == T.concat (toList s')
pack :: String -> DString
pack s = DString (S.singleton (T.pack s))
unpack :: DString -> String
unpack (DString s) = T.unpack (T.concat (toList s))
singleton :: Char -> DString
singleton c = DString (S.singleton (T.singleton c))
length :: DString -> Int
length (DString s) = fromIntegral (sum (map T.length (toList s)))
take :: Int -> DString -> DString
take n (DString s) =
let n' = fromIntegral n
lens = S.scanl (\acc t -> acc + T.length t) 0 s
ndigits = S.length (S.takeWhileL (< n') lens) + 1
text = T.take n' (T.concat (toList (S.take ndigits s)))
in DString (S.singleton text)
drop :: Int -> DString -> DString
drop n (DString s)
| n <= 0 = DString s
| otherwise =
let n' = fromIntegral n
lens = S.scanl (\acc text -> acc + T.length text) 0 s
ndigits = S.length (S.takeWhileL (< n') lens) - 1
s' = S.drop ndigits s
remain = n' - (lens `S.index` ndigits)
s'' = case S.viewl s' of
S.EmptyL -> S.empty
text :< rest -> T.drop remain text S.<| rest
in DString s''
null :: DString -> Bool
null (DString s) = sum (map T.length (toList s)) == 0
head :: DString -> Char
head (DString s) = case S.viewl s of
S.EmptyL -> error "Empty DString in DString.head"
text :< rest -> if T.length text > 0 then T.head text else DString.head (DString rest)
concat :: [DString] -> DString
concat strs = DString (mconcat [s | DString s <- strs])
hPutStr :: Handle -> DString -> IO ()
hPutStr h (DString s) = mapM_ (T.hPutStr h) (toList s)
|
