diff --git a/ListLike.cabal b/ListLike.cabal --- a/ListLike.cabal +++ b/ListLike.cabal @@ -1,5 +1,5 @@ Name: ListLike -Version: 4.2.1 +Version: 4.4 License: BSD3 Maintainer: John Lato Author: John Goerzen @@ -9,7 +9,7 @@ Category: Generics Cabal-Version: >= 1.8 Build-Type: Simple -homepage: http://software.complete.org/listlike +homepage: http://github.com/JohnLato/listlike synopsis: Generic support for list-like structures Description: Generic support for list-like structures in Haskell. . @@ -22,19 +22,24 @@ ByteString, for types that support input and output, and for types that can handle infinite lists. Stability: Stable +Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 Library + GHC-Options: -O2 Hs-Source-Dirs: src Exposed-Modules: Data.ListLike Data.ListLike.Base + Data.ListLike.Chars Data.ListLike.CharString Data.ListLike.FoldableLL Data.ListLike.IO Data.ListLike.Instances Data.ListLike.String Data.ListLike.Text + Data.ListLike.Text.Builder Data.ListLike.Text.Text Data.ListLike.Text.TextLazy + Data.ListLike.UTF8 Data.ListLike.Utils Data.ListLike.Vector Data.ListLike.Vector.Generic @@ -52,9 +57,12 @@ ,vector >= 0.5 && < 0.12 ,dlist >= 0.7 && < 0.9 ,fmlist >= 0.8 && < 0.10 - + ,utf8-string + ,deepseq + Test-suite listlike-tests - Hs-source-dirs: src testsrc + GHC-Options: -O2 + Hs-source-dirs: testsrc Main-is: runtests.hs Type: exitcode-stdio-1.0 @@ -71,6 +79,7 @@ ,fmlist ,text ,vector + ,utf8-string source-repository head type: git diff --git a/src/Data/ListLike.hs b/src/Data/ListLike.hs --- a/src/Data/ListLike.hs +++ b/src/Data/ListLike.hs @@ -29,7 +29,7 @@ -- * Creation & Basic Functions empty, singleton, - cons, snoc, append, head, last, tail, init, null, length, + cons, snoc, append, uncons, head, last, tail, init, null, length, -- * List transformations map, rigidMap, reverse, intersperse, -- ** Conversions @@ -95,6 +95,7 @@ -- ** ByteStrings -- $notesbytestring + Chars(..), CharString (..), CharStringLazy (..), @@ -118,6 +119,7 @@ splitAt, elem, notElem, unzip, lines, words, unlines, unwords, foldMap) import Data.ListLike.Base +import Data.ListLike.Chars import Data.ListLike.CharString import Data.ListLike.FoldableLL import Data.ListLike.Instances() diff --git a/src/Data/ListLike/Base.hs b/src/Data/ListLike/Base.hs --- a/src/Data/ListLike/Base.hs +++ b/src/Data/ListLike/Base.hs @@ -3,7 +3,8 @@ ,FunctionalDependencies ,FlexibleInstances ,BangPatterns - ,FlexibleContexts #-} + ,FlexibleContexts + ,CPP #-} {- Copyright (C) 2007 John Goerzen @@ -34,7 +35,7 @@ InfiniteListLike(..), zip, zipWith, sequence_ ) where -import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, uncons, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, dropWhileEnd, reverse, zip, zipWith, sequence, @@ -93,7 +94,12 @@ {- | Extracts the first element of a 'ListLike'. -} head :: full -> item + head = maybe (error "head") fst . uncons + {- | Extract head and tail, return Nothing if empty -} + uncons :: full -> Maybe (item, full) + uncons x = if null x then Nothing else Just (head x, tail x) -- please don't + {- | Extracts the last element of a 'ListLike'. -} last :: full -> item last l = case genericLength l of @@ -102,7 +108,8 @@ _ -> last (tail l) {- | Gives all elements after the head. -} - tail :: full -> full + tail :: full -> full + tail = maybe (error "tail") snd . uncons {- | All elements of the list except the last one. See also 'inits'. -} init :: full -> full @@ -419,6 +426,7 @@ Default implementation is @fromListLike = map id@ -} fromListLike :: ListLike full' item => full -> full' fromListLike = map id + {-# INLINE fromListLike #-} ------------------------------ Generalized functions {- | Generic version of 'nub' -} @@ -514,6 +522,13 @@ genericReplicate count x | count <= 0 = empty | otherwise = map (\_ -> x) [1..count] + +#if __GLASGOW_HASKELL__ >= 708 + {-# MINIMAL (singleton, uncons, null) | + (singleton, uncons, genericLength) | + (singleton, head, tail, null) | + (singleton, head, tail, genericLength) #-} +#endif {- instance (ListLike full item) => Monad full where diff --git a/src/Data/ListLike/CharString.hs b/src/Data/ListLike/CharString.hs --- a/src/Data/ListLike/CharString.hs +++ b/src/Data/ListLike/CharString.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses +{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances ,TypeSynonymInstances #-} @@ -133,7 +133,7 @@ --insert = BS.insert toList = BS.unpack . unCS fromList = CS . BS.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList --nubBy = BS.nubBy --deleteBy = BS.deleteBy --deleteFirstsBy = BS.deleteFirstsBy @@ -252,7 +252,7 @@ --insert = BSL.insert toList = BSL.unpack . unCSL fromList = CSL . BSL.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList --nubBy = BSL.nubBy --deleteBy = BSL.deleteBy --deleteFirstsBy = BSL.deleteFirstsBy diff --git a/src/Data/ListLike/Chars.hs b/src/Data/ListLike/Chars.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Chars.hs @@ -0,0 +1,87 @@ +-- | Work in progress. +{-# LANGUAGE CPP + ,MultiParamTypeClasses + ,FlexibleInstances #-} + +module Data.ListLike.Chars + +where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Monoid +#endif +import Control.DeepSeq +import Control.Monad +import Data.String as String (IsString(fromString)) +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.IO as TI +import qualified Data.Text.Lazy.Builder as Builder +import Data.Text.Encoding (decodeUtf8) +import Data.ListLike.Base as LL +import Data.ListLike.FoldableLL as LL +import Data.ListLike.IO +import Data.ListLike.String as LL +import Data.ListLike.Text + +data Chars + = B Builder.Builder + | T T.Text + deriving (Show, Eq, Ord) + +builder :: Chars -> Builder.Builder +builder (B x) = x +builder (T s) = Builder.fromLazyText s +{-# INLINE builder #-} + +instance Monoid Chars where + mempty = B mempty + mappend a b = B $ mappend (builder a) (builder b) + +instance String.IsString Chars where + fromString = B . String.fromString + +instance FoldableLL Chars Char where + foldl f r0 (B b) = LL.foldl f r0 . Builder.toLazyText $ b + foldl f r0 (T s) = LL.foldl f r0 $ s + foldr f r0 (B b) = LL.foldr f r0 . Builder.toLazyText $ b + foldr f r0 (T s) = LL.foldr f r0 $ s + -- + foldl' f r0 (B b) = LL.foldl' f r0 . Builder.toLazyText $ b + foldl' f r0 (T s) = LL.foldl' f r0 $ s + foldl1 f (B b) = LL.foldl1 f . Builder.toLazyText $ b + foldl1 f (T s) = LL.foldl1 f $ s + foldr' f r0 (B b) = LL.foldr' f r0 . Builder.toLazyText $ b + foldr' f r0 (T s) = LL.foldr' f r0 $ s + foldr1 f (B b) = LL.foldr1 f . Builder.toLazyText $ b + foldr1 f (T s) = LL.foldr1 f $ s + +instance ListLike Chars Char where + singleton = B . Builder.singleton + uncons (B b) = + case LL.uncons (Builder.toLazyText b) of + Nothing -> Nothing + Just (c, s) -> Just (c, T s) + uncons (T s) = + case LL.uncons s of + Nothing -> Nothing + Just (c, s') -> Just (c, T s') + null (B b) = LL.null . Builder.toLazyText $ b + null (T t) = LL.null t + +instance ListLikeIO Chars Char where + hGetLine h = T <$> hGetLine h + hGetContents h = T <$> hGetContents h + hGet h n = T <$> hGet h n + hGetNonBlocking h n = T <$> hGetNonBlocking h n + hPutStr h (B b) = hPutStr h . Builder.toLazyText $ b + hPutStr h (T s) = hPutStr h $ s + +instance StringLike Chars where + toString (B b) = toString . Builder.toLazyText $ b + toString (T s) = toString $ s + fromString = B . Builder.fromLazyText . LL.fromString + +instance NFData Chars where + rnf (B b) = rnf . Builder.toLazyText $ b + rnf (T s) = rnf s diff --git a/src/Data/ListLike/IO.hs b/src/Data/ListLike/IO.hs --- a/src/Data/ListLike/IO.hs +++ b/src/Data/ListLike/IO.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses +{-# LANGUAGE MultiParamTypeClasses ,FunctionalDependencies #-} diff --git a/src/Data/ListLike/Instances.hs b/src/Data/ListLike/Instances.hs --- a/src/Data/ListLike/Instances.hs +++ b/src/Data/ListLike/Instances.hs @@ -47,8 +47,10 @@ import Data.ListLike.IO import Data.ListLike.FoldableLL import Data.ListLike.Text () +import Data.ListLike.UTF8 import Data.ListLike.Vector () import Data.Int +import Data.Maybe (fromMaybe) import Data.Monoid import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC @@ -58,6 +60,8 @@ import Data.Array.IArray((!), (//), Ix(..)) import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSLC +import Data.String.UTF8 (UTF8) +import qualified Data.String.UTF8 as UTF8 import qualified System.IO as IO import Data.Word @@ -108,6 +112,7 @@ cons = BS.cons snoc = BS.snoc append = BS.append + uncons = BS.uncons head = BS.head last = BS.last tail = BS.tail @@ -162,7 +167,7 @@ --insert = BS.insert toList = BS.unpack fromList = BS.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList --nubBy = BS.nubBy --deleteBy = BS.deleteBy --deleteFirstsBy = BS.deleteFirstsBy @@ -218,6 +223,7 @@ cons = BSL.cons snoc = BSL.snoc append = BSL.append + uncons = BSL.uncons head = BSL.head last = BSL.last tail = BSL.tail @@ -273,7 +279,7 @@ --insert = BSL.insert toList = BSL.unpack fromList = BSL.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList --nubBy = BSL.nubBy --deleteBy = BSL.deleteBy --deleteFirstsBy = BSL.deleteFirstsBy @@ -547,7 +553,7 @@ --insert = S.insert toList = F.toList fromList = S.fromList - fromListLike = fromList . toList + --fromListLike = fromList . toList --nubBy = --deleteBy = --deleteFirstsBy = diff --git a/src/Data/ListLike/Text.hs b/src/Data/ListLike/Text.hs --- a/src/Data/ListLike/Text.hs +++ b/src/Data/ListLike/Text.hs @@ -5,5 +5,6 @@ where +import Data.ListLike.Text.Builder import Data.ListLike.Text.Text import Data.ListLike.Text.TextLazy diff --git a/src/Data/ListLike/Text/Builder.hs b/src/Data/ListLike/Text/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Text/Builder.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE CPP + ,MultiParamTypeClasses + ,FlexibleInstances #-} + +module Data.ListLike.Text.Builder + +where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif +import Control.DeepSeq (NFData(rnf)) +import qualified Data.Text.Lazy.Builder as Builder +import Data.ListLike.Base as LL +import Data.ListLike.FoldableLL as LL +import Data.ListLike.IO +import Data.ListLike.String as LL +import Data.ListLike.Text.TextLazy () +import Data.String (IsString(fromString)) + +instance FoldableLL Builder.Builder Char where + foldl f r0 = LL.foldl f r0 . Builder.toLazyText + foldr f r0 = LL.foldr f r0 . Builder.toLazyText + +instance ListLike Builder.Builder Char where + singleton = Builder.singleton + uncons b = case LL.uncons (Builder.toLazyText b) of + Nothing -> Nothing + Just (c, s) -> Just (c, Builder.fromLazyText s) + null = LL.null . Builder.toLazyText + +instance ListLikeIO Builder.Builder Char where + hGetLine h = Builder.fromLazyText <$> hGetLine h + hGetContents h = Builder.fromLazyText <$> hGetContents h + hGet h n = Builder.fromLazyText <$> hGet h n + hGetNonBlocking h n = Builder.fromLazyText <$> hGetNonBlocking h n + hPutStr h = hPutStr h . Builder.toLazyText + +instance StringLike Builder.Builder where + toString = toString . Builder.toLazyText + fromString = Builder.fromLazyText . LL.fromString + +instance NFData Builder.Builder where + rnf = rnf . Builder.toLazyText diff --git a/src/Data/ListLike/Text/Text.hs b/src/Data/ListLike/Text/Text.hs --- a/src/Data/ListLike/Text/Text.hs +++ b/src/Data/ListLike/Text/Text.hs @@ -66,7 +66,7 @@ findIndex = T.findIndex toList = T.unpack fromList = T.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList groupBy f = fromList . T.groupBy f genericLength = fromInteger . fromIntegral . T.length genericTake i = T.take (fromIntegral i) diff --git a/src/Data/ListLike/Text/TextLazy.hs b/src/Data/ListLike/Text/TextLazy.hs --- a/src/Data/ListLike/Text/TextLazy.hs +++ b/src/Data/ListLike/Text/TextLazy.hs @@ -64,7 +64,7 @@ index t = T.index t . fromIntegral toList = T.unpack fromList = T.pack - fromListLike = fromList . toList + --fromListLike = fromList . toList groupBy f = fromList . T.groupBy f genericLength = fromInteger . fromIntegral . T.length genericTake i = T.take (fromIntegral i) diff --git a/src/Data/ListLike/UTF8.hs b/src/Data/ListLike/UTF8.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/UTF8.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE CPP + ,MultiParamTypeClasses + ,FlexibleInstances + ,TypeFamilies + ,TypeSynonymInstances + ,UndecidableInstances #-} + +{- | +Instances of 'Data.ListLike.ListLike' and related classes. +Re-exported by "Data.ListLike". +-} + +-------------------------------------------------- +-- UTF8 ByteString + +module Data.ListLike.UTF8 () where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy.Char8 as BSLC +import Control.DeepSeq (NFData(rnf)) +import Data.ListLike.Base +import Data.ListLike.FoldableLL +import Data.ListLike.IO +import Data.ListLike.String (StringLike(..)) +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid(..)) +import Data.String (IsString(fromString)) +import Data.String.UTF8 (UTF8, UTF8Bytes) +import qualified Data.String.UTF8 as UTF8 +import GHC.Generics + +utf8rnf :: NFData a => UTF8 a -> () +utf8rnf = rnf . UTF8.toRep + +instance UTF8Bytes string index => IsString (UTF8 string) where + fromString = UTF8.fromString + +instance FoldableLL (UTF8 BS.ByteString) Char where + foldl = UTF8.foldl + -- foldl' = UTF8.foldl' + -- foldl1 = UTF8.foldl1 + foldr = UTF8.foldr + -- foldr' = UTF8.foldr' + -- foldr1 = UTF8.foldr1 + +instance ListLike (UTF8 BS.ByteString) Char where + empty = mempty + singleton c = UTF8.fromString [c] + -- cons = UTF8.cons + -- snoc = UTF8.snoc + -- append = UTF8.append + uncons = UTF8.uncons + head = fst . fromMaybe (error "head") . uncons + -- last = UTF8.last + tail = snd . fromMaybe (error "tail") . uncons + -- init = UTF8.init + null s = UTF8.length s == 0 + length = UTF8.length + -- -- map = + -- rigidMap = UTF8.map + -- reverse = UTF8.reverse + -- intersperse = UTF8.intersperse + -- concat = UTF8.concat . toList + -- --concatMap = + -- rigidConcatMap = UTF8.concatMap + -- any = UTF8.any + -- all = UTF8.all + -- maximum = UTF8.maximum + -- minimum = UTF8.minimum + -- replicate = UTF8.replicate + take = UTF8.take + drop = UTF8.drop + splitAt = UTF8.splitAt + -- takeWhile = UTF8.takeWhile + -- dropWhile = UTF8.dropWhile + span = UTF8.span + break = UTF8.break + -- group = fromList . UTF8.group + -- inits = fromList . UTF8.inits + -- tails = fromList . UTF8.tails + -- isPrefixOf = UTF8.isPrefixOf + -- isSuffixOf = UTF8.isSuffixOf + -- --isInfixOf = UTF8.isInfixOf + -- elem = UTF8.elem + -- notElem = UTF8.notElem + -- find = UTF8.find + -- filter = UTF8.filter + -- --partition = UTF8.partition + -- index = UTF8.index + -- elemIndex = UTF8.elemIndex + -- elemIndices x = fromList . UTF8.elemIndices x + -- findIndex = UTF8.findIndex + -- findIndices x = fromList . UTF8.findIndices x + -- -- the default definitions don't work well for array-like things, so + -- -- do monadic stuff via a list instead + -- sequence = liftM fromList . P.sequence . toList + -- mapM func = liftM fromList . P.mapM func . toList + -- --nub = UTF8.nub + -- --delete = UTF8.delete + -- --deleteFirsts = UTF8.deleteFirsts + -- --union = UTF8.union + -- --intersect = UTF8.intersect + -- sort = UTF8.sort + -- --insert = UTF8.insert + toList = UTF8.toString + -- fromList = UTF8.pack + -- fromListLike = fromList . toList + -- --nubBy = UTF8.nubBy + -- --deleteBy = UTF8.deleteBy + -- --deleteFirstsBy = UTF8.deleteFirstsBy + -- --unionBy = UTF8.unionBy + -- --intersectBy = UTF8.intersectBy + -- groupBy f = fromList . UTF8.groupBy f + -- --sortBy = UTF8.sortBy + -- --insertBy = UTF8.insertBy + -- genericLength = fromInteger . fromIntegral . UTF8.length + -- genericTake i = UTF8.take (fromIntegral i) + -- genericDrop i = UTF8.drop (fromIntegral i) + -- genericSplitAt i = UTF8.splitAt (fromIntegral i) + -- genericReplicate i = UTF8.replicate (fromIntegral i) + +instance ListLikeIO (UTF8 BS.ByteString) Char where + hGetLine h = UTF8.fromRep <$> BS.hGetLine h + hGetContents h = UTF8.fromRep <$> BS.hGetContents h + hGet h n = UTF8.fromRep <$> BS.hGet h n + hGetNonBlocking h n = UTF8.fromRep <$> BS.hGetNonBlocking h n + hPutStr h s = BS.hPutStr h (UTF8.toRep s) + hPutStrLn h s = BSC.hPutStrLn h (UTF8.toRep s) + -- getLine = BS.getLine + -- getContents = BS.getContents + -- putStr = BS.putStr + -- putStrLn = BSC.putStrLn + -- interact = BS.interact + -- readFile = BS.readFile + -- writeFile = BS.writeFile + -- appendFile = BS.appendFile + +instance StringLike (UTF8 BS.ByteString) where + toString = UTF8.toString + fromString = UTF8.fromString + +instance Monoid (UTF8 BS.ByteString) where + mempty = UTF8.fromString [] + mappend a b = UTF8.fromRep (mappend (UTF8.toRep a) (UTF8.toRep b)) + +-------------------------------------------------- +-- UTF8 Lazy.ByteString + +instance FoldableLL (UTF8 BSL.ByteString) Char where + foldl = UTF8.foldl + -- foldl' = UTF8.foldl' + -- foldl1 = UTF8.foldl1 + foldr = UTF8.foldr + -- foldr' = UTF8.foldr' + -- foldr1 = UTF8.foldr1 + +instance ListLike (UTF8 BSL.ByteString) Char where + empty = mempty + singleton c = UTF8.fromString [c] + -- cons = UTF8.cons + -- snoc = UTF8.snoc + -- append = UTF8.append + uncons = UTF8.uncons + head = fst . fromMaybe (error "head") . uncons + -- last = UTF8.last + tail = snd . fromMaybe (error "tail") . uncons + -- init = UTF8.init + null s = UTF8.length s == 0 + length = fromInteger . toInteger . UTF8.length + -- -- map = + -- rigidMap = UTF8.map + -- reverse = UTF8.reverse + -- intersperse = UTF8.intersperse + -- concat = UTF8.concat . toList + -- --concatMap = + -- rigidConcatMap = UTF8.concatMap + -- any = UTF8.any + -- all = UTF8.all + -- maximum = UTF8.maximum + -- minimum = UTF8.minimum + -- replicate = UTF8.replicate + take = UTF8.take . fromInteger . toInteger + drop = UTF8.drop . fromInteger . toInteger + splitAt = UTF8.splitAt . fromInteger . toInteger + -- takeWhile = UTF8.takeWhile + -- dropWhile = UTF8.dropWhile + span = UTF8.span + break = UTF8.break + -- group = fromList . UTF8.group + -- inits = fromList . UTF8.inits + -- tails = fromList . UTF8.tails + -- isPrefixOf = UTF8.isPrefixOf + -- isSuffixOf = UTF8.isSuffixOf + -- --isInfixOf = UTF8.isInfixOf + -- elem = UTF8.elem + -- notElem = UTF8.notElem + -- find = UTF8.find + -- filter = UTF8.filter + -- --partition = UTF8.partition + -- index = UTF8.index + -- elemIndex = UTF8.elemIndex + -- elemIndices x = fromList . UTF8.elemIndices x + -- findIndex = UTF8.findIndex + -- findIndices x = fromList . UTF8.findIndices x + -- -- the default definitions don't work well for array-like things, so + -- -- do monadic stuff via a list instead + -- sequence = liftM fromList . P.sequence . toList + -- mapM func = liftM fromList . P.mapM func . toList + -- --nub = UTF8.nub + -- --delete = UTF8.delete + -- --deleteFirsts = UTF8.deleteFirsts + -- --union = UTF8.union + -- --intersect = UTF8.intersect + -- sort = UTF8.sort + -- --insert = UTF8.insert + toList = UTF8.toString + -- fromList = UTF8.pack + -- fromListLike = fromList . toList + -- --nubBy = UTF8.nubBy + -- --deleteBy = UTF8.deleteBy + -- --deleteFirstsBy = UTF8.deleteFirstsBy + -- --unionBy = UTF8.unionBy + -- --intersectBy = UTF8.intersectBy + -- groupBy f = fromList . UTF8.groupBy f + -- --sortBy = UTF8.sortBy + -- --insertBy = UTF8.insertBy + -- genericLength = fromInteger . fromIntegral . UTF8.length + -- genericTake i = UTF8.take (fromIntegral i) + -- genericDrop i = UTF8.drop (fromIntegral i) + -- genericSplitAt i = UTF8.splitAt (fromIntegral i) + -- genericReplicate i = UTF8.replicate (fromIntegral i) + +instance ListLikeIO (UTF8 BSL.ByteString) Char where + hGetLine h = (UTF8.fromRep . BSL.fromStrict) <$> BS.hGetLine h + hGetContents h = (UTF8.fromRep) <$> BSL.hGetContents h + hGet h n = UTF8.fromRep <$> BSL.hGet h n + hGetNonBlocking h n = UTF8.fromRep <$> BSL.hGetNonBlocking h n + hPutStr h s = BSL.hPutStr h (UTF8.toRep s) + hPutStrLn h s = BSLC.hPutStrLn h (UTF8.toRep s) + -- getLine = BSL.getLine + -- getContents = BSL.getContents + -- putStr = BSL.putStr + -- putStrLn = BSLC.putStrLn + -- interact = BSL.interact + -- readFile = BSL.readFile + -- writeFile = BSL.writeFile + -- appendFile = BSL.appendFile + +instance StringLike (UTF8 BSL.ByteString) where + toString = UTF8.toString + fromString = UTF8.fromString + +instance Monoid (UTF8 BSL.ByteString) where + mempty = UTF8.fromString [] + mappend a b = UTF8.fromRep (mappend (UTF8.toRep a) (UTF8.toRep b)) + +{-# RULES "fromListLike/a" fromListLike = id :: a -> a #-} diff --git a/src/Data/ListLike/Utils.hs b/src/Data/ListLike/Utils.hs --- a/src/Data/ListLike/Utils.hs +++ b/src/Data/ListLike/Utils.hs @@ -69,9 +69,7 @@ -- | Converts to a MonadPlus instance toMonadPlus :: (MonadPlus m, ListLike full a) => full -> m (a, full) -toMonadPlus c - | null c = mzero - | otherwise = return (head c, tail c) +toMonadPlus = maybe mzero return . uncons -- | List-like destructor (like Data.Maybe.maybe) list :: ListLike full a => b -> (a -> full -> b) -> full -> b diff --git a/src/Data/ListLike/Vector/Generic.hs b/src/Data/ListLike/Vector/Generic.hs --- a/src/Data/ListLike/Vector/Generic.hs +++ b/src/Data/ListLike/Vector/Generic.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE MultiParamTypeClasses +{-# LANGUAGE CPP + ,MultiParamTypeClasses ,FlexibleContexts ,FlexibleInstances - ,OverlappingInstances ,UndecidableInstances #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances #-} +#endif -- | ListLike instance for any type supporting the @Data.Vector.Generic@ -- interface. To avoid collisions with other Vector instances, this module @@ -21,7 +24,7 @@ import Data.Monoid -instance V.Vector v a => FoldableLL (v a) a where +instance {-# OVERLAPPABLE #-} V.Vector v a => FoldableLL (v a) a where foldl = V.foldl foldl' = V.foldl' foldl1 = V.foldl1 @@ -29,7 +32,7 @@ foldr' = V.foldr' foldr1 = V.foldr1 -instance (Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where +instance {-# OVERLAPPABLE #-} (Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where empty = V.empty singleton = V.singleton cons = V.cons @@ -70,7 +73,7 @@ findIndex = V.findIndex toList = V.toList fromList = V.fromList - fromListLike = fromList . toList + --fromListLike = fromList . toList --groupBy f = genericLength = fromInteger . fromIntegral . V.length genericTake i = V.take (fromIntegral i) diff --git a/src/Data/ListLike/Vector/Storable.hs b/src/Data/ListLike/Vector/Storable.hs --- a/src/Data/ListLike/Vector/Storable.hs +++ b/src/Data/ListLike/Vector/Storable.hs @@ -66,7 +66,7 @@ findIndex = V.findIndex toList = V.toList fromList = V.fromList - fromListLike = fromList . toList + --fromListLike = fromList . toList --groupBy f = genericLength = fromInteger . fromIntegral . V.length genericTake i = V.take (fromIntegral i) diff --git a/src/Data/ListLike/Vector/Unboxed.hs b/src/Data/ListLike/Vector/Unboxed.hs --- a/src/Data/ListLike/Vector/Unboxed.hs +++ b/src/Data/ListLike/Vector/Unboxed.hs @@ -65,7 +65,7 @@ findIndex = V.findIndex toList = V.toList fromList = V.fromList - fromListLike = fromList . toList + --fromListLike = fromList . toList --groupBy f = genericLength = fromInteger . fromIntegral . V.length genericTake i = V.take (fromIntegral i) diff --git a/src/Data/ListLike/Vector/Vector.hs b/src/Data/ListLike/Vector/Vector.hs --- a/src/Data/ListLike/Vector/Vector.hs +++ b/src/Data/ListLike/Vector/Vector.hs @@ -64,7 +64,7 @@ findIndex = V.findIndex toList = V.toList fromList = V.fromList - fromListLike = fromList . toList + --fromListLike = fromList . toList --groupBy f = genericLength = fromInteger . fromIntegral . V.length genericTake i = V.take (fromIntegral i) diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs --- a/testsrc/TestInfrastructure.hs +++ b/testsrc/TestInfrastructure.hs @@ -25,6 +25,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ListLike as LL +import qualified Data.ListLike.Chars as Chars import qualified Data.Array as A import qualified Data.DList as DL import qualified Data.FMList as FM @@ -32,6 +33,8 @@ import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.String.UTF8 as UTF8 import qualified Data.Vector as V import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU @@ -74,6 +77,7 @@ instance (CoArbitrary i) => CoArbitrary (FM.FMList i) where coarbitrary l = coarbitrary (LL.toList l) +#if ! MIN_VERSION_QuickCheck(2,8,2) instance (Arbitrary i) => Arbitrary (S.Seq i) where arbitrary = sized (\n -> choose (0, n) >>= myVector) where myVector n = @@ -83,6 +87,7 @@ instance (CoArbitrary i) => CoArbitrary (S.Seq i) where coarbitrary l = coarbitrary (LL.toList l) +#endif instance Arbitrary (BSL.ByteString) where arbitrary = sized (\n -> choose (0, n) >>= myVector) @@ -104,6 +109,16 @@ instance CoArbitrary (BS.ByteString) where coarbitrary l = coarbitrary (LL.toList l) +instance Arbitrary Chars.Chars where + arbitrary = sized (\n -> choose (0, n) >>= myVector) + where myVector n = + do arblist <- vector n + return (LL.fromList arblist) + shrink = map LL.fromList . shrink . LL.toList + +instance CoArbitrary Chars.Chars where + coarbitrary l = coarbitrary (LL.toList l) + instance Arbitrary i => Arbitrary (A.Array Int i) where arbitrary = sized (\n -> choose (0, n) >>= myVector) where myVector n = @@ -134,6 +149,36 @@ instance CoArbitrary (TL.Text) where coarbitrary l = coarbitrary (LL.toList l) +instance Arbitrary (TB.Builder) where + arbitrary = sized (\n -> choose (0, n) >>= myVector) + where myVector n = + do arblist <- vector n + return (LL.fromList arblist) + shrink = map LL.fromList . shrink . LL.toList + +instance CoArbitrary (TB.Builder) where + coarbitrary l = coarbitrary (LL.toList l) + +instance Arbitrary (UTF8.UTF8 BS.ByteString) where + arbitrary = sized (\n -> choose (0, n) >>= myVector) + where myVector n = + do arblist <- vector n + return (LL.fromList arblist) + shrink = map LL.fromList . shrink . LL.toList + +instance CoArbitrary (UTF8.UTF8 BS.ByteString) where + coarbitrary l = coarbitrary (LL.toList l) + +instance Arbitrary (UTF8.UTF8 BSL.ByteString) where + arbitrary = sized (\n -> choose (0, n) >>= myVector) + where myVector n = + do arblist <- vector n + return (LL.fromList arblist) + shrink = map LL.fromList . shrink . LL.toList + +instance CoArbitrary (UTF8.UTF8 BSL.ByteString) where + coarbitrary l = coarbitrary (LL.toList l) + instance Arbitrary i => Arbitrary (V.Vector i) where arbitrary = sized (\n -> choose (0, n) >>= myVector) where myVector n = @@ -183,6 +228,8 @@ instance TestLL BSL.ByteString Word8 where +instance TestLL Chars.Chars Char where + instance (Arbitrary a, Show a, Eq a) => TestLL (S.Seq a) a where instance (Arbitrary a, Show a, Eq a) => TestLL (A.Array Int a) a where @@ -191,6 +238,12 @@ instance TestLL TL.Text Char where +instance TestLL TB.Builder Char where + +instance TestLL (UTF8.UTF8 BS.ByteString) Char where + +instance TestLL (UTF8.UTF8 BSL.ByteString) Char where + instance (Arbitrary a, Show a, Eq a) => TestLL (V.Vector a) a where instance (Arbitrary a, Show a, Eq a, VS.Storable a) => TestLL (VS.Vector a) a where @@ -280,8 +333,8 @@ wwrap "wrap MyList (MyList Int)" (x::LLWrap (MyList (MyList Int)) (MyList Int) Int), wwrap "wrap S.Seq (S.Seq Int)" (x::LLWrap (S.Seq (S.Seq Int)) (S.Seq Int) Int), wwrap "wrap Array (Array Int)" (x::LLWrap (A.Array Int (A.Array Int Int)) (A.Array Int Int) Int), - wwrap "wrap Array [Int]" (x::LLWrap (A.Array Int [Int]) [Int] Int), - wwrap "wrap (Vector (Vector Int))" (x::LLWrap (V.Vector (V.Vector Int)) (V.Vector Int) Int) + wwrap "wrap Array [Int]" (x::LLWrap (A.Array Int [Int]) [Int] Int) + ,wwrap "wrap (Vector (Vector Int))" (x::LLWrap (V.Vector (V.Vector Int)) (V.Vector Int) Int) ] -- | all props, 1 args: full @@ -294,6 +347,7 @@ w "MyList Bool" (x::LLTest (MyList Bool) Bool), w "ByteString" (x::LLTest BS.ByteString Word8), w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8), + w "Chars" (x::LLTest Chars.Chars Char), w "Sequence Int" (x::LLTest (S.Seq Int) Int), w "Sequence Bool" (x::LLTest (S.Seq Bool) Bool), w "Sequence Char" (x::LLTest (S.Seq Char) Char), @@ -309,7 +363,10 @@ w "StorableVector Bool" (x::LLTest (VS.Vector Bool) Bool), w "UnboxVector Bool" (x::LLTest (VU.Vector Bool) Bool), w "Text" (x::LLTest T.Text Char), - w "Text.Lazy" (x::LLTest TL.Text Char) + w "Text.Lazy" (x::LLTest TL.Text Char), + w "Text.Builder" (x::LLTest TB.Builder Char), + w "UTF8 ByteString" (x::LLTest (UTF8.UTF8 BS.ByteString) Char), + w "UTF8 ByteString.Lazy" (x::LLTest (UTF8.UTF8 BSL.ByteString) Char) ] -- | all props, 1 args: full @@ -322,9 +379,13 @@ -- w "FMList Char" (x::LLTest (FM.FMList Char) Char), w "ByteString" (x::LLTest BS.ByteString Word8), w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8), + w "Chars" (x::LLTest Chars.Chars Char), w "Array Int Char" (x::LLTest (A.Array Int Char) Char), w "Text" (x::LLTest T.Text Char), w "Text.Lazy" (x::LLTest TL.Text Char), - w "Vector Char" (x::LLTest (V.Vector Char) Char), + w "Text.Builder" (x::LLTest TB.Builder Char), + w "UTF8 ByteString" (x::LLTest (UTF8.UTF8 BS.ByteString) Char), + w "UTF8 ByteString.Lazy" (x::LLTest (UTF8.UTF8 BSL.ByteString) Char) + ,w "Vector Char" (x::LLTest (V.Vector Char) Char), w "Vector.Unbox Char" (x::LLTest (VU.Vector Char) Char) ]