ListLike 4.2.1 → 4.7.8.4

raw patch · 27 files changed

Files

• CHANGELOG.md +68/−0
• COPYRIGHT +1/−0
• ListLike.cabal +82/−31
• README.md +8/−15
• src/Data/ListLike.hs +27/−22
• src/Data/ListLike/Base.hs +121/−71
• src/Data/ListLike/CharString.hs +40/−27
• src/Data/ListLike/Chars.hs +99/−0
• src/Data/ListLike/DList.hs +39/−11
• src/Data/ListLike/FMList.hs +16/−11
• src/Data/ListLike/FoldableLL.hs +7/−7
• src/Data/ListLike/IO.hs +6/−6
• src/Data/ListLike/Instances.hs +116/−55
• src/Data/ListLike/String.hs +27/−8
• src/Data/ListLike/Text.hs +4/−6
• src/Data/ListLike/Text/Builder.hs +51/−0
• src/Data/ListLike/Text/Text.hs +12/−7
• src/Data/ListLike/Text/TextLazy.hs +11/−7
• src/Data/ListLike/UTF8.hs +288/−0
• src/Data/ListLike/Utils.hs +13/−8
• src/Data/ListLike/Vector.hs +4/−8
• src/Data/ListLike/Vector/Generic.hs +32/−18
• src/Data/ListLike/Vector/Storable.hs +15/−11
• src/Data/ListLike/Vector/Unboxed.hs +15/−12
• src/Data/ListLike/Vector/Vector.hs +15/−11
• testsrc/TestInfrastructure.hs +97/−32
• testsrc/runtests.hs +68/−40

@@ -0,0 +1,68 @@+CHANGES+=======++#### 4.7.8.4 (2025-08-26)++  - fix build with `-Werror=incomplete-patterns`+  - tested with GHC 8.0 - 9.14 alpha1++#### 4.7.8.3 (2025-03-13)++  - drop support for GHC 7+  - allow `containers-0.8` and up+  - tested with GHC 8.0 - 9.12.1++#### 4.7.8.2 (2023-10-10)++  - pacify GHC 9.8's new `x-partial` warning+  - tested with GHC 7.10 - 9.8++#### 4.7.8.1 (2023-07-12)++  - allow `bytestring-0.12` and fix its deprecation warnings+  - tested with GHC 7.10 - 9.6++### 4.7.8 (2022-11-15)++  - change default `insertBy` implementation to work better with dlists+    ([#18](https://github.com/ddssff/listlike/pull/18))+  - allow `vector-0.13`+  - tested with GHC 7.10 - 9.4++### 4.7.7 (2022-05-26)++  - methods `sequence` and `mapM`: relax `Monad` constraint to `Applicative`+  - `LANGUAGE TypeOperators` to fix GHC 9.4 warning+  - allow `text-2.0`+  - tested with GHC 7.10 - 9.4++### 4.7.6 (2021-09-01)++  - new implementation of `tail` in `DList` instance+  - warning-free for `-Wall` and `-Wcompat`++### 4.7.4 (2021-01-07)++  - support utf8-string-1.0.2 ([#10](https://github.com/ddssff/listlike/issues/10))++### 4.7.3 (2020-12-31)++  - support bytestring-0.10.12 ([#7](https://github.com/ddssff/listlike/pull/7)) for ghc 8.10.3+  - removed support for ghc 7.6 and 7.8 ([#6](https://github.com/ddssff/listlike/issues/6))++### 4.7.2 (2020-08-21)++  - support dlist-1.0 ([#4](https://github.com/ddssff/listlike/issues/4))++### 4.7.1 (2020-07-03)++  - support QuickCheck-2.14++## 4.7++  - make `GHC.Exts.IsList` a superclass of `ListLike` and use its `fromList` and `toList` methods+  - make `Data.String.IsString` a superclass of `Stringlike` and use its `fromString` method+  - add methods to `StringLike`: `show`, `fromText`, `fromLazyText`+  - add a class `ListOps`, alternative to `ListLike`, that uses the `GHC.Exts.Item` instead of+    the `item` type parameter+  - supply `instance IsString Seq` for old versions of container

@@ -1,4 +1,5 @@ Copyright (c) 2007-2010 John Goerzon and John Lato.
+Copyright (c) 2018 David Fox
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,17 +1,17 @@+Cabal-Version: 1.18 Name: ListLike-Version: 4.2.1+Version: 4.7.8.4+ License: BSD3-Maintainer: John Lato <jwlato@gmail.com>+Maintainer: David Fox <dsf@seereason.com>, Andreas Abel Author: John Goerzen Copyright: Copyright (c) 2007-2008 John Goerzen license-file: COPYRIGHT-extra-source-files: COPYRIGHT, README.md-Category: Generics-Cabal-Version: >= 1.8+Category: list, string, text, bytestring, vector Build-Type: Simple-homepage: http://software.complete.org/listlike-synopsis: Generic support for list-like structures-Description: Generic support for list-like structures in Haskell.+homepage: http://github.com/ddssff/listlike+synopsis: Generalized support for list-like structures+Description: Generalized support for list-like structures in Haskell.  .  The ListLike module provides a common interface to the various Haskell  types that are list-like.  Predefined interfaces include standard@@ -23,18 +23,42 @@  infinite lists. Stability: Stable +Tested-With:+  GHC == 9.14.1+  GHC == 9.12.2+  GHC == 9.10.2+  GHC == 9.8.4+  GHC == 9.6.7+  GHC == 9.4.8+  GHC == 9.2.8+  GHC == 9.0.2+  GHC == 8.10.7+  GHC == 8.8.4+  GHC == 8.6.5+  GHC == 8.4.4+  GHC == 8.2.2+  GHC == 8.0.2++extra-doc-files:+  README.md+  CHANGELOG.md+ Library+  default-language: Haskell2010   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@@ -44,34 +68,61 @@           Data.ListLike.DList           Data.ListLike.FMList   -- Other-Modules: Data.ConfigFile.Lexer-  Build-Depends: base       >= 4.6   && < 5-                ,containers >= 0.3   && < 0.6-                ,bytestring >= 0.9.1 && < 0.11-                ,array      >= 0.3   && < 0.6-                ,text       >= 0.11  && < 1.3-                ,vector     >= 0.5   && < 0.12-                ,dlist      >= 0.7   && < 0.9-                ,fmlist     >= 0.8   && < 0.10-  +  Build-Depends:+      base        >= 4.9      && < 5+    , containers  >= 0.5.7    && < 1+    , bytestring  >= 0.10.8   && < 0.13+    , array       >= 0.5      && < 0.6+    , text        >= 1.2      && < 1.3  || >= 2.0 && < 2.2+    , vector      >= 0.12     && < 0.14+    , dlist       >= 0.8      && < 1.1+    , fmlist      >= 0.9      && < 0.10+    , utf8-string >= 1.0      && < 1.1+    , deepseq++  -- Remark: Atm, we don't comply with the Haskell Package Versioning Policy+  --   https://pvp.haskell.org/+  -- > §6. Client defines orphan instance.+  -- > If a package defines an orphan instance, it MUST depend on the+  -- > minor version of the packages that define the data type and the+  -- > type class to be backwards compatible. For example,+  -- > build-depends: mypkg >= 2.1.1 && < 2.1.2.+  --+  -- Since ListLike defines orphan instances, we would need to include+  -- the minor version number in the upper bounds.+  -- (See issues #7 and #10.)+  -- However, this could involve a maintenance marathon to relax upper bounds.++  If !impl(ghc >= 8.4)+    Build-Depends: semigroups >= 0.16 && < 0.20++  ghc-options:+    -Wall+    -Wcompat+ Test-suite listlike-tests-  Hs-source-dirs: src testsrc+  default-language: Haskell2010+  Hs-source-dirs: testsrc   Main-is:        runtests.hs   Type:           exitcode-stdio-1.0    Other-modules:  TestInfrastructure-  Build-depends:   base-                  ,ListLike-                  ,HUnit      >= 1.2 && < 2-                  ,QuickCheck >= 2.4 && < 3-                  ,random     >= 1   && < 2-                  ,array-                  ,bytestring-                  ,containers-                  ,dlist-                  ,fmlist-                  ,text-                  ,vector+  Build-depends:+      base+    , ListLike+    , HUnit      >= 1.5 && < 2+    , QuickCheck >= 2.9 && < 3+    , array+    , bytestring+    , containers+    , dlist+    , fmlist+    , text+    , vector+    , utf8-string+  If !impl(ghc >= 8.4)+    Build-Depends: semigroups >= 0.16 && < 0.20  source-repository head   type:     git-  location: git://github.com/JohnLato/listlike.git+  location: https://github.com/ddssff/listlike.git

