1{-# LANGUAGE MultiParamTypeClasses
2            ,FlexibleInstances
3            ,TypeFamilies
4            ,TypeSynonymInstances #-}
5
6
7{-
8Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>
9
10All rights reserved.
11
12For license and copyright information, see the file COPYRIGHT
13
14-}
15
16{- |
17   Module     : Data.ListLike.CharString
18   Copyright  : Copyright (C) 2007 John Goerzen
19   License    : BSD3
20
21   Maintainer : John Lato <jwlato@gmail.com>
22   Stability  : provisional
23   Portability: portable
24
25Newtype wrapper for ByteString to enable a Char-based interface
26Re-exported by "Data.ListLike".
27
28Written by John Lato, jwlato\@gmail.com
29-}
30
31module Data.ListLike.CharString (
32  CharString (..)
33 ,CharStringLazy (..)
34)
35
36where
37
38import Prelude hiding (length, head, last, null, tail, map, filter, concat,
39                       any, lookup, init, all, foldl, foldr, foldl1, foldr1,
40                       maximum, minimum, iterate, span, break, takeWhile,
41                       dropWhile, reverse, zip, zipWith, sequence,
42                       sequence_, mapM, mapM_, concatMap, and, or, sum,
43                       product, repeat, replicate, cycle, take, drop,
44                       splitAt, elem, notElem, unzip, lines, words,
45                       unlines, unwords)
46--import qualified Data.Foldable as F
47import           Data.ListLike.Base
48import           Data.ListLike.String
49import           Data.ListLike.IO
50import           Data.ListLike.FoldableLL
51import           Data.Int
52import           Data.Monoid
53import           Data.Semigroup (Semigroup(..))
54import           Data.String (IsString(..))
55import qualified Data.ByteString.Char8 as BS
56import qualified Data.ByteString.Lazy.Char8 as BSL
57--import qualified System.IO as IO
58--import           Data.Word
59import           Control.Arrow
60import           GHC.Exts (IsList(..))
61
62--------------------------------------------------
63-- ByteString
64
65-- | Newtype wrapper around Data.ByteString.Char8.ByteString,
66--   this allows for ListLike instances with Char elements.
67newtype CharString = CS { unCS :: BS.ByteString }
68  deriving (Read, Show, Eq, Ord)
69
70instance Semigroup CharString where
71  (<>) = mappend
72
73instance Monoid CharString where
74  mempty = CS mempty
75  mappend l r = CS $ mappend (unCS l) (unCS r)
76
77instance FoldableLL CharString Char where
78    foldl f i0  ls = BS.foldl f i0 (unCS ls)
79    foldl' f i0 ls = BS.foldl' f i0 (unCS ls)
80    foldl1 f    ls = BS.foldl1 f (unCS ls)
81    foldr f i0  ls = BS.foldr f i0 (unCS ls)
82    foldr1 f    ls = BS.foldr1 f (unCS ls)
83
84instance IsList CharString where
85  type Item CharString = Char
86  toList = BS.unpack . unCS
87  fromList = CS . BS.pack
88
89instance ListLike CharString Char where
90    empty = CS BS.empty
91    singleton = CS . BS.singleton
92    cons x l = CS (BS.cons x (unCS l))
93    snoc l x = CS (BS.snoc (unCS l) x)
94    append l r = CS $ BS.append (unCS l) (unCS r)
95    head = BS.head . unCS
96    last = BS.last . unCS
97    tail = CS . BS.tail . unCS
98    init = CS . BS.init . unCS
99    null = BS.null . unCS
100    length = fromIntegral . BS.length . unCS
101    -- map = BS.map
102    rigidMap f = CS . BS.map f . unCS
103    reverse = CS . BS.reverse . unCS
104    --intersperse = BS.intersperse
105    concat = CS . BS.concat . map unCS . toList
106    --concatMap = BS.concatMap
107    rigidConcatMap f = CS . BS.concatMap (unCS . f) . unCS
108    any p = BS.any p . unCS
109    all p = BS.all p . unCS
110    maximum = BS.maximum . unCS
111    minimum = BS.minimum . unCS
112    replicate i = CS . BS.replicate (fromIntegral i)
113    take i = CS . BS.take (fromIntegral i) . unCS
114    drop i = CS . BS.drop (fromIntegral i) . unCS
115    splitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS
116    takeWhile p = CS . BS.takeWhile p . unCS
117    dropWhile p = CS . BS.dropWhile p . unCS
118    span p  = (CS *** CS) . BS.span p . unCS
119    break p = (CS *** CS) . BS.break p . unCS
120    group = fromList . map CS . BS.group . unCS
121    inits = fromList . map CS . BS.inits . unCS
122    tails = fromList . map CS . BS.tails . unCS
123    isPrefixOf p f = BS.isPrefixOf (unCS p) (unCS f)
124    --isSuffixOf = BS.isSuffixOf
125    --isInfixOf = BS.isInfixOf
126    elem x = BS.elem x . unCS
127    notElem x = BS.notElem x . unCS
128    find p = BS.find p . unCS
129    filter p = CS . BS.filter p . unCS
130    --partition = BS.partition
131    index l i = BS.index (unCS l) (fromIntegral i)
132    elemIndex i = BS.elemIndex i  . unCS
133    --elemIndices x = fromList . L.map fromIntegral . BS.elemIndices x
134    findIndex f = BS.findIndex f . unCS
135    --findIndices x = fromList . L.map fromIntegral . BS.findIndices x
136    --sequence = BS.sequence
137    --mapM = BS.mapM
138    --mapM_ = BS.mapM_
139    --nub = BS.nub
140    --delete = BS.delete
141    --deleteFirsts = BS.deleteFirsts
142    --union = BS.union
143    --intersect = BS.intersect
144    --sort = BS.sort
145    --insert = BS.insert
146    --toList = BS.unpack . unCS
147    --fromList = CS . BS.pack
148    --fromListLike = fromList . toList
149    --nubBy = BS.nubBy
150    --deleteBy = BS.deleteBy
151    --deleteFirstsBy = BS.deleteFirstsBy
152    --unionBy = BS.unionBy
153    --intersectBy = BS.intersectBy
154    -- BS.groupBy is broken. groupBy f = fromList . BS.groupBy f
155    -- the below works on ghc but generates a type error on hugs
156    -- groupBy func = map fromList . L.groupBy func . toList
157    --sortBy = BS.sortBy
158    --insertBy = BS.insertBy
159    genericLength = fromInteger . fromIntegral . BS.length . unCS
160    genericTake i = CS . BS.take (fromIntegral i) . unCS
161    genericDrop i = CS . BS.drop (fromIntegral i) . unCS
162    genericSplitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS
163    genericReplicate i = CS . BS.replicate (fromIntegral i)
164
165instance ListLikeIO CharString Char where
166    hGetLine h = fmap CS $ BS.hGetLine h
167    hGetContents = fmap CS . BS.hGetContents
168    hGet h n = fmap CS $ BS.hGet h n
169    hGetNonBlocking h n = fmap CS $ BS.hGetNonBlocking h n
170    hPutStr h = BS.hPut h . unCS
171    --hPutStrLn = BS.hPutStrLn
172    getLine = fmap CS BS.getLine
173    getContents = fmap CS BS.getContents
174    putStr = BS.putStr . unCS
175    putStrLn = BS.putStrLn . unCS
176    interact f = BS.interact (unCS . f . CS)
177    readFile = fmap CS . BS.readFile
178    writeFile fp = BS.writeFile fp . unCS
179    appendFile fp = BS.appendFile fp . unCS
180
181instance IsString CharString where
182    fromString = CS . BS.pack
183
184instance StringLike CharString where
185    toString = BS.unpack . unCS
186
187--------------------------------------------------
188-- ByteString.Lazy
189
190-- | Newtype wrapper around Data.ByteString.Lazy.Char8.ByteString,
191--   this allows for ListLike instances with Char elements.
192newtype CharStringLazy = CSL { unCSL :: BSL.ByteString }
193  deriving (Read, Show, Eq, Ord)
194
195instance Semigroup CharStringLazy where
196  (<>) = mappend
197
198instance Monoid CharStringLazy where
199  mempty = CSL mempty
200  mappend l r = CSL $ mappend (unCSL l) (unCSL r)
201
202instance FoldableLL CharStringLazy Char where
203    foldl f i0  ls = BSL.foldl f i0 (unCSL ls)
204    foldl' f i0 ls = BSL.foldl' f i0 (unCSL ls)
205    foldl1 f    ls = BSL.foldl1 f (unCSL ls)
206    foldr f i0  ls = BSL.foldr f i0 (unCSL ls)
207    foldr1 f    ls = BSL.foldr1 f (unCSL ls)
208
209mi64toi :: Maybe Int64 -> Maybe Int
210mi64toi Nothing = Nothing
211mi64toi (Just x) = Just (fromIntegral x)
212
213instance IsList CharStringLazy where
214  type Item CharStringLazy = Char
215  toList = BSL.unpack . unCSL
216  fromList = CSL . BSL.pack
217
218instance ListLike CharStringLazy Char where
219    empty = CSL BSL.empty
220    singleton = CSL . BSL.singleton
221    cons x l = CSL (BSL.cons x (unCSL l))
222    snoc l x = CSL (BSL.snoc (unCSL l) x)
223    append l r = CSL $ BSL.append (unCSL l) (unCSL r)
224    head = BSL.head . unCSL
225    last = BSL.last . unCSL
226    tail = CSL . BSL.tail . unCSL
227    init = CSL . BSL.init . unCSL
228    null = BSL.null . unCSL
229    length = fromIntegral . BSL.length . unCSL
230    -- map = BSL.map
231    rigidMap f = CSL . BSL.map f . unCSL
232    reverse = CSL . BSL.reverse . unCSL
233    --intersperse = BSL.intersperse
234    concat = CSL . BSL.concat . map unCSL . toList
235    --concatMap = BSL.concatMap
236    rigidConcatMap f = CSL . BSL.concatMap (unCSL . f) . unCSL
237    any p = BSL.any p . unCSL
238    all p = BSL.all p . unCSL
239    maximum = BSL.maximum . unCSL
240    minimum = BSL.minimum . unCSL
241    replicate i = CSL . BSL.replicate (fromIntegral i)
242    take i = CSL . BSL.take (fromIntegral i) . unCSL
243    drop i = CSL . BSL.drop (fromIntegral i) . unCSL
244    splitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL
245    takeWhile p = CSL . BSL.takeWhile p . unCSL
246    dropWhile p = CSL . BSL.dropWhile p . unCSL
247    span p  = (CSL *** CSL) . BSL.span p . unCSL
248    break p = (CSL *** CSL) . BSL.break p . unCSL
249    group = fromList . map CSL . BSL.group . unCSL
250    inits = fromList . map CSL . BSL.inits . unCSL
251    tails = fromList . map CSL . BSL.tails . unCSL
252    isPrefixOf p f = BSL.isPrefixOf (unCSL p) (unCSL f)
253    --isSuffixOf = BSL.isSuffixOf
254    --isInfixOf = BSL.isInfixOf
255    elem x = BSL.elem x . unCSL
256    notElem x = BSL.notElem x . unCSL
257    find p = BSL.find p . unCSL
258    filter p = CSL . BSL.filter p . unCSL
259    --partition = BSL.partition
260    index l i = BSL.index (unCSL l) (fromIntegral i)
261    elemIndex i = mi64toi . BSL.elemIndex i  . unCSL
262    --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x
263    findIndex f = mi64toi . BSL.findIndex f . unCSL
264    --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x
265    --sequence = BSL.sequence
266    --mapM = BSL.mapM
267    --mapM_ = BSL.mapM_
268    --nub = BSL.nub
269    --delete = BSL.delete
270    --deleteFirsts = BSL.deleteFirsts
271    --union = BSL.union
272    --intersect = BSL.intersect
273    --sort = BSL.sort
274    --insert = BSL.insert
275    --toList = BSL.unpack . unCSL
276    --fromList = CSL . BSL.pack
277    --fromListLike = fromList . toList
278    --nubBy = BSL.nubBy
279    --deleteBy = BSL.deleteBy
280    --deleteFirstsBy = BSL.deleteFirstsBy
281    --unionBy = BSL.unionBy
282    --intersectBy = BSL.intersectBy
283    -- BSL.groupBy is broken. groupBy f = fromList . BSL.groupBy f
284    -- the below works on ghc but generates a type error on hugs
285    -- groupBy func = map fromList . L.groupBy func . toList
286    --sortBy = BSL.sortBy
287    --insertBy = BSL.insertBy
288    genericLength = fromInteger . fromIntegral . BSL.length . unCSL
289    genericTake i = CSL . BSL.take (fromIntegral i) . unCSL
290    genericDrop i = CSL . BSL.drop (fromIntegral i) . unCSL
291    genericSplitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL
292    genericReplicate i = CSL . BSL.replicate (fromIntegral i)
293
294strict2lazy :: BS.ByteString -> CharStringLazy
295strict2lazy b = CSL $ BSL.fromChunks [b]
296
297instance ListLikeIO CharStringLazy Char where
298    hGetLine h = fmap strict2lazy $ BS.hGetLine h
299    hGetContents = fmap CSL . BSL.hGetContents
300    hGet h n = fmap CSL $ BSL.hGet h n
301    hGetNonBlocking h n = fmap CSL $ BSL.hGetNonBlocking h n
302    hPutStr h = BSL.hPut h . unCSL
303    --hPutStrLn = BSL.hPutStrLn
304    getLine = fmap strict2lazy BS.getLine
305    getContents = fmap CSL BSL.getContents
306    putStr = BSL.putStr . unCSL
307    putStrLn = BSL.putStrLn . unCSL
308    interact f = BSL.interact (unCSL . f . CSL)
309    readFile = fmap CSL . BSL.readFile
310    writeFile fp = BSL.writeFile fp . unCSL
311    appendFile fp = BSL.appendFile fp . unCSL
312
313instance IsString CharStringLazy where
314    fromString = CSL . BSL.pack
315
316instance StringLike CharStringLazy where
317    toString = BSL.unpack . unCSL
318