1{-# LANGUAGE CPP
2            ,MultiParamTypeClasses
3            ,FlexibleInstances
4            ,TypeFamilies
5            ,TypeSynonymInstances
6            ,UndecidableInstances #-}
7{-# OPTIONS -fno-warn-orphans #-}
8
9{- |
10Instances of 'Data.ListLike.ListLike' and related classes.
11Re-exported by "Data.ListLike".
12-}
13
14--------------------------------------------------
15-- UTF8 ByteString
16
17module Data.ListLike.UTF8 () where
18
19#if !MIN_VERSION_base(4,8,0)
20import           Control.Applicative
21#endif
22import qualified Data.ByteString as BS
23import qualified Data.ByteString.Char8 as BSC
24import qualified Data.ByteString.Lazy as BSL
25import qualified Data.ByteString.Lazy.Char8 as BSLC
26--import Control.DeepSeq (NFData(rnf))
27import Data.ListLike.Base as LL
28import Data.ListLike.FoldableLL
29import Data.ListLike.IO
30import Data.ListLike.String (StringLike(..))
31import Data.Maybe (fromMaybe)
32import Data.Monoid (Monoid(..))
33import Data.Semigroup (Semigroup(..))
34import Data.String (IsString(fromString))
35import Data.String.UTF8 (UTF8{-, UTF8Bytes-})
36import qualified Data.String.UTF8 as UTF8
37import GHC.Exts (IsList(..))
38--import GHC.Generics
39
40#if 0
41utf8rnf :: NFData a => UTF8 a -> ()
42utf8rnf = rnf . UTF8.toRep
43#endif
44
45instance FoldableLL (UTF8 BS.ByteString) Char where
46    foldl = UTF8.foldl
47    -- foldl' = UTF8.foldl'
48    -- foldl1 = UTF8.foldl1
49    foldr = UTF8.foldr
50    -- foldr' = UTF8.foldr'
51    -- foldr1 = UTF8.foldr1
52
53instance IsList (UTF8 BS.ByteString) where
54    type Item (UTF8 BS.ByteString) = Char
55    toList = UTF8.toString
56    fromList = LL.fromList' -- LL.map id
57
58instance ListLike (UTF8 BS.ByteString) Char where
59    empty = mempty
60    singleton c = UTF8.fromString [c]
61    -- cons = UTF8.cons
62    -- snoc = UTF8.snoc
63    -- append = UTF8.append
64    uncons = UTF8.uncons
65    head = fst . fromMaybe (error "head") . uncons
66    -- last = UTF8.last
67    tail = snd . fromMaybe (error "tail") . uncons
68    -- init = UTF8.init
69    null s = UTF8.length s == 0
70    length = UTF8.length
71    -- -- map =
72    -- rigidMap = UTF8.map
73    -- reverse = UTF8.reverse
74    -- intersperse = UTF8.intersperse
75    -- concat = UTF8.concat . toList
76    -- --concatMap =
77    -- rigidConcatMap = UTF8.concatMap
78    -- any = UTF8.any
79    -- all = UTF8.all
80    -- maximum = UTF8.maximum
81    -- minimum = UTF8.minimum
82    -- replicate = UTF8.replicate
83    take = UTF8.take
84    drop = UTF8.drop
85    splitAt = UTF8.splitAt
86    -- takeWhile = UTF8.takeWhile
87    -- dropWhile = UTF8.dropWhile
88    span = UTF8.span
89    break = UTF8.break
90    -- group = fromList . UTF8.group
91    -- inits = fromList . UTF8.inits
92    -- tails = fromList . UTF8.tails
93    -- isPrefixOf = UTF8.isPrefixOf
94    -- isSuffixOf = UTF8.isSuffixOf
95    -- --isInfixOf = UTF8.isInfixOf
96    -- elem = UTF8.elem
97    -- notElem = UTF8.notElem
98    -- find = UTF8.find
99    -- filter = UTF8.filter
100    -- --partition = UTF8.partition
101    -- index = UTF8.index
102    -- elemIndex = UTF8.elemIndex
103    -- elemIndices x = fromList . UTF8.elemIndices x
104    -- findIndex = UTF8.findIndex
105    -- findIndices x = fromList . UTF8.findIndices x
106    -- -- the default definitions don't work well for array-like things, so
107    -- -- do monadic stuff via a list instead
108    -- sequence  = liftM fromList . P.sequence  . toList
109    -- mapM func = liftM fromList . P.mapM func . toList
110    -- --nub = UTF8.nub
111    -- --delete = UTF8.delete
112    -- --deleteFirsts = UTF8.deleteFirsts
113    -- --union = UTF8.union
114    -- --intersect = UTF8.intersect
115    -- sort = UTF8.sort
116    -- --insert = UTF8.insert
117    --toList = UTF8.toString
118    -- fromList = UTF8.pack
119    -- fromListLike = fromList . toList
120    -- --nubBy = UTF8.nubBy
121    -- --deleteBy = UTF8.deleteBy
122    -- --deleteFirstsBy = UTF8.deleteFirstsBy
123    -- --unionBy = UTF8.unionBy
124    -- --intersectBy = UTF8.intersectBy
125    -- groupBy f = fromList . UTF8.groupBy f
126    -- --sortBy = UTF8.sortBy
127    -- --insertBy = UTF8.insertBy
128    -- genericLength = fromInteger . fromIntegral . UTF8.length
129    -- genericTake i = UTF8.take (fromIntegral i)
130    -- genericDrop i = UTF8.drop (fromIntegral i)
131    -- genericSplitAt i = UTF8.splitAt (fromIntegral i)
132    -- genericReplicate i = UTF8.replicate (fromIntegral i)
133
134instance ListLikeIO (UTF8 BS.ByteString) Char where
135    hGetLine h = UTF8.fromRep <$> BS.hGetLine h
136    hGetContents h = UTF8.fromRep <$> BS.hGetContents h
137    hGet h n = UTF8.fromRep <$> BS.hGet h n
138    hGetNonBlocking h n = UTF8.fromRep <$> BS.hGetNonBlocking h n
139    hPutStr h s = BS.hPutStr h (UTF8.toRep s)
140    hPutStrLn h s = BSC.hPutStrLn h (UTF8.toRep s)
141    -- getLine = BS.getLine
142    -- getContents = BS.getContents
143    -- putStr = BS.putStr
144    -- putStrLn = BSC.putStrLn
145    -- interact = BS.interact
146    -- readFile = BS.readFile
147    -- writeFile = BS.writeFile
148    -- appendFile = BS.appendFile
149
150instance IsString (UTF8 BS.ByteString) where
151    fromString = UTF8.fromString
152
153instance StringLike (UTF8 BS.ByteString) where
154    toString = UTF8.toString
155
156instance Semigroup (UTF8 BS.ByteString) where
157  (<>) = mappend
158
159instance Monoid (UTF8 BS.ByteString) where
160    mempty = UTF8.fromString []
161    mappend a b = UTF8.fromRep (mappend (UTF8.toRep a) (UTF8.toRep b))
162
163--------------------------------------------------
164-- UTF8 Lazy.ByteString
165
166instance FoldableLL (UTF8 BSL.ByteString) Char where
167    foldl = UTF8.foldl
168    -- foldl' = UTF8.foldl'
169    -- foldl1 = UTF8.foldl1
170    foldr = UTF8.foldr
171    -- foldr' = UTF8.foldr'
172    -- foldr1 = UTF8.foldr1
173
174instance IsList (UTF8 BSL.ByteString) where
175    type Item (UTF8 BSL.ByteString) = Char
176    toList = UTF8.toString
177    fromList = LL.fromList' -- LL.map id
178
179instance ListLike (UTF8 BSL.ByteString) Char where
180    empty = mempty
181    singleton c = UTF8.fromString [c]
182    -- cons = UTF8.cons
183    -- snoc = UTF8.snoc
184    -- append = UTF8.append
185    uncons = UTF8.uncons
186    head = fst . fromMaybe (error "head") . uncons
187    -- last = UTF8.last
188    tail = snd . fromMaybe (error "tail") . uncons
189    -- init = UTF8.init
190    null s = UTF8.length s == 0
191    length = fromInteger . toInteger . UTF8.length
192    -- -- map =
193    -- rigidMap = UTF8.map
194    -- reverse = UTF8.reverse
195    -- intersperse = UTF8.intersperse
196    -- concat = UTF8.concat . toList
197    -- --concatMap =
198    -- rigidConcatMap = UTF8.concatMap
199    -- any = UTF8.any
200    -- all = UTF8.all
201    -- maximum = UTF8.maximum
202    -- minimum = UTF8.minimum
203    -- replicate = UTF8.replicate
204    take = UTF8.take . fromInteger . toInteger
205    drop = UTF8.drop . fromInteger . toInteger
206    splitAt = UTF8.splitAt . fromInteger . toInteger
207    -- takeWhile = UTF8.takeWhile
208    -- dropWhile = UTF8.dropWhile
209    span = UTF8.span
210    break = UTF8.break
211    -- group = fromList . UTF8.group
212    -- inits = fromList . UTF8.inits
213    -- tails = fromList . UTF8.tails
214    -- isPrefixOf = UTF8.isPrefixOf
215    -- isSuffixOf = UTF8.isSuffixOf
216    -- --isInfixOf = UTF8.isInfixOf
217    -- elem = UTF8.elem
218    -- notElem = UTF8.notElem
219    -- find = UTF8.find
220    -- filter = UTF8.filter
221    -- --partition = UTF8.partition
222    -- index = UTF8.index
223    -- elemIndex = UTF8.elemIndex
224    -- elemIndices x = fromList . UTF8.elemIndices x
225    -- findIndex = UTF8.findIndex
226    -- findIndices x = fromList . UTF8.findIndices x
227    -- -- the default definitions don't work well for array-like things, so
228    -- -- do monadic stuff via a list instead
229    -- sequence  = liftM fromList . P.sequence  . toList
230    -- mapM func = liftM fromList . P.mapM func . toList
231    -- --nub = UTF8.nub
232    -- --delete = UTF8.delete
233    -- --deleteFirsts = UTF8.deleteFirsts
234    -- --union = UTF8.union
235    -- --intersect = UTF8.intersect
236    -- sort = UTF8.sort
237    -- --insert = UTF8.insert
238    -- toList = UTF8.toString
239    -- fromList = UTF8.pack
240    -- fromListLike = fromList . toList
241    -- --nubBy = UTF8.nubBy
242    -- --deleteBy = UTF8.deleteBy
243    -- --deleteFirstsBy = UTF8.deleteFirstsBy
244    -- --unionBy = UTF8.unionBy
245    -- --intersectBy = UTF8.intersectBy
246    -- groupBy f = fromList . UTF8.groupBy f
247    -- --sortBy = UTF8.sortBy
248    -- --insertBy = UTF8.insertBy
249    -- genericLength = fromInteger . fromIntegral . UTF8.length
250    -- genericTake i = UTF8.take (fromIntegral i)
251    -- genericDrop i = UTF8.drop (fromIntegral i)
252    -- genericSplitAt i = UTF8.splitAt (fromIntegral i)
253    -- genericReplicate i = UTF8.replicate (fromIntegral i)
254
255instance ListLikeIO (UTF8 BSL.ByteString) Char where
256    hGetLine h = (UTF8.fromRep . BSL.fromStrict) <$> BS.hGetLine h
257    hGetContents h = (UTF8.fromRep) <$> BSL.hGetContents h
258    hGet h n = UTF8.fromRep <$> BSL.hGet h n
259    hGetNonBlocking h n = UTF8.fromRep <$> BSL.hGetNonBlocking h n
260    hPutStr h s = BSL.hPutStr h (UTF8.toRep s)
261    hPutStrLn h s = BSLC.hPutStrLn h (UTF8.toRep s)
262    -- getLine = BSL.getLine
263    -- getContents = BSL.getContents
264    -- putStr = BSL.putStr
265    -- putStrLn = BSLC.putStrLn
266    -- interact = BSL.interact
267    -- readFile = BSL.readFile
268    -- writeFile = BSL.writeFile
269    -- appendFile = BSL.appendFile
270
271instance Semigroup (UTF8 BSL.ByteString) where
272  (<>) = mappend
273
274instance IsString (UTF8 BSL.ByteString) where
275    fromString = UTF8.fromString
276
277instance StringLike (UTF8 BSL.ByteString) where
278    toString = UTF8.toString
279
280instance Monoid (UTF8 BSL.ByteString) where
281    mempty = UTF8.fromString []
282    mappend a b = UTF8.fromRep (mappend (UTF8.toRep a) (UTF8.toRep b))
283
284{-# RULES "fromListLike/a" fromListLike = id :: a -> a #-}
285