@@ -1,20 +1,13 @@-[![Build Status](https://secure.travis-ci.org/JohnLato/listlike.png?branch=master)](http://travis-ci.org/JohnLato/listlike)+[![Build Status](https://github.com/ddssff/listlike/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/ddssff/listlike/actions/workflows/haskell-ci.yml)+[![Hackage](https://img.shields.io/hackage/v/ListLike.svg)](https://hackage.haskell.org/package/ListLike)+[![Stackage Nightly](http://stackage.org/package/ListLike/badge/nightly)](http://stackage.org/nightly/package/ListLike)+[![Stackage LTS](http://stackage.org/package/ListLike/badge/lts)](http://stackage.org/lts/package/ListLike)  ListLike ======== -The `ListLike` package provides typeclasses and instances to allow-polymorphism over many common datatypes.--Installation---------------The package can be built/installed with Cabal.  If you have `cabal-install`,-simply run `cabal install ListLike` to install the package.  Without-`cabal-install`, execute the following commands:+The `ListLike` package provides typeclasses and instances that+polymorphically generalize list operations to many list-like types+such as vectors, text, bytestrings, or difference lists. -```-$ runghc Setup.hs configure-$ runghc Setup.hs build-$ runghc Setup.hs install-```+Read the [introduction](https://hackage.haskell.org/package/ListLike/docs/Data-ListLike.html).

@@ -12,8 +12,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Goerzen <jgoerzen@complete.org>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Generic operations over list-like structures@@ -23,13 +23,13 @@ Please start with the introduction at "Data.ListLike#intro". -} -module Data.ListLike +module Data.ListLike                 (-- * Introduction                  -- $intro-                 +                  -- * Creation & Basic Functions-                 empty, singleton, -                 cons, snoc, append, head, last, tail, init, null, length,+                 empty, singleton,+                 cons, snoc, append, uncons, head, last, tail, init, null, length,                  -- * List transformations                  map, rigidMap, reverse, intersperse,                  -- ** Conversions@@ -52,9 +52,11 @@                  -- * Sublists                  -- ** Extracting sublists                  take, drop, splitAt, takeWhile, dropWhile, dropWhileEnd, span, break,-                 group, inits, tails, +                 group, inits, tails,                  -- ** Predicates                  isPrefixOf, isSuffixOf, isInfixOf,+                 -- ** Modify based on predicate+                 stripPrefix, stripSuffix,                  -- * Searching lists                  -- ** Searching by equality                  elem, notElem,@@ -70,7 +72,8 @@                  ListLikeIO(..),                  -- * Special lists                  -- ** Strings-                 toString, fromString, lines, words,+                 toString, fromString, lines, words, show,+                 fromStringLike, fromText, fromLazyText,                  -- ** \"Set\" operations                  nub, delete, deleteFirsts, union, intersect,                  -- ** Ordered lists@@ -95,12 +98,13 @@                   -- ** ByteStrings                  -- $notesbytestring+                 Chars(..),                  CharString (..),                  CharStringLazy (..),                   -- * Base Typeclasses                  -- ** The ListLike class-                 ListLike,+                 ListLike, ListOps,                  -- ** The FoldableLL class                  FoldableLL,                  -- ** The StringLike class@@ -109,20 +113,21 @@                  InfiniteListLike                 )        where-import Prelude hiding (length, 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,-                       sequence_, mapM, mapM_, concatMap, and, or, sum,-                       product, repeat, replicate, cycle, take, drop,-                       splitAt, elem, notElem, unzip, lines, words,-                       unlines, unwords, foldMap)+import Prelude hiding (Foldable(..), head, last, tail, map, filter, concat,+                       any, lookup, init, all,+                       iterate, span, break, takeWhile,+                       dropWhile, {-dropWhileEnd,-} reverse, zip, zipWith, sequence,+                       sequence_, mapM, mapM_, concatMap, and, or,+                       repeat, replicate, cycle, take, drop,+                       splitAt, notElem, unzip, lines, words,+                       unlines, unwords, show) import Data.ListLike.Base+import Data.ListLike.Chars import Data.ListLike.CharString import Data.ListLike.FoldableLL-import Data.ListLike.Instances()-import Data.ListLike.DList-import Data.ListLike.FMList+import Data.ListLike.Instances ()+import Data.ListLike.DList ()+import Data.ListLike.FMList () import Data.ListLike.String import Data.ListLike.Utils import Data.ListLike.IO@@ -159,7 +164,7 @@ In most cases, functions here can act as drop-in replacements for their list-specific counterparts.  They will use the same underlying implementations for lists, so there should be no performance difference.-    + You can make your own types instances of 'ListLike' as well.  For more details, see the notes for the 'ListLike' typeclass. -}@@ -222,7 +227,7 @@ * 'map' uses the 'ListLike' implementation.  'rigidMap' is more efficient.   The same goes for 'concatMap' vs. 'rigidConcatMap'. -* 'isInfixOf', 'sequence', 'mapM' and similar monad operations, 'insert', +* 'isInfixOf', 'sequence', 'mapM' and similar monad operations, 'insert',   'union', 'intersect', 'sortBy', and similar functions are not implemented   in 'ByteStream' and use a naive default implementation. 

@@ -1,9 +1,13 @@ {-# LANGUAGE ScopedTypeVariables+            ,TypeFamilies             ,MultiParamTypeClasses             ,FunctionalDependencies             ,FlexibleInstances             ,BangPatterns-            ,FlexibleContexts #-}+            ,FlexibleContexts+            ,ConstraintKinds+            ,CPP #-}+{-# LANGUAGE TypeOperators #-}  -- for GHC >= 9.4  {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>@@ -19,8 +23,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Generic operations over list-like structures@@ -28,25 +32,32 @@ Written by John Goerzen, jgoerzen\@complete.org -} -module Data.ListLike.Base +module Data.ListLike.Base     (-    ListLike(..),+    ListLike(..), ListOps,+    toList, fromList,     InfiniteListLike(..),     zip, zipWith, sequence_     ) where-import Prelude hiding (length, 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,-                       sequence_, mapM, mapM_, concatMap, and, or, sum,-                       product, repeat, replicate, cycle, take, drop,-                       splitAt, elem, notElem, unzip, lines, words,-                       unlines, unwords, foldMap)++import Prelude+  ( Applicative(..), Bool(..), Eq(..), Int, Integer, Integral+  , Maybe(..), Monad, Monoid(..), Num(..), Ord(..), Ordering(..)+  , ($), (.), (&&), (||), (++), asTypeOf, error, flip, fst, snd+  , id, maybe, max, min, not, otherwise+  , sequenceA+  )+#if MIN_VERSION_base(4,17,0)+import Data.Type.Equality -- GHC 9.4: type equality ~ is just an operator now+#endif+ import qualified Data.List as L import Data.ListLike.FoldableLL-import qualified Control.Monad as M-import Data.Monoid-import Data.Maybe+    ( FoldableLL(foldr, foldr1, foldl), fold, foldMap, sequence_ )+import qualified Control.Applicative as A+import Data.Monoid ( All(All, getAll), Any(Any, getAny) )+import Data.Maybe ( listToMaybe )+import GHC.Exts (IsList(Item, fromList, {-fromListN,-} toList))  {- | The class implementing list-like functions. @@ -66,7 +77,7 @@  * null or genericLength -}-class (FoldableLL full item, Monoid full) =>+class (IsList full, item ~ Item full, FoldableLL full item, Monoid full) =>     ListLike full item | full -> item where      ------------------------------ Creation@@ -88,12 +99,17 @@     snoc l item = append l (singleton item)      {- | Combines two lists.  Like (++). -}-    append :: full -> full -> full +    append :: full -> full -> full     append = mappend      {- | 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 +118,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@@ -127,7 +144,7 @@          as fast, if not faster, than this function and is recommended          if it will work for your purposes.  See also 'mapM'. -}     map :: ListLike full' item' => (item -> item') -> full -> full'-    map func inp  +    map func inp         | null inp = empty         | otherwise = cons (func (head inp)) (map func (tail inp)) @@ -139,7 +156,7 @@     rigidMap = map      {- | Reverse the elements in a list. -}-    reverse :: full -> full +    reverse :: full -> full     reverse l = rev l empty         where rev rl a                 | null rl = a@@ -158,7 +175,7 @@      ------------------------------ Special folds     {- | Flatten the structure. -}-    concat :: (ListLike full' full, Monoid full) => full' -> full+    concat :: (ListLike full' full{-, Monoid full-}) => full' -> full     concat = fold      {- | Map a function over the items and concatenate the results.@@ -210,7 +227,7 @@      {- | Returns all elements at start of list that satisfy the function. -}     takeWhile :: (item -> Bool) -> full -> full-    takeWhile func l +    takeWhile func l         | null l = empty         | func x = cons x (takeWhile func (tail l))         | otherwise = empty@@ -233,7 +250,7 @@     span :: (item -> Bool) -> full -> (full, full)     span func l         | null l = (empty, empty)-        | func x = (cons x ys, zs) +        | func x = (cons x ys, zs)         | otherwise = (empty, l)        where (ys, zs) = span func (tail l)              x = head l@@ -268,7 +285,7 @@     isPrefixOf needle haystack         | null needle = True         | null haystack = False-        | otherwise = (head needle) == (head haystack) && +        | otherwise = (head needle) == (head haystack) &&                       isPrefixOf (tail needle) (tail haystack)      {- | True when the first list is at the beginning of the second. -}@@ -277,10 +294,23 @@      {- | True when the first list is wholly containted within the second -}     isInfixOf :: Eq item => full -> full -> Bool-    isInfixOf needle haystack = +    isInfixOf needle haystack =         any (isPrefixOf needle) thetails         where thetails = asTypeOf (tails haystack) [haystack] +    ------------------------------ Conditionally modify based on predicates+    {- | Remove a prefix from a listlike if possible -}+    stripPrefix :: Eq item => full -> full -> Maybe full+    stripPrefix xs ys = if xs `isPrefixOf` ys+                            then Just $ drop (length xs) ys+                            else Nothing++    {- | Remove a suffix from a listlike if possible -}+    stripSuffix :: Eq item => full -> full -> Maybe full+    stripSuffix xs ys = if xs `isSuffixOf` ys+                            then Just $ take (length ys - length xs) ys+                            else Nothing+     ------------------------------ Searching     {- | True if the item occurs in the list -}     elem :: Eq item => item -> full -> Bool@@ -298,8 +328,8 @@                     Just x -> Just (index l x)      {- | Returns only the elements that satisfy the function. -}-    filter :: (item -> Bool) -> full -> full -    filter func l +    filter :: (item -> Bool) -> full -> full+    filter func l         | null l = empty         | func (head l) = cons (head l) (filter func (tail l))         | otherwise = filter func (tail l)@@ -313,7 +343,7 @@     {- | The element at 0-based index i.  Raises an exception if i is out          of bounds.  Like (!!) for lists. -}     index :: full -> Int -> item-    index l i +    index l i         | null l = error "index: index not found"         | i < 0 = error "index: index must be >= 0"         | i == 0 = head l@@ -323,7 +353,7 @@     elemIndex :: Eq item => item -> full -> Maybe Int     elemIndex e l = findIndex (== e) l -    {- | Returns the indices of the matching elements.  See also +    {- | Returns the indices of the matching elements.  See also        'findIndices' -}     elemIndices :: (Eq item, ListLike result Int) => item -> full -> result     elemIndices i l = findIndices (== i) l@@ -340,18 +370,14 @@      ------------------------------ Monadic operations     {- | Evaluate each action in the sequence and collect the results -}-    sequence :: (Monad m, ListLike fullinp (m item)) =>+    sequence :: (Applicative m, ListLike fullinp (m item)) =>                 fullinp -> m full-    sequence l = foldr func (return empty) l-        where func litem results = -                do x <- litem-                   xs <- results-                   return (cons x xs)+    sequence = foldr (A.liftA2 cons) (pure empty) -    {- | A map in monad space.  Same as @'sequence' . 'map'@ -         +    {- | A map in monad space.  Same as @'sequence' . 'map'@+          See also 'rigidMapM' -}-    mapM :: (Monad m, ListLike full' item') => +    mapM :: (Applicative m, ListLike full' item') =>             (item -> m item') -> full -> m full'     mapM func l = sequence mapresult             where mapresult = asTypeOf (map func l) []@@ -396,40 +422,51 @@     sort = sortBy compare      {- | Inserts the element at the last place where it is still less than or-         equal to the next element.  On data types that do not preserve +         equal to the next element.  On data types that do not preserve          ordering, or enforce their own ordering, the result may not          be what you expect.  On types such as maps, this may result in          changing an existing item.  See also 'insertBy'. -}-    insert :: Ord item => item -> full -> full +    insert :: Ord item => item -> full -> full     insert = insertBy compare      ------------------------------ Conversions      {- | Converts the structure to a list.  This is logically equivolent-         to 'fromListLike', but may have a more optimized implementation. -}-    toList :: full -> [item]-    toList = fromListLike+         to 'fromListLike', but may have a more optimized implementation.+         These two functions are now retired in favor of the methods of+         IsList, but they are retained here because some instances still+         use this implementation. -}+    toList' :: full -> [item]+    toList' = fromListLike      {- | Generates the structure from a list. -}-    fromList :: [item] -> full -    fromList [] = empty-    fromList (x:xs) = cons x (fromList xs)+    fromList' :: [item] -> full+    fromList' [] = empty+    fromList' (x:xs) = cons x (fromList xs) -    {- | Converts one ListLike to another.  See also 'toList'.+    {- | Converts one ListLike to another.  See also 'toList''.          Default implementation is @fromListLike = map id@ -}     fromListLike :: ListLike full' item => full -> full'     fromListLike = map id+    {-# INLINE fromListLike #-}      ------------------------------ Generalized functions     {- | Generic version of 'nub' -}+    -- This code is adapted from Data.List in base.     nubBy :: (item -> item -> Bool) -> full -> full-    nubBy f l = nubBy' l (empty :: full)-     where-      nubBy' ys xs-        | null ys              = empty-        | any (f (head ys)) xs = nubBy' (tail ys) xs-        | otherwise            = let y = head ys-                                 in  cons y (nubBy' (tail ys) (cons y xs))+    nubBy eq l = nubBy' l mempty+      where+        nubBy' ys xs =+          case uncons ys of+            Nothing -> mempty+            Just (y, ys')+              | elem_by y xs -> nubBy' ys' xs+              | otherwise -> cons y (nubBy' ys' (cons y xs))+        elem_by :: item -> full -> Bool+        elem_by y xs =+          case uncons xs of+            Nothing -> False+            Just (x, xs') -> x `eq` y || elem_by y xs' {-     nubBy f l         | null l = empty@@ -460,7 +497,7 @@     intersectBy func xs ys = filter (\x -> any (func x) ys) xs      {- | Generic version of 'group'. -}-    groupBy :: (ListLike full' full, Eq item) => +    groupBy :: (ListLike full' full, Eq item) =>                 (item -> item -> Bool) -> full -> full'     groupBy eq l         | null l = empty@@ -470,16 +507,17 @@                             xs = tail l      {- | Sort function taking a custom comparison function -}-    sortBy :: (item -> item -> Ordering) -> full -> full +    sortBy :: (item -> item -> Ordering) -> full -> full     sortBy cmp = foldr (insertBy cmp) empty      {- | Like 'insert', but with a custom comparison function -}     insertBy :: (item -> item -> Ordering) -> item ->-                full -> full -    insertBy cmp x ys-        | null ys = singleton x-        | otherwise = case cmp x (head ys) of-                        GT -> cons (head ys) (insertBy cmp x (tail ys))+                full -> full+    insertBy cmp x ys =+        case uncons ys of+            Nothing -> singleton x+            Just (ys_head,ys_tail) -> case cmp x ys_head of+                        GT -> cons ys_head (insertBy cmp x ys_tail)                         _ ->  cons x ys      ------------------------------ Generic Operations@@ -500,7 +538,7 @@      {- | Generic version of 'drop' -}     genericDrop :: Integral a => a -> full -> full-    genericDrop n l +    genericDrop n l         | n <= 0 = l         | null l = l         | otherwise = genericDrop (n - 1) (tail l)@@ -511,10 +549,21 @@      {- | Generic version of 'replicate' -}     genericReplicate :: Integral a => a -> item -> full-    genericReplicate count x +    genericReplicate count x         | count <= 0 = empty         | otherwise = map (\_ -> x) [1..count] ++    {-# MINIMAL (singleton, uncons, null) |+                (singleton, uncons, genericLength) |+                (singleton, head, tail, null) |+                (singleton, head, tail, genericLength) #-}+++-- | A version of 'ListLike' with a single type parameter, the item+-- type is obtained using the 'Item' type function from 'IsList'.+type ListOps full = (ListLike full (Item full))+ {- instance (ListLike full item) => Monad full where     m >>= k = foldr (append . k) empty m@@ -543,7 +592,7 @@      {- | Converts a finite list into a circular one -}     cycle :: full -> full-    cycle xs +    cycle xs         | null xs = error "ListLike.cycle: empty list"         | otherwise = xs' where xs' = append xs xs' @@ -556,9 +605,11 @@     cons x l = x : l     snoc l x = l ++ [x]     append = (++)-    head = L.head+    -- Andreas Abel, 2023-10-10, issue #32:+    -- Use implementation of 'head' and 'tail' in terms of 'uncons' to avoid the x-partial warning under GHC 9.8+    uncons []       = Nothing+    uncons (x : xs) = Just (x, xs)     last = L.last-    tail = L.tail     init = L.init     null = L.null     length = L.length@@ -566,8 +617,6 @@     rigidMap = L.map     reverse = L.reverse     intersperse = L.intersperse-    toList = id-    fromList = id     -- fromListLike = toList     concat = L.concat . toList     -- concatMap func = fromList . L.concatMap func@@ -592,6 +641,7 @@     isPrefixOf = L.isPrefixOf     isSuffixOf = L.isSuffixOf     isInfixOf = L.isInfixOf+    stripPrefix = L.stripPrefix     elem = L.elem     notElem = L.notElem     find = L.find@@ -601,7 +651,7 @@     elemIndex = L.elemIndex     elemIndices item = fromList . L.elemIndices item     findIndex = L.findIndex-    sequence = M.sequence . toList+    sequence = sequenceA . toList     -- mapM = M.mapM     nub = L.nub     delete = L.delete@@ -626,7 +676,7 @@           ListLike fullb itemb,           ListLike result (item, itemb)) =>           full -> fullb -> result-zip = zipWith (\a b -> (a, b))+zip = zipWith (,)  {- | Takes two lists and combines them with a custom combining function -} zipWith :: (ListLike full item,

@@ -1,6 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses            +{-# LANGUAGE CPP+            ,MultiParamTypeClasses             ,FlexibleInstances-            ,TypeSynonymInstances #-}+            ,TypeFamilies+            ,TypeSynonymInstances+            ,GeneralizedNewtypeDeriving #-}   {-@@ -17,8 +20,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Newtype wrapper for ByteString to enable a Char-based interface@@ -34,7 +37,7 @@  where -import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat,                        any, lookup, init, all, foldl, foldr, foldl1, foldr1,                        maximum, minimum, iterate, span, break, takeWhile,                        dropWhile, reverse, zip, zipWith, sequence,@@ -42,18 +45,22 @@                        product, repeat, replicate, cycle, take, drop,                        splitAt, elem, notElem, unzip, lines, words,                        unlines, unwords)-import qualified Data.Foldable as F+--import qualified Data.Foldable as F import           Data.ListLike.Base import           Data.ListLike.String import           Data.ListLike.IO import           Data.ListLike.FoldableLL import           Data.Int-import           Data.Monoid+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup (Semigroup(..))+#endif+import           Data.String (IsString(..)) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified System.IO as IO-import           Data.Word+--import qualified System.IO as IO+--import           Data.Word import           Control.Arrow+import           GHC.Exts (IsList(..))  -------------------------------------------------- -- ByteString@@ -61,11 +68,7 @@ -- | Newtype wrapper around Data.ByteString.Char8.ByteString, --   this allows for ListLike instances with Char elements. newtype CharString = CS { unCS :: BS.ByteString }-  deriving (Read, Show, Eq, Ord)--instance Monoid CharString where-  mempty = CS mempty-  mappend l r = CS $ mappend (unCS l) (unCS r)+  deriving (Read, Show, Eq, Ord, Semigroup, Monoid)  instance FoldableLL CharString Char where     foldl f i0  ls = BS.foldl f i0 (unCS ls)@@ -74,6 +77,11 @@     foldr f i0  ls = BS.foldr f i0 (unCS ls)     foldr1 f    ls = BS.foldr1 f (unCS ls) +instance IsList CharString where+  type Item CharString = Char+  toList = BS.unpack . unCS+  fromList = CS . BS.pack+ instance ListLike CharString Char where     empty = CS BS.empty     singleton = CS . BS.singleton@@ -131,9 +139,9 @@     --intersect = BS.intersect     --sort = BS.sort     --insert = BS.insert-    toList = BS.unpack . unCS-    fromList = CS . BS.pack-    fromListLike = fromList . toList+    --toList = BS.unpack . unCS+    --fromList = CS . BS.pack+    --fromListLike = fromList . toList     --nubBy = BS.nubBy     --deleteBy = BS.deleteBy     --deleteFirstsBy = BS.deleteFirstsBy@@ -166,9 +174,11 @@     writeFile fp = BS.writeFile fp . unCS     appendFile fp = BS.appendFile fp . unCS +instance IsString CharString where+    fromString = CS . BS.pack+ instance StringLike CharString where     toString = BS.unpack . unCS-    fromString = CS . BS.pack  -------------------------------------------------- -- ByteString.Lazy@@ -176,11 +186,7 @@ -- | Newtype wrapper around Data.ByteString.Lazy.Char8.ByteString, --   this allows for ListLike instances with Char elements. newtype CharStringLazy = CSL { unCSL :: BSL.ByteString }-  deriving (Read, Show, Eq, Ord)--instance Monoid CharStringLazy where-  mempty = CSL mempty-  mappend l r = CSL $ mappend (unCSL l) (unCSL r)+  deriving (Read, Show, Eq, Ord, Semigroup, Monoid)  instance FoldableLL CharStringLazy Char where     foldl f i0  ls = BSL.foldl f i0 (unCSL ls)@@ -193,6 +199,11 @@ mi64toi Nothing = Nothing mi64toi (Just x) = Just (fromIntegral x) +instance IsList CharStringLazy where+  type Item CharStringLazy = Char+  toList = BSL.unpack . unCSL+  fromList = CSL . BSL.pack+ instance ListLike CharStringLazy Char where     empty = CSL BSL.empty     singleton = CSL . BSL.singleton@@ -250,9 +261,9 @@     --intersect = BSL.intersect     --sort = BSL.sort     --insert = BSL.insert-    toList = BSL.unpack . unCSL-    fromList = CSL . BSL.pack-    fromListLike = fromList . toList+    --toList = BSL.unpack . unCSL+    --fromList = CSL . BSL.pack+    --fromListLike = fromList . toList     --nubBy = BSL.nubBy     --deleteBy = BSL.deleteBy     --deleteFirstsBy = BSL.deleteFirstsBy@@ -288,6 +299,8 @@     writeFile fp = BSL.writeFile fp . unCSL     appendFile fp = BSL.appendFile fp . unCSL +instance IsString CharStringLazy where+    fromString = CSL . BSL.pack+ instance StringLike CharStringLazy where     toString = BSL.unpack . unCSL-    fromString = CSL . BSL.pack

@@ -0,0 +1,99 @@+{-# LANGUAGE CPP+            ,MultiParamTypeClasses+            ,TypeFamilies+            ,FlexibleInstances #-}++module Data.ListLike.Chars++where++import           Control.DeepSeq+--import           Control.Monad+import           Data.String as String (IsString)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+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 ()+import           GHC.Exts (IsList(..))++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 Semigroup Chars where+  a <> b = B $ builder a <> builder b++instance Monoid Chars where+  mempty  = B mempty+  mappend = (<>)++instance String.IsString Chars where+  -- Builder already has an IsString instance, do we want to use it?+  -- fromString = B . String.fromString+  -- or do we want the implementation that used to be in the StringLike instance?+  fromString = B . Builder.fromLazyText . LL.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 IsList Chars where+    type Item Chars = Char+    toList = LL.toList'+    fromList = LL.fromList'++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+    fromLazyText = B . Builder.fromLazyText+    fromText = B . Builder.fromText++instance NFData Chars where+    rnf (B b) = rnf . Builder.toLazyText $ b+    rnf (T s) = rnf s

@@ -1,22 +1,29 @@ {-# LANGUAGE NoImplicitPrelude, MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}+{-# LANGUAGE CPP #-}+ -- | 'Data.ListLike.ListLike' instances for 'Data.DList.DList'+ module Data.ListLike.DList () where-import qualified Prelude as P++import qualified Prelude+ import Data.ListLike.Base import Data.ListLike.FoldableLL-import Data.ListLike.IO import Data.ListLike.String-import Data.DList (DList(..))+#if MIN_VERSION_dlist(1,0,0)+import Data.DList.Unsafe (DList(UnsafeDList), unsafeApplyDList)+#else+import Data.DList (DList)+#endif import qualified Data.DList as D-import Data.Foldable (Foldable) import qualified Data.Foldable as F-import Data.Traversable (Traversable)-import qualified Data.Traversable as T-import Data.String (IsString)+import qualified Data.List as List import qualified Data.String as S import Control.Category-import Data.Char (Char(..))+import Data.Char (Char) + instance FoldableLL (DList a) a where   foldl = F.foldl   foldr = D.foldr@@ -32,16 +39,37 @@   snoc = D.snoc   append = D.append   head = D.head+#if MIN_VERSION_dlist(1,0,0)+  -- Andreas Abel, 2021-09-01, issue #14,+  -- work around https://github.com/spl/dlist/issues/98:+  --+  -- dlist-1.0 changed @tail@ so that it is not an operation+  -- on difference lists anymore, but collapses the difference list+  -- into a plain list.+  --+  -- The following tail function restores the spirit of difference+  -- lists, at the cost of breaking data abstraction, i.e.,+  -- using the constructor and destructor of the newtype DList.+  -- Andreas Abel, 2023-10-10, issue #32:+  -- Use @drop 1@ instead of @tail@ as the latter triggers the x-partial warning in GHC 9.8.+  tail = UnsafeDList . (List.drop 1 .) . unsafeApplyDList+#else   tail = D.tail+#endif   rigidMap = D.map   null = null . D.toList-  toList = D.toList-  fromList = D.fromList+  --toList = D.toList+  --fromList = D.fromList   replicate = D.replicate+  uncons xs = case xs of+    D.Nil -> Prelude.Nothing+    D.Cons d_head l_tail -> Prelude.Just (d_head,fromList l_tail)+    _ -> Prelude.error "Workaround for missing COMPLETE pragma on dlist patterns" + instance StringLike (DList Char) where   toString = D.toList-  fromString = D.fromList+  -- fromString = D.fromList   lines = map D.fromList . S.lines . D.toList   words = map D.fromList . S.words . D.toList   unlines = D.fromList . S.unlines . map D.toList

@@ -1,23 +1,24 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}+{-# OPTIONS -Wno-orphans #-} -- | 'Data.ListLike.ListLike' instances for 'Data.FMList.FMList' module Data.ListLike.FMList () where-import qualified Prelude as P+import Prelude hiding (cycle, map) import Data.ListLike.Base import Data.ListLike.FoldableLL-import Data.ListLike.IO+--import Data.ListLike.IO import Data.ListLike.String import Data.FMList (FMList(..)) import qualified Data.FMList as FM-import Data.Foldable (Foldable)+--import Data.Foldable (Foldable) import qualified Data.Foldable as F-import Data.Traversable (Traversable)-import qualified Data.Traversable as T+--import Data.Traversable (Traversable)+--import qualified Data.Traversable as T import Data.String (IsString) import qualified Data.String as S import Control.Monad.Zip (MonadZip) import qualified Control.Monad.Zip as Z-import Data.Function-import Data.Char (Char(..))+--import Data.Function+import GHC.Exts (IsList(..))  instance FoldableLL (FMList a) a where   foldl = F.foldl@@ -27,6 +28,11 @@   foldl' = F.foldl'   foldr' = F.foldr' +instance IsList (FMList a) where+  type Item (FMList a) = a+  fromList = FM.fromList+  toList = FM.toList+ instance ListLike (FMList a) a where   empty = FM.empty   singleton = FM.singleton@@ -37,8 +43,8 @@   tail = FM.tail   last = FM.last   init = FM.init-  fromList = FM.fromList-  toList = FM.toList+  --fromList = FM.fromList+  --toList = FM.toList   null = FM.null   genericLength = FM.genericLength   length = FM.length@@ -58,7 +64,6 @@   fromString = FM.fromList  instance StringLike (FMList Char) where-  fromString = FM.fromList   toString = FM.toList   lines = map FM.fromList . S.lines . FM.toList   words = map FM.fromList . S.words . FM.toList

@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses+{-# LANGUAGE CPP+            ,MultiParamTypeClasses             ,FunctionalDependencies             ,FlexibleInstances #-} @@ -15,8 +16,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Generic tools for data structures that can be folded.@@ -24,19 +25,18 @@ Written by John Goerzen, jgoerzen\@complete.org  -}-module Data.ListLike.FoldableLL +module Data.ListLike.FoldableLL     (-- * FoldableLL Class      FoldableLL(..),      -- * Utilities      fold, foldMap, foldM, sequence_, mapM_-    ) where +    ) where import Prelude hiding (foldl, foldr, foldr1, sequence_, mapM_, foldMap) import qualified Data.Foldable as F-import Data.Monoid import Data.Maybe import qualified Data.List as L -{- | This is the primary class for structures that are to be considered +{- | This is the primary class for structures that are to be considered foldable.  A minimum complete definition provides 'foldl' and 'foldr'.  Instances of 'FoldableLL' can be folded, and can be many and varied.

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses            +{-# LANGUAGE MultiParamTypeClasses             ,FunctionalDependencies #-}  @@ -16,8 +16,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  String-like functions@@ -29,7 +29,7 @@     ( ListLikeIO(..)     )        where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat,                        any, lookup, init, all, foldl, foldr, foldl1, foldr1,                        maximum, minimum, iterate, span, break, takeWhile,                        dropWhile, reverse, zip, zipWith, sequence,@@ -48,7 +48,7 @@ Note that some types may not be capable of lazy reading or writing. Therefore, the usual semantics of "System.IO" functions regarding laziness may or may not be available from a particular implementation.-    + Minimal complete definition:  * hGetLine@@ -104,7 +104,7 @@     -- | Interact with stdin and stdout by using a function to transform     -- input to output.  May be lazy.  See 'System.IO.interact' for more.     interact :: (full -> full) -> IO ()-    interact func = +    interact func =         do c <- getContents            putStr (func c) 

@@ -1,7 +1,12 @@-{-# LANGUAGE MultiParamTypeClasses            +{-# LANGUAGE CPP+            ,MultiParamTypeClasses             ,FlexibleInstances+            ,TypeFamilies             ,TypeSynonymInstances #-}-+{-# OPTIONS -Wno-orphans #-}+#if __GLASGOW_HASKELL__ >= 900+{-# OPTIONS -Wno-incomplete-uni-patterns #-}+#endif  {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>@@ -17,8 +22,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Instances of 'Data.ListLike.ListLike' and related classes.@@ -28,7 +33,7 @@ -}  module Data.ListLike.Instances () where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat,                        any, lookup, init, all, foldl, foldr, foldl1, foldr1,                        maximum, minimum, iterate, span, break, takeWhile,                        dropWhile, reverse, zip, zipWith, sequence,@@ -37,7 +42,6 @@                        splitAt, elem, notElem, unzip, lines, words,                        unlines, unwords) import qualified Prelude as P-import           Control.Monad import qualified Data.List as L import qualified Data.Sequence as S import           Data.Sequence ((><), (|>), (<|))@@ -47,19 +51,26 @@ 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.Monoid+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup (Semigroup(..))+#endif import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC-import qualified Data.Foldable as F-import qualified Data.Traversable as T+--import qualified Data.Foldable as F+--import qualified Data.Traversable as T import qualified Data.Array.IArray as A import           Data.Array.IArray((!), (//), Ix(..)) import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSLC+import           Data.String (IsString)+--import           Data.String.UTF8 (UTF8)+--import qualified Data.String.UTF8 as UTF8 import qualified System.IO as IO import           Data.Word+import           GHC.Exts (IsList(..))  -------------------------------------------------- -- []@@ -70,8 +81,10 @@ instance ListLikeIO String Char where     hGetLine = IO.hGetLine     hGetContents = IO.hGetContents-    hGet h c = BSL.hGet h c >>= (return . toString)-    hGetNonBlocking h i = BSL.hGetNonBlocking h i >>= (return . toString)+    hGet _ c | c <= 0 = return mempty+    hGet h c = cons <$> IO.hGetChar h <*> hGet h (pred c)+    -- hGetNonBlocking h i >>= (return . toString)+    hGetNonBlocking _h _i = error "Unimplemented: hGetNonBlocking in instance ListLikeIO String Char"     hPutStr = IO.hPutStr     hPutStrLn = IO.hPutStrLn     getLine = IO.getLine@@ -82,9 +95,27 @@     readFile = IO.readFile     writeFile = IO.writeFile +{-+import           Data.ByteString.Internal (createAndTrim)+import qualified System.IO.Error as IO++hGetNonBlocking :: IO.Handle -> Int -> IO BS.ByteString+hGetNonBlocking h i+    | i >  0    = createAndTrim i $ \p -> IO.hGetBufNonBlocking h p i+    | i == 0    = return empty+    | otherwise = illegalBufferSize h "hGetNonBlocking'" i++illegalBufferSize :: IO.Handle -> String -> Int -> IO a+illegalBufferSize handle fn sz =+    ioError (IO.mkIOError IO.illegalOperationErrorType msg (Just handle) Nothing)+    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(+    where+      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []+-}+ instance StringLike String where     toString = id-    fromString = id+    --fromString = id  instance InfiniteListLike [a] a where     iterate = L.iterate@@ -102,12 +133,20 @@     foldr' = BS.foldr'     foldr1 = BS.foldr1 +#if !MIN_VERSION_bytestring(0,10,12)+instance IsList BS.ByteString where+    type Item BS.ByteString = Word8+    toList = BS.unpack+    fromList = BS.pack+#endif+ instance ListLike BS.ByteString Word8 where     empty = BS.empty     singleton = BS.singleton     cons = BS.cons     snoc = BS.snoc     append = BS.append+    uncons = BS.uncons     head = BS.head     last = BS.last     tail = BS.tail@@ -151,8 +190,8 @@     findIndices x = fromList . BS.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+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList     --nub = BS.nub     --delete = BS.delete     --deleteFirsts = BS.deleteFirsts@@ -160,9 +199,7 @@     --intersect = BS.intersect     sort = BS.sort     --insert = BS.insert-    toList = BS.unpack-    fromList = BS.pack-    fromListLike = fromList . toList+    --fromListLike = fromList . toList     --nubBy = BS.nubBy     --deleteBy = BS.deleteBy     --deleteFirstsBy = BS.deleteFirstsBy@@ -178,13 +215,13 @@     genericReplicate i = BS.replicate (fromIntegral i)  instance ListLikeIO BS.ByteString Word8 where-    hGetLine = BS.hGetLine+    hGetLine = BSC.hGetLine     hGetContents = BS.hGetContents     hGet = BS.hGet     hGetNonBlocking = BS.hGetNonBlocking     hPutStr = BS.hPutStr     hPutStrLn = BSC.hPutStrLn-    getLine = BS.getLine+    getLine = BSC.getLine     getContents = BS.getContents     putStr = BS.putStr     putStrLn = BSC.putStrLn@@ -193,9 +230,18 @@     writeFile = BS.writeFile     appendFile = BS.appendFile +-- There is no bijection between Strings and ByteStrings that I know+-- of.  The elements of a String are Unicode code points, and while+-- every String can be UTF8-encoded into a ByteString, there are+-- ByteStrings that can not be decoded into valid Strings - notably+-- "\128".  So should ByteString be an instance of StringLike?+-- Probably not.  Unfortunately, this instance is used to implement+-- the ListLikeIO instance for String!  This must not stand.+#if 0 instance StringLike BS.ByteString where-    toString = map (toEnum . fromIntegral) . BS.unpack-    fromString = BS.pack . map (fromIntegral . fromEnum)+    toString = BSU.toString+    --fromString = BSU.fromString+#endif  -------------------------------------------------- -- ByteString.Lazy@@ -212,12 +258,20 @@ mi64toi Nothing = Nothing mi64toi (Just x) = Just (fromIntegral x) +#if !MIN_VERSION_bytestring(0,10,12)+instance IsList BSL.ByteString where+    type Item BSL.ByteString = Word8+    toList = BSL.unpack+    fromList = BSL.pack+#endif+ instance ListLike BSL.ByteString Word8 where     empty = BSL.empty     singleton = BSL.singleton     cons = BSL.cons     snoc = BSL.snoc     append = BSL.append+    uncons = BSL.uncons     head = BSL.head     last = BSL.last     tail = BSL.tail@@ -255,12 +309,12 @@     filter = BSL.filter     --partition = BSL.partition     index l i = BSL.index l (fromIntegral i)-    elemIndex i = mi64toi . BSL.elemIndex i +    elemIndex i = mi64toi . BSL.elemIndex i     --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x     findIndex f = mi64toi . BSL.findIndex f     --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x-    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList     --sequence = BSL.sequence     --mapM = BSL.mapM     --mapM_ = BSL.mapM_@@ -271,9 +325,7 @@     --intersect = BSL.intersect     --sort = BSL.sort     --insert = BSL.insert-    toList = BSL.unpack-    fromList = BSL.pack-    fromListLike = fromList . toList+    --fromListLike = fromList . toList     --nubBy = BSL.nubBy     --deleteBy = BSL.deleteBy     --deleteFirstsBy = BSL.deleteFirstsBy@@ -293,13 +345,13 @@ strict2lazy :: BS.ByteString -> IO BSL.ByteString strict2lazy b = return (BSL.fromChunks [b]) instance ListLikeIO BSL.ByteString Word8 where-    hGetLine h = BS.hGetLine h >>= strict2lazy+    hGetLine h = BSC.hGetLine h >>= strict2lazy     hGetContents = BSL.hGetContents     hGet = BSL.hGet     hGetNonBlocking = BSL.hGetNonBlocking     hPutStr = BSL.hPut     -- hPutStrLn = BSLC.hPutStrLn-    getLine = BS.getLine >>= strict2lazy+    getLine = BSC.getLine >>= strict2lazy     getContents = BSL.getContents     putStr = BSL.putStr     putStrLn = BSLC.putStrLn@@ -308,9 +360,11 @@     writeFile = BSL.writeFile     appendFile = BSL.appendFile +#if 0 instance StringLike BSL.ByteString where-    toString = map (toEnum . fromIntegral) . BSL.unpack-    fromString = BSL.pack . map (fromIntegral . fromEnum)+    toString = BSLU.toString+    --fromString = BSLU.fromString+#endif  -------------------------------------------------- -- Map@@ -325,7 +379,8 @@ -------------------------------------------------- -- Arrays -instance (Ix i) => FoldableLL (A.Array i e) e where+-- This constraint is required for ghc < 8+instance Ix i => FoldableLL (A.Array i e) e where     foldl = F.foldl     foldl1 = F.foldl1     foldl' = F.foldl'@@ -333,25 +388,33 @@     foldr1 = F.foldr1     foldr' = F.foldr' +instance (Integral i, Ix i) => Semigroup (A.Array i e) where+  l1 <> l2 = A.array (blow, newbhigh) $+               A.assocs l1 ++ zip [bhigh + 1 .. newbhigh] (A.elems l2)+    where+    newlen        = genericLength newelems+    newelems      = A.elems l2+    newbhigh      = bhigh + newlen+    (blow, bhigh) = A.bounds l1+ instance (Integral i, Ix i) => Monoid (A.Array i e) where-    mempty = A.listArray (0, -1) []-    mappend l1 l2 =-        A.array (blow, newbhigh)-              (A.assocs l1 ++ zip [(bhigh + 1)..newbhigh] (A.elems l2))-        where newlen = genericLength newelems-              newelems = A.elems l2-              newbhigh = bhigh + newlen-              (blow, bhigh) = A.bounds l1+  mempty  = A.listArray (0, -1) []+  mappend = (<>) +instance (Integral i, Ix i) => IsList (A.Array i e) where+    type Item (A.Array i e) = e+    toList = A.elems+    fromList l = A.listArray (0, genericLength l - 1) l+ instance (Integral i, Ix i) => ListLike (A.Array i e) e where     empty = mempty     singleton i = A.listArray (0, 0) [i]-    cons i l = +    cons i l =         -- To add something to the beginning of an array, we must         -- change the bounds and set the first element.         (A.ixmap (blow - 1, bhigh) id l) // [(blow - 1, i)]         where (blow, bhigh) = A.bounds l-    snoc l i = +    snoc l i =         -- Here we must change the bounds and set the last element         (A.ixmap (blow, bhigh + 1) id l) // [(bhigh + 1, i)]         where (blow, bhigh) = A.bounds l@@ -366,7 +429,7 @@     length = genericLength     -- map     rigidMap = A.amap-    reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l)) +    reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l))     -- intersperse     -- concat     -- concatMap@@ -399,8 +462,8 @@     elemIndices i = fromList . L.elemIndices i . toList     findIndex f = L.findIndex f . toList     findIndices f = fromList . L.findIndices f . toList-    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList     -- rigidMapM = mapM     nub = fromList . L.nub . toList     -- delete@@ -409,8 +472,6 @@     -- intersect     sort l = A.listArray (A.bounds l) (L.sort (A.elems l))     -- insert-    toList = A.elems-    fromList l = A.listArray (0, genericLength l - 1) l     -- fromListLike     nubBy f = fromList . L.nubBy f . toList     -- deleteBy@@ -422,7 +483,7 @@     -- insertBy     genericLength l = fromIntegral (bhigh - blow + 1)         where (blow, bhigh) = A.bounds l-    genericTake count l +    genericTake count l         | count > genericLength l = l         | count <= 0 = empty         | otherwise = A.listArray (blow, blow + (fromIntegral count) - 1)@@ -432,13 +493,15 @@                           (L.genericDrop count (A.elems l))         where (blow, bhigh) = A.bounds l     -- geneicSplitAt-    genericReplicate count i = A.listArray (0, (fromIntegral count) - 1) +    genericReplicate count i = A.listArray (0, (fromIntegral count) - 1)                                            (L.genericReplicate count i)  +instance (Integral i, Ix i) => IsString (A.Array i Char) where+    fromString = fromList+ instance (Integral i, Ix i) => StringLike (A.Array i Char) where     toString = toList-    fromString = fromList     -- lines     -- words @@ -479,7 +542,7 @@  instance StringLike (S.Seq Char) where     toString = toList-    fromString = fromList+    --fromString = fromList  instance FoldableLL (S.Seq a) a where     foldl = F.foldl@@ -506,7 +569,7 @@     reverse = S.reverse     --intersperse =     --concat =-    --concatMap = +    --concatMap =     --rigidConcatMap =     any = F.any     all = F.all@@ -545,9 +608,7 @@     --intersect =     sort = S.sort     --insert = S.insert-    toList = F.toList-    fromList = S.fromList-    fromListLike = fromList . toList+    --fromListLike = fromList . toList     --nubBy =     --deleteBy =     --deleteFirstsBy =

@@ -12,8 +12,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  String-like functions@@ -21,11 +21,14 @@ Written by John Goerzen, jgoerzen\@complete.org -} +{-# LANGUAGE FlexibleContexts #-}+ module Data.ListLike.String     ( StringLike(..)+    , fromString     )        where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat,                        any, lookup, init, all, foldl, foldr, foldl1, foldr1,                        maximum, minimum, iterate, span, break, takeWhile,                        dropWhile, reverse, zip, zipWith, sequence,@@ -35,20 +38,20 @@                        unlines, unwords) import qualified Data.List as L import Data.ListLike.Base+import Data.String+import Data.Text (Text)+import qualified Data.Text.Lazy as Lazy (Text)  {- | An extension to 'ListLike' for those data types that are similar to a 'String'.  Minimal complete definition is 'toString' and 'fromString'. -}-class StringLike s where+class IsString s => StringLike s where     {- | Converts the structure to a 'String' -}     toString :: s -> String-    -    {- | Converts a 'String' to a list -}-    fromString :: String -> s      {- | Breaks a string into a list of strings -}     lines :: (ListLike full s) => s -> full-    --lines = map fromString . L.lines . toString +    --lines = map fromString . L.lines . toString     lines = myLines      {- | Breaks a string into a list of words -}@@ -62,6 +65,22 @@     {- | Joins words -}     unwords :: ListLike full s => full -> s     unwords = myUnwords++    {- | Generalize the 'Show' method t return any 'StringLike'. -}+    show :: Show a => a -> s+    show = fromString . Prelude.show++    fromStringLike :: StringLike s' => s -> s'+    fromStringLike = fromString . toString++    {- | Override this to avoid extra 'String' conversions. -}+    fromText :: StringLike Text => Text -> s+    fromText = fromString . toString+    {- | Override this to avoid extra 'String' conversions. -}+    fromLazyText :: StringLike Lazy.Text => Lazy.Text -> s+    fromLazyText = fromString . toString++{-# DEPRECATED fromStringLike "Use fromString . toString or something more efficient using local knowledge" #-}  -- For some reason, Hugs required splitting these out into -- separate functions.

@@ -1,9 +1,7 @@-module Data.ListLike.Text (-  module Data.ListLike.Text.Text- ,module Data.ListLike.Text.TextLazy-)+module Data.ListLike.Text ()  where -import Data.ListLike.Text.Text-import Data.ListLike.Text.TextLazy+import Data.ListLike.Text.Builder ()+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()

@@ -0,0 +1,51 @@+{-# LANGUAGE CPP+            ,MultiParamTypeClasses+            ,TypeFamilies+            ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Text.Builder++where++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))+import           GHC.Exts (IsList(..))++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 IsList Builder.Builder where+    type Item Builder.Builder = Char+    -- Can we do better?+    toList = LL.toList'+    fromList = LL.fromList'++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+    fromText = Builder.fromText+    fromLazyText = Builder.fromLazyText++instance NFData Builder.Builder where+    rnf = rnf . Builder.toLazyText

@@ -1,14 +1,15 @@ {-# LANGUAGE MultiParamTypeClasses             ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}  module Data.ListLike.Text.Text  where  import           Prelude as P-import           Control.Monad import qualified Data.Text as T import qualified Data.Text.IO as TI+import qualified Data.Text.Lazy as Lazy (toStrict) import           Data.Text.Encoding (decodeUtf8) import           Data.ListLike.Base as LL import           Data.ListLike.FoldableLL@@ -59,14 +60,16 @@     tails = fromList . T.tails     isPrefixOf = T.isPrefixOf     isSuffixOf = T.isSuffixOf+    stripPrefix = T.stripPrefix+    stripSuffix = T.stripSuffix     elem = T.isInfixOf . T.singleton     find = T.find     filter = T.filter     index = T.index     findIndex = T.findIndex-    toList = T.unpack-    fromList = T.pack-    fromListLike = fromList . toList+    --toList = T.unpack+    --fromList = T.pack+    --fromListLike = fromList . toList     groupBy f = fromList . T.groupBy f     genericLength = fromInteger . fromIntegral . T.length     genericTake i = T.take (fromIntegral i)@@ -74,8 +77,8 @@     genericSplitAt i = T.splitAt (fromIntegral i)     genericReplicate i = LL.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList  instance ListLikeIO T.Text Char where     hGetLine = TI.hGetLine@@ -95,8 +98,10 @@  instance StringLike T.Text where     toString = T.unpack-    fromString = T.pack     words = fromList . T.words     lines = fromList . T.lines     unwords = T.unwords . toList     unlines = T.unlines . toList++    fromText = id+    fromLazyText = Lazy.toStrict

@@ -1,12 +1,12 @@ {-# LANGUAGE MultiParamTypeClasses             ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}  module Data.ListLike.Text.TextLazy  where  import           Prelude as P-import           Control.Monad import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as TI import           Data.Text.Encoding (decodeUtf8)@@ -58,13 +58,15 @@     tails = fromList . T.tails     isPrefixOf = T.isPrefixOf     isSuffixOf = T.isSuffixOf+    stripPrefix = T.stripPrefix+    stripSuffix = T.stripSuffix     elem = T.isInfixOf . T.singleton     find = T.find     filter = T.filter     index t = T.index t . fromIntegral-    toList = T.unpack-    fromList = T.pack-    fromListLike = fromList . toList+    --toList = T.unpack+    --fromList = T.pack+    --fromListLike = fromList . toList     groupBy f = fromList . T.groupBy f     genericLength = fromInteger . fromIntegral . T.length     genericTake i = T.take (fromIntegral i)@@ -72,8 +74,8 @@     genericSplitAt i = T.splitAt (fromIntegral i)     genericReplicate i = LL.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList  instance ListLikeIO T.Text Char where     hGetLine = TI.hGetLine@@ -93,8 +95,10 @@  instance StringLike T.Text where     toString = T.unpack-    fromString = T.pack     words = fromList . T.words     lines = fromList . T.lines     unwords = T.unwords . toList     unlines = T.unlines . toList++    fromText = T.fromStrict+    fromLazyText = id

@@ -0,0 +1,288 @@+{-# LANGUAGE CPP+            ,MultiParamTypeClasses+            ,FlexibleInstances+            ,TypeFamilies+            ,TypeSynonymInstances+            ,UndecidableInstances #-}+{-# OPTIONS -Wno-orphans #-}++{- |+Instances of 'Data.ListLike.ListLike' and related classes.+Re-exported by "Data.ListLike".+-}++--------------------------------------------------+-- UTF8 ByteString++module Data.ListLike.UTF8 () where++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 as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String (StringLike(..))+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+#if !MIN_VERSION_utf8_string(1,0,2)+import Data.String (IsString(fromString))+#endif+import Data.String.UTF8 (UTF8{-, UTF8Bytes-})+import qualified Data.String.UTF8 as UTF8+import GHC.Exts (IsList(..))+--import GHC.Generics++#if 0+utf8rnf :: NFData a => UTF8 a -> ()+utf8rnf = rnf . UTF8.toRep+#endif++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 IsList (UTF8 BS.ByteString) where+    type Item (UTF8 BS.ByteString) = Char+    toList = UTF8.toString+    fromList = LL.fromList' -- LL.map id++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  = fmap fromList . P.sequenceA  . toList+    -- mapM func = fmap fromList . P.traverse 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 <$> BSC.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++#if !MIN_VERSION_utf8_string(1,0,2)+instance IsString (UTF8 BS.ByteString) where+    fromString = UTF8.fromString+#endif++instance StringLike (UTF8 BS.ByteString) where+    toString = UTF8.toString++instance Semigroup (UTF8 BS.ByteString) where+  a <> b = UTF8.fromRep $ UTF8.toRep a <> UTF8.toRep b++instance Monoid (UTF8 BS.ByteString) where+  mempty  = UTF8.fromString []+  mappend = (<>)++--------------------------------------------------+-- 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 IsList (UTF8 BSL.ByteString) where+    type Item (UTF8 BSL.ByteString) = Char+    toList = UTF8.toString+    fromList = LL.fromList' -- LL.map id++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  = fmap fromList . P.sequenceA  . toList+    -- mapM func = fmap fromList . P.traverse 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) <$> BSC.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++#if !MIN_VERSION_utf8_string(1,0,2)+instance IsString (UTF8 BSL.ByteString) where+    fromString = UTF8.fromString+#endif++instance StringLike (UTF8 BSL.ByteString) where+    toString = UTF8.toString++instance Semigroup (UTF8 BSL.ByteString) where+  a <> b = UTF8.fromRep $ UTF8.toRep a <> UTF8.toRep b++instance Monoid (UTF8 BSL.ByteString) where+  mempty  = UTF8.fromString []+  mappend = (<>)++{-# RULES "fromListLike/a" fromListLike = id :: a -> a #-}

@@ -15,8 +15,8 @@    Copyright  : Copyright (C) 2007 John Goerzen    License    : BSD3 -   Maintainer : John Lato <jwlato@gmail.com>-   Stability  : provisional+   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+   Stability  : stable    Portability: portable  Utilities for 'Data.ListLike.ListLike' and friends.  More functions@@ -26,9 +26,10 @@ -}  module Data.ListLike.Utils-    (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list+    (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list,+     intercalate     ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat,                        any, lookup, init, all, foldl, foldr, foldl1, foldr1,                        maximum, minimum, iterate, span, break, takeWhile,                        dropWhile, reverse, zip, zipWith, sequence,@@ -39,7 +40,6 @@ import Control.Monad (MonadPlus(..)) import Data.ListLike.Base import Data.ListLike.FoldableLL-import Data.Maybe (maybe) import Data.Monoid  -- | Returns True if all elements are True@@ -69,10 +69,15 @@  -- | 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 list d f = maybe d (uncurry f) . toMonadPlus++-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse'+-- xs xss))@.  It inserts the list @xs@ in between the lists in @xss@+-- and concatenates the result.+intercalate :: (ListLike a item, ListLike b a)+            => a -> b -> a+intercalate x = concat . intersperse x

@@ -2,14 +2,10 @@ -- The @Data.ListLike.Vector.Generic@ instances are not exported from this -- module in order to prevent collisions. ---module Data.ListLike.Vector (-  module Data.ListLike.Vector.Storable- ,module Data.ListLike.Vector.Unboxed- ,module Data.ListLike.Vector.Vector-)+module Data.ListLike.Vector ()  where -import Data.ListLike.Vector.Storable-import Data.ListLike.Vector.Unboxed-import Data.ListLike.Vector.Vector+import Data.ListLike.Vector.Storable ()+import Data.ListLike.Vector.Unboxed ()+import Data.ListLike.Vector.Vector ()

@@ -1,9 +1,13 @@-{-# LANGUAGE MultiParamTypeClasses-            ,FlexibleContexts-            ,FlexibleInstances-            ,OverlappingInstances-            ,UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}  -- for GHC >= 9.4 +{-# OPTIONS -Wno-orphans #-}+ -- | ListLike instance for any type supporting the @Data.Vector.Generic@ -- interface.  To avoid collisions with other Vector instances, this module -- must be imported directly.@@ -12,16 +16,15 @@ where  import           Prelude as P-import           Control.Monad import qualified Data.Vector.Generic as V import           Data.Vector.Generic ((!)) import           Data.ListLike.Base import           Data.ListLike.FoldableLL import           Data.ListLike.String--import           Data.Monoid+import           Data.String (IsString)+import           GHC.Exts (IsList(..)) -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,14 @@     foldr' = V.foldr'     foldr1 = V.foldr1 -instance (Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where+#if 0+instance {-# OVERLAPPABLE #-} (Monoid (v a), Eq (v a), V.Vector v a) => IsList (v a) where+    type Item (v a) = a+    toList = V.toList+    fromList = V.fromList+#endif++instance {-# OVERLAPPABLE #-} (IsList (v a), Item (v a) ~ a, Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where     empty = V.empty     singleton = V.singleton     cons = V.cons@@ -68,33 +78,37 @@     filter = V.filter     index = (!)     findIndex = V.findIndex-    toList = V.toList-    fromList = V.fromList-    fromListLike = fromList . toList-    --groupBy f = +    --toList = V.toList+    --fromList = V.fromList+    --fromListLike = fromList . toList+    --groupBy f =     genericLength = fromInteger . fromIntegral . V.length     genericTake i = V.take (fromIntegral i)     genericDrop i = V.drop (fromIntegral i)-    --genericSplitAt i = +    --genericSplitAt i =     genericReplicate i = V.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList +instance (Eq (v Char), V.Vector v Char) => IsString (v Char) where+    fromString = V.fromList+ instance (Eq (v Char), V.Vector v Char) => StringLike (v Char) where     toString = V.toList-    fromString = V.fromList     --words =     --lines =     unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList     unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList +isPrefixOf' :: (V.Vector v a, Eq (v a)) => v a -> v a -> Bool isPrefixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =             needle == V.slice 0 (V.length needle) haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False+isSuffixOf' :: (V.Vector v a, Eq (v a)) => v a -> v a -> Bool isSuffixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =

@@ -1,19 +1,20 @@ {-# LANGUAGE MultiParamTypeClasses+            ,TypeFamilies             ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}  module Data.ListLike.Vector.Storable ()  where  import           Prelude as P-import           Control.Monad import qualified Data.Vector.Storable as V import           Data.Vector.Storable ((!)) import           Data.ListLike.Base import           Data.ListLike.FoldableLL import           Data.ListLike.String+import           Data.String (IsString) -import           Data.Monoid import           Foreign.Storable (Storable)  @@ -64,33 +65,37 @@     filter = V.filter     index = (!)     findIndex = V.findIndex-    toList = V.toList-    fromList = V.fromList-    fromListLike = fromList . toList-    --groupBy f = +    --toList = V.toList+    --fromList = V.fromList+    --fromListLike = fromList . toList+    --groupBy f =     genericLength = fromInteger . fromIntegral . V.length     genericTake i = V.take (fromIntegral i)     genericDrop i = V.drop (fromIntegral i)-    --genericSplitAt i = +    --genericSplitAt i =     genericReplicate i = V.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList +instance IsString (V.Vector Char) where+    fromString = fromList+ instance StringLike (V.Vector Char) where     toString = toList-    fromString = fromList     --words =     --lines =     unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList     unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList +isPrefixOf' :: (Storable a, Eq a) => V.Vector a -> V.Vector a -> Bool isPrefixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =             needle == V.slice 0 (V.length needle) haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False+isSuffixOf' :: (Storable a, Eq a) => V.Vector a -> V.Vector a -> Bool isSuffixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =@@ -99,4 +104,3 @@                           haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False-

@@ -1,19 +1,19 @@ {-# LANGUAGE MultiParamTypeClasses+            ,TypeFamilies             ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}  module Data.ListLike.Vector.Unboxed ()  where  import           Prelude as P-import           Control.Monad import qualified Data.Vector.Unboxed as V import           Data.Vector.Unboxed (Unbox, (!)) import           Data.ListLike.Base import           Data.ListLike.FoldableLL import           Data.ListLike.String--import           Data.Monoid+import           Data.String (IsString)   instance Unbox a => FoldableLL (V.Vector a) a where@@ -63,33 +63,37 @@     filter = V.filter     index = (!)     findIndex = V.findIndex-    toList = V.toList-    fromList = V.fromList-    fromListLike = fromList . toList-    --groupBy f = +    --toList = V.toList+    --fromList = V.fromList+    --fromListLike = fromList . toList+    --groupBy f =     genericLength = fromInteger . fromIntegral . V.length     genericTake i = V.take (fromIntegral i)     genericDrop i = V.drop (fromIntegral i)-    --genericSplitAt i = +    --genericSplitAt i =     genericReplicate i = V.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList +instance IsString (V.Vector Char) where+    fromString = fromList+ instance StringLike (V.Vector Char) where     toString = toList-    fromString = fromList     --words =     --lines =     unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList     unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList +isPrefixOf' :: (Unbox a, Eq a) => V.Vector a -> V.Vector a -> Bool isPrefixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =             needle == V.slice 0 (V.length needle) haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False+isSuffixOf' :: (Unbox a, Eq a) => V.Vector a -> V.Vector a -> Bool isSuffixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =@@ -98,4 +102,3 @@                           haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False-

@@ -1,19 +1,19 @@ {-# LANGUAGE MultiParamTypeClasses+            ,TypeFamilies             ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}  module Data.ListLike.Vector.Vector ()  where  import           Prelude as P-import           Control.Monad import qualified Data.Vector as V import           Data.Vector ((!)) import           Data.ListLike.Base import           Data.ListLike.FoldableLL import           Data.ListLike.String--import           Data.Monoid+import           Data.String (IsString)  instance FoldableLL (V.Vector a) a where     foldl = V.foldl@@ -62,33 +62,37 @@     filter = V.filter     index = (!)     findIndex = V.findIndex-    toList = V.toList-    fromList = V.fromList-    fromListLike = fromList . toList-    --groupBy f = +    --toList = V.toList+    --fromList = V.fromList+    --fromListLike = fromList . toList+    --groupBy f =     genericLength = fromInteger . fromIntegral . V.length     genericTake i = V.take (fromIntegral i)     genericDrop i = V.drop (fromIntegral i)-    --genericSplitAt i = +    --genericSplitAt i =     genericReplicate i = V.replicate (fromIntegral i) -    sequence  = liftM fromList . P.sequence  . toList-    mapM func = liftM fromList . P.mapM func . toList+    sequence  = fmap fromList . P.sequenceA  . toList+    mapM func = fmap fromList . P.traverse func . toList +instance IsString (V.Vector Char) where+    fromString = fromList+ instance StringLike (V.Vector Char) where     toString = toList-    fromString = fromList     --words =     --lines =     unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList     unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList +isPrefixOf' :: Eq a => V.Vector a -> V.Vector a -> Bool isPrefixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =             needle == V.slice 0 (V.length needle) haystack   | V.length needle == V.length haystack = needle == haystack   | otherwise = False+isSuffixOf' :: Eq a => V.Vector a -> V.Vector a -> Bool isSuffixOf' needle haystack   | V.null needle = True   | V.length needle < V.length haystack =

@@ -6,7 +6,9 @@             ,FunctionalDependencies             ,FlexibleInstances             ,UndecidableInstances+            ,TypeFamilies             ,FlexibleContexts #-}+{-# OPTIONS -Wno-orphans #-}  {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>@@ -25,24 +27,30 @@ 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+import qualified Data.Semigroup as Sem import qualified Data.Sequence as S-import qualified Data.Foldable as F+--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-import System.Random+--import System.Random import System.IO import qualified Test.HUnit as HU import Text.Printf import Data.Function (on)+import Data.String (IsString(fromString)) import Data.Word import Data.List-import Data.Monoid+import Data.Monoid (Monoid(..))+import GHC.Exts (IsList(Item))  simpleArb :: (LL.ListLike f i, Arbitrary i) => Gen f simpleArb = sized (\n -> choose (0, n) >>= myVector)@@ -74,34 +82,34 @@ instance (CoArbitrary i) => CoArbitrary (FM.FMList i) where     coarbitrary l = coarbitrary (LL.toList l) -instance (Arbitrary i) => Arbitrary (S.Seq i) where+instance Arbitrary (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 i) => CoArbitrary (S.Seq i) where+instance CoArbitrary (BSL.ByteString) where     coarbitrary l = coarbitrary (LL.toList l) -instance Arbitrary (BSL.ByteString) where+instance Arbitrary (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 (BSL.ByteString) where+instance CoArbitrary (BS.ByteString) where     coarbitrary l = coarbitrary (LL.toList l) -instance Arbitrary (BS.ByteString) where+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 (BS.ByteString) where+instance CoArbitrary Chars.Chars where     coarbitrary l = coarbitrary (LL.toList l)  instance Arbitrary i => Arbitrary (A.Array Int i) where@@ -134,6 +142,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 +221,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 +231,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@@ -212,38 +258,50 @@     foldr1 f (MyList x) = foldr1 f x     foldl1 f (MyList x) = foldl1 f x +instance Sem.Semigroup (MyList a) where+    MyList x <> MyList y = MyList (x ++ y)+ instance Monoid (MyList a) where     mempty = MyList []-    mappend (MyList x) (MyList y) = MyList (x ++ y)+    mappend = (Sem.<>) +instance IsList (MyList a) where+    type Item (MyList a) = a+    toList (MyList xs) = xs+    fromList = MyList+ instance LL.ListLike (MyList a) a where     singleton x = MyList [x]-    head (MyList x) = head x-    tail (MyList x) = MyList (tail x)+    -- Andreas Abel, 2023-10-10, issue #32:+    -- Avoid 'head' and 'tail' from 'Prelude' and thus the x-partial warning of GHC 9.8.+    head (MyList (x:xs)) = x+    head (MyList [])     = undefined+    tail (MyList (x:xs)) = MyList xs+    tail (MyList []    ) = undefined     null (MyList x) = null x +instance IsString (MyList Char) where+    fromString = MyList+ instance LL.StringLike (MyList Char) where     toString (MyList x) = x-    fromString x = MyList x -mkTest msg test = HU.TestLabel msg $ HU.TestCase (quickCheck test)+mkTest :: Testable prop => String -> prop -> HU.Test+mkTest msg test = HU.TestLabel msg $ HU.TestCase (quickCheckResult test >>= HU.assertBool msg . isSuccess)  -- Modified from HUnit runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)-runVerbTestText (HU.PutText put us) t = do-  (counts, us') <- HU.performTest reportStart reportError reportFailure us t+runVerbTestText (HU.PutText put us) test = do+  (counts, us') <- HU.performTest reportStart reportError reportFailure us test   us'' <- put (HU.showCounts counts) True us'   return (counts, us'')  where-  reportStart ss us = do hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))-                         put (HU.showCounts (HU.counts ss)) False us+  reportStart ss us' = do+    hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))+    put (HU.showCounts (HU.counts ss)) False us'   reportError   = reportProblem "Error:"   "Error in:   "   reportFailure = reportProblem "Failure:" "Failure in: "-#if MIN_VERSION_HUnit(1,3,0)-  reportProblem p0 p1 _mloc msg ss us = put line True us-#else-  reportProblem p0 p1 msg ss us = put line True us-#endif+  reportProblem p0 p1 _mloc msg ss us' = put line True us'    where line  = "### " ++ kind ++ path' ++ '\n' : msg          kind  = if null path' then p0 else p1          path' = HU.showPath (HU.path ss)@@ -260,8 +318,7 @@          forall t. Testable t => LLWrap (f' -> t)  w :: TestLL f i => String -> LLTest f i -> HU.Test-w msg f = case f of-                    LLTest theTest -> mkTest msg theTest+w msg (LLTest theTest) = mkTest msg theTest  ws :: (LL.StringLike f, TestLL f i) => String -> LLTest f i -> HU.Test ws = w@@ -280,12 +337,12 @@      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-apf :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, CoArbitrary f, CoArbitrary i) => LLTest f i) -> HU.Test +apf :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, CoArbitrary f, CoArbitrary i) => LLTest f i) -> HU.Test apf msg x = HU.TestLabel msg $ HU.TestList $     [w "[Int]" (x::LLTest [Int] Int),      w "MyList Int" (x::LLTest (MyList Int) Int),@@ -294,6 +351,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,22 +367,29 @@      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-aps :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.StringLike f, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i) => LLTest f i) -> HU.Test +aps :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.StringLike f, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i) => LLTest f i) -> HU.Test aps msg x = HU.TestLabel msg $ HU.TestList $     [w "String" (x::LLTest String Char),      w "MyList Char" (x::LLTest (MyList Char) Char),      w "Sequence Char" (x::LLTest (S.Seq Char) Char),      w "DList Char" (x::LLTest (DL.DList Char) Char),      -- 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 "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 "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)     ]

@@ -1,12 +1,18 @@-{-# LANGUAGE ScopedTypeVariables-            ,RankNTypes-            ,ExistentialQuantification-            ,MultiParamTypeClasses-            ,FunctionalDependencies-            ,FlexibleInstances-            ,UndecidableInstances-            ,FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -Wno-missing-signatures #-}++ {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org> @@ -17,18 +23,20 @@ -} module Main where +import Control.Applicative ((<$>), (<*>)) import Test.QuickCheck import qualified Data.ListLike as LL-import qualified Data.Foldable as F-import System.Random+--import qualified Data.Foldable as F+--import System.Random import qualified Test.HUnit as HU import System.IO-import Text.Printf-import Data.Word+--import Text.Printf+--import Data.Word import Data.List import Data.Monoid import TestInfrastructure import Data.Foldable(foldr', fold, foldMap)+import System.Exit import System.Info  @@ -39,8 +47,8 @@ prop_empty f = (LL.toList l == []) && (LL.null l) && (LL.length l == 0)     where l = asTypeOf LL.empty f -prop_tofromlist f = -    LL.toList f == l && +prop_tofromlist f =+    LL.toList f == l &&     LL.length f == length l &&     f == (LL.fromList . LL.toList $ f)     where l = LL.toList f@@ -49,9 +57,17 @@ prop_cons f i = llcmp (LL.cons i f) (i : (LL.toList f)) prop_append f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2) prop_head f = not (LL.null f) ==> LL.head f == head (LL.toList f)-prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f)+  where+    head (x:xs) = x+    head []     = undefined+  -- Andreas Abel, 2023-10-10, issue #32:+  -- Redefine 'head' and 'tail' to avoid the x-partial warning of GHC 9.8. prop_tail f = not (LL.null f) ==> llcmp (LL.tail f) (tail (LL.toList f))+  where+    tail (x:xs) = xs+    tail []     = undefined prop_init f = not (LL.null f) ==> llcmp (LL.init f) (init (LL.toList f))+prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f) prop_null f = LL.null f == null (LL.toList f) prop_length2 f = checkLengths f (LL.toList f) prop_length3 f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2)@@ -64,7 +80,7 @@ prop_reverse f = llcmp (LL.reverse f) (reverse (LL.toList f)) prop_intersperse f i = llcmp (LL.intersperse i f) (intersperse i (LL.toList f)) -prop_concat f = +prop_concat f =     llcmp (LL.concat f) (concat $ map LL.toList (LL.toList f))  prop_concatmap :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> [item]) -> Property@@ -85,18 +101,18 @@ prop_take f count = llcmp (LL.take count f) (take count (LL.toList f)) prop_drop f count = count >= 0 ==> llcmp (LL.drop count f) (drop count (LL.toList f)) prop_splitAt f count = count >= 0 ==>-    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f] +    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f]           [LL.splitAt count (LL.toList f)]-prop_takeWhile f func = llcmp (LL.takeWhile func f) +prop_takeWhile f func = llcmp (LL.takeWhile func f)                               (takeWhile func (LL.toList f))-prop_dropWhile f func = llcmp (LL.dropWhile func f) +prop_dropWhile f func = llcmp (LL.dropWhile func f)                               (dropWhile func (LL.toList f)) prop_dropWhileEnd f func = llcmp (LL.dropWhileEnd func f)                                  (dropWhileEnd func (LL.toList f))-prop_span f func = +prop_span f func =     llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.span func $ f]           [span func (LL.toList f)]-prop_break f func = +prop_break f func =     llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.break func $ f]           [break func (LL.toList f)] prop_group f =@@ -104,17 +120,22 @@     (map LL.toList (LL.group f)) == (group (LL.toList f)) prop_inits f = (map LL.toList (LL.inits f)) == (inits (LL.toList f)) prop_tails f = (map LL.toList (LL.tails f)) == (tails (LL.toList f))-prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 == +prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 ==     (isPrefixOf (LL.toList f1) (LL.toList f2)) prop_isSuffixOf f1 f2 = LL.isSuffixOf f1 f2 ==     (isSuffixOf (LL.toList f1) (LL.toList f2)) prop_isInfixOf f1 f2 = LL.isInfixOf f1 f2 ==     (isInfixOf (LL.toList f1) (LL.toList f2))+prop_stripPrefix f1 f2 = (LL.toList <$> LL.stripPrefix f1 f2) ==+    (stripPrefix (LL.toList f1) (LL.toList f2))+prop_stripPrefix2 f1 f2 = (LL.toList <$> LL.stripPrefix f1 (f1 <> f2)) ==+    (stripPrefix (LL.toList f1) (LL.toList $ f1 <> f2))+prop_stripSuffix f1 f2 = LL.stripSuffix f1 (f2 <> f1) == Just f2 prop_elem f i = LL.elem i f == elem i (LL.toList f) prop_notElem f i = LL.notElem i f == notElem i (LL.toList f) prop_find f func = LL.find func f == find func (LL.toList f) prop_filter f func = llcmp (LL.filter func f) (filter func (LL.toList f))-prop_partition f func = +prop_partition f func =     (LL.toList f1, LL.toList f2) == partition func (LL.toList f)     where (f1, f2) = LL.partition func f prop_index f i = (i >= 0 && i < LL.length f) ==>@@ -137,7 +158,7 @@     where llmapM = asTypeOf (LL.mapM func f) (Just (LL.toList f))  prop_rigidMapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Property-prop_rigidMapM f func = +prop_rigidMapM f func =     case (LL.rigidMapM func f, mapM func (LL.toList f)) of          (Just ll, Just l)  -> llcmp ll l          (Nothing, Nothing) -> property True@@ -147,16 +168,16 @@  prop_nub f = llcmp (LL.nub f) (nub (LL.toList f)) prop_delete f i = llcmp (LL.delete i f) (delete i (LL.toList f))-prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2) +prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2)     ((LL.toList f1) \\ (LL.toList f2))-prop_union f1 f2 = llcmp (LL.union f1 f2) +prop_union f1 f2 = llcmp (LL.union f1 f2)     (union (LL.toList f1) (LL.toList f2))-prop_intersect f1 f2 = llcmp (LL.intersect f1 f2) +prop_intersect f1 f2 = llcmp (LL.intersect f1 f2)     (intersect (LL.toList f1) (LL.toList f2)) prop_sort f1 = llcmp (LL.sort f1) (sort (LL.toList f1)) prop_insert f i = llcmp (LL.insert i f) (insert i (LL.toList f)) prop_nubBy f func = llcmp (LL.nubBy func f) (nubBy func (LL.toList f))-prop_deleteBy f func i = llcmp (LL.deleteBy func i f) +prop_deleteBy f func i = llcmp (LL.deleteBy func i f)                          (deleteBy func i (LL.toList f)) prop_deleteFirstsBy f1 f2 func = llcmp (LL.deleteFirstsBy func f1 f2)     (deleteFirstsBy func (LL.toList f1) (LL.toList f2))@@ -192,12 +213,12 @@ --    full -> Result prop_zip f = LL.zip f f2 == zip (LL.toList f) f2     where f2 = [(-5::Int)..]-prop_zipWith f = +prop_zipWith f =     LL.toList res == (zipWith func (LL.toList f) f2)     where f2 = [(100::Int)..(-100)]           func x y = (y + 5, x)           res = asTypeOf (LL.zipWith func f f2) [(5::Int, LL.head f)]---FIXME: prop_unzip +--FIXME: prop_unzip --FIXME: prop_and --FIXME: prop_or --FIXME: prop_sum@@ -205,7 +226,7 @@ prop_foldl f func (i::Int) = LL.foldl func i f == foldl func i (LL.toList f) prop_foldl' f func (i::Integer) =     LL.foldl' func i f == foldl' func i (LL.toList f)-prop_foldl1 f func = not (LL.null f) ==> +prop_foldl1 f func = not (LL.null f) ==>     (LL.foldl1 func f) == (foldl1 func (LL.toList f)) prop_foldr f func (i::Int) = LL.foldr func i f == foldr func i (LL.toList f) prop_foldr' f func (i::Integer) =@@ -223,7 +244,7 @@ prop_toString f =     ((LL.fromString . LL.toString $ f) == f)     where l = LL.toList f-prop_fromString f x = +prop_fromString f x =     LL.toString (asTypeOf (LL.fromString x) f) == x prop_lines f = map LL.toString res == lines (LL.toString f)     where res = asTypeOf (LL.lines f) [f]@@ -269,6 +290,9 @@         apf "isPrefixOf" (t prop_isPrefixOf),         apf "isSuffixOf" (t prop_isSuffixOf),         apf "isInfixOf" (t prop_isInfixOf),+        apf "stripPrefix" (t prop_stripPrefix),+        apf "stripPrefix2" (t prop_stripPrefix2),+        apf "stripSuffix" (t prop_stripSuffix),         apf "elem" (t prop_elem),         apf "notElem" (t prop_notElem),         apf "find" (t prop_find),@@ -309,13 +333,13 @@         apf "genericSplitAt" (t prop_genericSplitAt),         apf "genericReplicate" (t prop_genericReplicate),         apf "zip" (t prop_zip),-        apf "zipWith" (t prop_zipWith) +        apf "zipWith" (t prop_zipWith)         -- apf "unzip" (t prop_unzip),         -- apf "and" (t prop_and),         -- apf "or" (t prop_or),         -- apf "sum" (t prop_sum),         -- apf "propduct" (t prop_product),-        -- sequence_ +        -- sequence_         ]  allf = (if compilerName == "hugs" then [] else [ apf "foldl" (t prop_foldl),@@ -327,14 +351,14 @@         apf "foldr" (t prop_foldr),         apf "foldr'" (t prop_foldr'),         apw "fold" (LLWrap prop_fold),-        apf "foldMap" (t prop_foldMap) +        apf "foldMap" (t prop_foldMap)        ]  alls = [         aps "toString" (t prop_toString),         aps "fromString" (t prop_fromString),         aps "lines" (t prop_lines),-        aps "words" (t prop_words) +        aps "words" (t prop_words)         -- FIXME: aps (t prop_unlines),         -- FIXME: aps (t prop_unwords)        ]@@ -345,7 +369,11 @@  testh = HU.runTestTT $ allTests testv = runVerbTestText (HU.putTextToHandle stderr True) $ allTests-         -main = -    do testv-       return ()++main = do+  (counts, n) <- testv+  case HU.errors counts + HU.failures counts of+    0 -> return ()+    n -> do+      putStrLn ("counts=" ++ show counts ++ " n=" ++ show n)+      exitWith (ExitFailure 1)