ListLike-4.2.1/0000755000000000000000000000000012606470212011424 5ustar0000000000000000ListLike-4.2.1/README.md0000644000000000000000000000106212606470212012702 0ustar0000000000000000[![Build Status](https://secure.travis-ci.org/JohnLato/listlike.png?branch=master)](http://travis-ci.org/JohnLato/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: ``` $ runghc Setup.hs configure $ runghc Setup.hs build $ runghc Setup.hs install ``` ListLike-4.2.1/ListLike.cabal0000644000000000000000000000500512606470212014130 0ustar0000000000000000Name: ListLike Version: 4.2.1 License: BSD3 Maintainer: John Lato 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 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. . The ListLike module provides a common interface to the various Haskell types that are list-like. Predefined interfaces include standard Haskell lists, Arrays, ByteStrings, and lazy ByteStrings. Custom types can easily be made ListLike instances as well. . ListLike also provides for String-like types, such as String and ByteString, for types that support input and output, and for types that can handle infinite lists. Stability: Stable Library Hs-Source-Dirs: src Exposed-Modules: Data.ListLike Data.ListLike.Base Data.ListLike.CharString Data.ListLike.FoldableLL Data.ListLike.IO Data.ListLike.Instances Data.ListLike.String Data.ListLike.Text Data.ListLike.Text.Text Data.ListLike.Text.TextLazy Data.ListLike.Utils Data.ListLike.Vector Data.ListLike.Vector.Generic Data.ListLike.Vector.Storable Data.ListLike.Vector.Unboxed Data.ListLike.Vector.Vector 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 Test-suite listlike-tests Hs-source-dirs: src 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 source-repository head type: git location: git://github.com/JohnLato/listlike.git ListLike-4.2.1/Setup.hs0000644000000000000000000000011212606470212013052 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain ListLike-4.2.1/COPYRIGHT0000644000000000000000000000270612606470212012724 0ustar0000000000000000Copyright (c) 2007-2010 John Goerzon and John Lato. 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. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ListLike-4.2.1/testsrc/0000755000000000000000000000000012606470212013113 5ustar0000000000000000ListLike-4.2.1/testsrc/runtests.hs0000644000000000000000000003452612606470212015350 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables ,RankNTypes ,ExistentialQuantification ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances ,UndecidableInstances ,FlexibleContexts #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} module Main where import Test.QuickCheck import qualified Data.ListLike as LL 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 Data.List import Data.Monoid import TestInfrastructure import Data.Foldable(foldr', fold, foldMap) import System.Info -- prop_singleton :: (Eq i,LL.ListLike f i) => f -> i -> Bool --prop_singleton :: (Eq i, LL.ListLike f i, Arbitrary f, Show f, Show i, Arbitrary i) => f -> i -> Bool prop_singleton f x = (LL.toList $ asTypeOf (LL.singleton x) f) == [x] 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 && LL.length f == length l && f == (LL.fromList . LL.toList $ f) where l = LL.toList f prop_length f = LL.length f == length (LL.toList f) 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) prop_tail f = not (LL.null f) ==> llcmp (LL.tail f) (tail (LL.toList f)) prop_init f = not (LL.null f) ==> llcmp (LL.init f) (init (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) prop_map :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> item) -> Property prop_map f func = llcmp llmap (map func (LL.toList f)) where llmap = asTypeOf (LL.map func f) (LL.toList f) prop_rigidMap f func = llcmp (LL.rigidMap func f) (map func (LL.toList f)) 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 = 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 prop_concatmap f func = llcmp (LL.concatMap func f) (concatMap func (LL.toList f)) prop_rigidConcatMap f func = llcmp (LL.rigidConcatMap func f) (concatMap (LL.toList . func) (LL.toList f)) prop_any f func = (LL.any func f) == (any func (LL.toList f)) prop_all f func = (LL.all func f) == (all func (LL.toList f)) prop_maximum f = not (LL.null f) ==> LL.maximum f == maximum (LL.toList f) prop_minimum f = not (LL.null f) ==> LL.minimum f == minimum (LL.toList f) prop_replicate f count i = count <= 1000 ==> llcmp res (replicate count i) where res = asTypeOf (LL.replicate count i) f 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] [LL.splitAt count (LL.toList f)] prop_takeWhile f func = llcmp (LL.takeWhile func f) (takeWhile func (LL.toList 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 = llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.span func $ f] [span func (LL.toList f)] 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 = -- llcmp (map LL.toList (LL.group f)) (group (LL.toList f)) (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 == (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_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 = (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) ==> (LL.index f i == ((LL.toList f) !! i)) prop_elemIndex f i = LL.elemIndex i f == elemIndex i (LL.toList f) prop_elemIndices f i = LL.elemIndices i f == elemIndices i (LL.toList f) prop_findIndex f func = LL.findIndex func f == findIndex func (LL.toList f) prop_findIndices f func = LL.findIndices func f == findIndices func (LL.toList f) prop_sequence f = case (llres, sequence testit) of (Just ll, Just l) -> llcmp ll l _ -> error "Error!" where testit = map Just (LL.toList f) llres = asTypeOf (LL.sequence testit) (Just f) prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Bool prop_mapM f func = llmapM == (mapM func (LL.toList f)) 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 = case (LL.rigidMapM func f, mapM func (LL.toList f)) of (Just ll, Just l) -> llcmp ll l (Nothing, Nothing) -> property True e -> error $ "error in prop_rigidMapM: " ++ show e -- FIXME: can we test mapM_? 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) ((LL.toList f1) \\ (LL.toList 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) (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) (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)) prop_unionBy f1 f2 func = llcmp (LL.unionBy func f1 f2) (unionBy func (LL.toList f1) (LL.toList f2)) prop_intersectBy f1 f2 func = llcmp (LL.intersectBy func f1 f2) (intersectBy func (LL.toList f1) (LL.toList f2)) prop_groupBy f func = (map LL.toList (LL.groupBy func f)) == (groupBy func (LL.toList f)) prop_sortBy1 f = llcmp (LL.sortBy compare f) (sortBy compare (LL.toList f)) prop_sortBy2 f = llcmp (LL.sortBy func f) (sortBy func (LL.toList f)) where func x y = compare y x prop_sortBy f func = llcmp (LL.sortBy func f) (sortBy func (LL.toList f)) prop_insertBy1 f i = llcmp (LL.insertBy compare i f) (insertBy compare i (LL.toList f)) prop_insertBy2 f i = llcmp (LL.insertBy func i f) (insertBy func i (LL.toList f)) where func x y = compare y x prop_genericLength f = LL.genericLength f == genericLength (LL.toList f) prop_genericTake f (i::Integer) = (i >= 0) ==> llcmp (LL.genericTake i f) (genericTake i (LL.toList f)) prop_genericDrop f (i::Integer) = (i >= 0) ==> llcmp (LL.genericDrop i f) (genericDrop i (LL.toList f)) prop_genericSplitAt f (i::Integer) = i >= 0 ==> llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.genericSplitAt i $ f] [LL.genericSplitAt i (LL.toList f)] prop_genericReplicate f (count::Integer) i = count >= 0 ==> llcmp res (genericReplicate count i) where res = asTypeOf (LL.genericReplicate count i) f --prop_zip :: (LL.ListLike full item, LL.ListLike result (item, Int)) => -- full -> Result prop_zip f = LL.zip f f2 == zip (LL.toList f) f2 where f2 = [(-5::Int)..] 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_and --FIXME: prop_or --FIXME: prop_sum --FIXME: prop_product 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) ==> (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) = LL.foldr' func i f == foldr' func i (LL.toList f) prop_foldr1 f func = not (LL.null f) ==> LL.foldl1 func f == foldl1 func (LL.toList f) prop_fold f = llcmp res resl where res = LL.fold f resl = fold (map LL.toList (LL.toList f)) prop_foldMap :: (LL.ListLike full item, Eq full) => full -> (item -> [Int]) -> Bool prop_foldMap f func = res == resl where res = LL.foldMap func f resl = foldMap func (LL.toList f) -- asTypeOf (foldMap (LL.toList f)) (head f) prop_toString f = ((LL.fromString . LL.toString $ f) == f) where l = LL.toList f 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] prop_words f = map LL.toString res == words (LL.toString f) where res = asTypeOf (LL.words f) [f] allt = [apf "empty" (t prop_empty), apf "length" (t prop_length), apf "to/fromList" (t prop_tofromlist), apf "singleton" (t prop_singleton), apf "cons" (t prop_cons), apf "append" (t prop_append), apf "head" (t prop_head), apf "last" (t prop_last), apf "tail" (t prop_tail), apf "init" (t prop_init), apf "null" (t prop_null), apf "length2" (t prop_length2), apf "length3" (t prop_length3), apf "map" (t prop_map), apf "rigidMap" (t prop_rigidMap), apf "reverse" (t prop_reverse), apf "intersperse" (t prop_intersperse), apw "concat" (LLWrap prop_concat), apf "concatMap" (t prop_concatmap), apf "rigidConcatMap" (t prop_rigidConcatMap), apf "any" (t prop_any), apf "all" (t prop_all), apf "maximum" (t prop_maximum), apf "minimum" (t prop_minimum), apf "replicate" (t prop_replicate), apf "take" (t prop_take), apf "drop" (t prop_drop), apf "splitAt" (t prop_splitAt), apf "takeWhile" (t prop_takeWhile), apf "dropWhile" (t prop_dropWhile), apf "dropWhileEnd" (t prop_dropWhileEnd), apf "span" (t prop_span), apf "break" (t prop_break), apf "group" (t prop_group), apf "inits" (t prop_inits), apf "tails" (t prop_tails), apf "isPrefixOf" (t prop_isPrefixOf), apf "isSuffixOf" (t prop_isSuffixOf), apf "isInfixOf" (t prop_isInfixOf), apf "elem" (t prop_elem), apf "notElem" (t prop_notElem), apf "find" (t prop_find), apf "filter" (t prop_filter), apf "partition" (t prop_partition), apf "index" (t prop_index), apf "elemIndex" (t prop_elemIndex), apf "elemIndices" (t prop_elemIndices), apf "findIndex" (t prop_findIndex), apf "findIndices" (t prop_findIndices), apf "sequence" (t prop_sequence), apf "mapM" (t prop_mapM), apf "rigidMapM" (t prop_rigidMapM), -- FIXME: mapM_ ? apf "nub" (t prop_nub), apf "delete" (t prop_delete), apf "deleteFirsts" (t prop_deleteFirsts), apf "union" (t prop_union), apf "intersect" (t prop_intersect), apf "sort" (t prop_sort), apf "insert" (t prop_insert), -- toList -- fromList -- fromListLike apf "nubBy" (t prop_nubBy), apf "deleteBy" (t prop_deleteBy), apf "deleteFirstsBy" (t prop_deleteFirstsBy), apf "unionBy" (t prop_unionBy), apf "intersectBy" (t prop_intersectBy), apf "groupBy" (t prop_groupBy), apf "sortBy1" (t prop_sortBy1), apf "sortBy2" (t prop_sortBy2), apf "insertBy1" (t prop_insertBy1), apf "insertBy2" (t prop_insertBy2), apf "genericLength" (t prop_genericLength), apf "genericTake" (t prop_genericTake), apf "genericDrop" (t prop_genericDrop), apf "genericSplitAt" (t prop_genericSplitAt), apf "genericReplicate" (t prop_genericReplicate), apf "zip" (t prop_zip), 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_ ] allf = (if compilerName == "hugs" then [] else [ apf "foldl" (t prop_foldl), apf "foldr1" (t prop_foldr1), apf "foldl1" (t prop_foldl1)]) ++ [ apf "foldl'" (t prop_foldl'), apf "foldr" (t prop_foldr), apf "foldr'" (t prop_foldr'), apw "fold" (LLWrap prop_fold), 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) -- FIXME: aps (t prop_unlines), -- FIXME: aps (t prop_unwords) ] allTests = HU.TestList $ reverse $ [HU.TestLabel "ListLike" (HU.TestList allt), HU.TestLabel "FoldableLL" (HU.TestList allf), HU.TestLabel "StringLike" (HU.TestList alls)] testh = HU.runTestTT $ allTests testv = runVerbTestText (HU.putTextToHandle stderr True) $ allTests main = do testv return () ListLike-4.2.1/testsrc/TestInfrastructure.hs0000644000000000000000000003013712606470212017333 0ustar0000000000000000{-# LANGUAGE CPP ,ScopedTypeVariables ,RankNTypes ,ExistentialQuantification ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances ,UndecidableInstances ,FlexibleContexts #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} -- FIXME -- better code is in offlineimap v7 branch module TestInfrastructure where import Test.QuickCheck import Test.QuickCheck.Test import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ListLike as LL import qualified Data.Array as A import qualified Data.DList as DL import qualified Data.FMList as FM import qualified Data.Sequence as S import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.Text.Lazy as TL 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.IO import qualified Test.HUnit as HU import Text.Printf import Data.Function (on) import Data.Word import Data.List import Data.Monoid simpleArb :: (LL.ListLike f i, Arbitrary i) => Gen f simpleArb = sized (\n -> choose (0, n) >>= myVector) where myVector n = do arblist <- vector n return (LL.fromList arblist) instance (Arbitrary i) => Arbitrary (MyList i) where arbitrary = sized (\n -> choose (0, n) >>= myVector) where myVector n = do arblist <- vector n return (LL.fromList arblist) shrink (MyList l) = map MyList $ shrink l instance (CoArbitrary i) => CoArbitrary (MyList i) where coarbitrary l = coarbitrary (LL.toList l) instance (Arbitrary i) => Arbitrary (DL.DList i) where arbitrary = simpleArb shrink = map LL.fromList . shrink . LL.toList instance (CoArbitrary i) => CoArbitrary (DL.DList i) where coarbitrary l = coarbitrary (LL.toList l) instance (Arbitrary i) => Arbitrary (FM.FMList i) where arbitrary = simpleArb shrink = map LL.fromList . shrink . LL.toList instance (CoArbitrary i) => CoArbitrary (FM.FMList i) where coarbitrary l = coarbitrary (LL.toList l) instance (Arbitrary i) => Arbitrary (S.Seq i) 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 coarbitrary l = coarbitrary (LL.toList l) 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 (BSL.ByteString) where coarbitrary l = coarbitrary (LL.toList l) 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 (BS.ByteString) where coarbitrary l = coarbitrary (LL.toList l) instance Arbitrary i => Arbitrary (A.Array Int i) where arbitrary = sized (\n -> choose (0, n) >>= myVector) where myVector n = do arblist <- vector n return (LL.fromList arblist) shrink = map LL.fromList . shrink . LL.toList instance (CoArbitrary i) => CoArbitrary (A.Array Int i) where coarbitrary l = coarbitrary (LL.toList l) instance Arbitrary (T.Text) 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 (T.Text) where coarbitrary l = coarbitrary (LL.toList l) instance Arbitrary (TL.Text) 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 (TL.Text) 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 = do arblist <- vector n return (LL.fromList arblist) shrink = map LL.fromList . shrink . LL.toList instance (CoArbitrary i) => CoArbitrary (V.Vector i) where coarbitrary l = coarbitrary (LL.toList l) instance (Arbitrary i, VS.Storable i) => Arbitrary (VS.Vector i) 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, VS.Storable i) => CoArbitrary (VS.Vector i) where coarbitrary l = coarbitrary (LL.toList l) instance (Arbitrary i, VU.Unbox i) => Arbitrary (VU.Vector i) 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, VU.Unbox i) => CoArbitrary (VU.Vector i) where coarbitrary l = coarbitrary (LL.toList l) class (Show b, Arbitrary a, Show a, Eq a, Eq b, LL.ListLike a b) => TestLL a b where llcmp :: a -> [b] -> Property llcmp f l = (putStrLn ("Expected: " ++ show l ++ "\nGot: " ++ show f)) `whenFail` (l == (LL.toList f)) checkLengths :: a -> [b] -> Bool checkLengths f l = (LL.length f) == length l instance (Arbitrary a, Show a, Eq a) => TestLL [a] a where instance (Arbitrary a, Show a, Eq a) => TestLL (MyList a) a instance (Arbitrary a, Show a, Eq a) => TestLL (DL.DList a) a instance (Arbitrary a, Show a, Eq a) => TestLL (FM.FMList a) a instance TestLL BS.ByteString Word8 where instance TestLL BSL.ByteString Word8 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 instance TestLL T.Text Char where instance TestLL TL.Text 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 instance (Arbitrary a, Show a, Eq a, VU.Unbox a) => TestLL (VU.Vector a) a where instance Eq a => Eq (FM.FMList a) where (==) = (==) `on` FM.toList mapRemoveDups :: (Eq k1) => [(k1, v1)] -> [(k1, v1)] mapRemoveDups = nubBy (\(k1, _) (k2, _) -> k1 == k2) data MyList a = MyList [a] deriving (Ord, Eq, Show) instance LL.FoldableLL (MyList a) a where foldr f i (MyList x) = foldr f i x foldl f i (MyList x) = foldl f i x foldr1 f (MyList x) = foldr1 f x foldl1 f (MyList x) = foldl1 f x instance Monoid (MyList a) where mempty = MyList [] mappend (MyList x) (MyList y) = MyList (x ++ y) instance LL.ListLike (MyList a) a where singleton x = MyList [x] head (MyList x) = head x tail (MyList x) = MyList (tail x) null (MyList x) = null x instance LL.StringLike (MyList Char) where toString (MyList x) = x fromString x = MyList x mkTest msg test = HU.TestLabel msg $ HU.TestCase (quickCheck test) -- 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 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 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 where line = "### " ++ kind ++ path' ++ '\n' : msg kind = if null path' then p0 else p1 path' = HU.showPath (HU.path ss) -- | So we can test map and friends instance Show (a -> b) where show _ = "(a -> b)" data LLTest f i = forall t. Testable t => LLTest (f -> t) data LLWrap f' f i = 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 ws :: (LL.StringLike f, TestLL f i) => String -> LLTest f i -> HU.Test ws = w wwrap :: (TestLL f i, TestLL f' f) => String -> LLWrap f' f i -> HU.Test wwrap msg f = case f of LLWrap theTest -> mkTest msg theTest t :: forall f t i. (TestLL f i, Arbitrary f, Arbitrary i, Show f, Eq f, Testable t) => (f -> t) -> LLTest f i t = LLTest -- | all props, wrapped list apw :: String -> (forall f' f i. (TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, LL.ListLike f' f, Show f', TestLL f' f, Arbitrary f', Eq f') => LLWrap f' f i) -> HU.Test apw msg x = HU.TestLabel msg $ HU.TestList $ [wwrap "wrap [[Int]]" (x::LLWrap [[Int]] [Int] Int), 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) ] -- | 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 msg x = HU.TestLabel msg $ HU.TestList $ [w "[Int]" (x::LLTest [Int] Int), w "MyList Int" (x::LLTest (MyList Int) Int), w "String" (x::LLTest String Char), w "[Bool]" (x::LLTest [Bool] Bool), w "MyList Bool" (x::LLTest (MyList Bool) Bool), w "ByteString" (x::LLTest BS.ByteString Word8), w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8), 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), w "Array Int Int" (x::LLTest (A.Array Int Int) Int), w "Array Int Bool" (x::LLTest (A.Array Int Bool) Bool), w "Array (Just Int)" (x::LLTest (A.Array Int (Maybe Int)) (Maybe Int)), w "DList Int" (x::LLTest (DL.DList Int) Int), -- w "FMList Int" (x::LLTest (FM.FMList Int) Int), w "Vector Int" (x::LLTest (V.Vector Int) Int), w "StorableVector Int" (x::LLTest (VS.Vector Int) Int), w "UnboxVector Int" (x::LLTest (VU.Vector Int) Int), w "Vector Bool" (x::LLTest (V.Vector Bool) Bool), 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) ] -- | 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 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 "Array Int Char" (x::LLTest (A.Array Int Char) Char), w "Text" (x::LLTest T.Text Char), w "Text.Lazy" (x::LLTest TL.Text Char), w "Vector Char" (x::LLTest (V.Vector Char) Char), w "Vector.Unbox Char" (x::LLTest (VU.Vector Char) Char) ] ListLike-4.2.1/src/0000755000000000000000000000000012606470212012213 5ustar0000000000000000ListLike-4.2.1/src/Data/0000755000000000000000000000000012606470212013064 5ustar0000000000000000ListLike-4.2.1/src/Data/ListLike.hs0000644000000000000000000002140112606470212015136 0ustar0000000000000000{- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Goerzen Stability : provisional Portability: portable Generic operations over list-like structures Written by John Goerzen, jgoerzen\@complete.org Please start with the introduction at "Data.ListLike#intro". -} module Data.ListLike (-- * Introduction -- $intro -- * Creation & Basic Functions empty, singleton, cons, snoc, append, head, last, tail, init, null, length, -- * List transformations map, rigidMap, reverse, intersperse, -- ** Conversions toList, fromList, fromListLike, -- * Reducing lists (folds), from "FoldableLL" foldl, foldl', foldl1, foldr, foldr', foldr1, -- ** Special folds concat, concatMap, rigidConcatMap, and, or, any, all, sum, product, maximum, minimum, fold, foldMap, -- * Building lists -- ** Scans -- ** Accumulating maps -- ** Infinite lists iterate, repeat, replicate, cycle, -- ** Unfolding -- * Sublists -- ** Extracting sublists take, drop, splitAt, takeWhile, dropWhile, dropWhileEnd, span, break, group, inits, tails, -- ** Predicates isPrefixOf, isSuffixOf, isInfixOf, -- * Searching lists -- ** Searching by equality elem, notElem, -- ** Searching with a predicate find, filter, partition, -- * Indexing lists index, elemIndex, elemIndices, findIndex, findIndices, -- * Zipping and unzipping lists zip, zipWith, unzip, -- * Monadic Operations sequence, sequence_, mapM, rigidMapM, mapM_, -- * Input and Output ListLikeIO(..), -- * Special lists -- ** Strings toString, fromString, lines, words, -- ** \"Set\" operations nub, delete, deleteFirsts, union, intersect, -- ** Ordered lists sort, insert, -- * Generalized functions -- ** The \"By\" operations -- *** User-supplied equality (replacing an Eq context) nubBy, deleteBy, deleteFirstsBy, unionBy, intersectBy, groupBy, -- *** User-supplied comparison (replacing an Ord context) sortBy, insertBy, -- maximumBy, minimumBy, -- ** The \"generic\" operations genericLength, genericTake, genericDrop, genericSplitAt, -- genericIndex, genericReplicate, -- * Notes on specific instances -- ** Lists -- $noteslist -- ** Arrays -- $notesarray -- ** ByteStrings -- $notesbytestring CharString (..), CharStringLazy (..), -- * Base Typeclasses -- ** The ListLike class ListLike, -- ** The FoldableLL class FoldableLL, -- ** The StringLike class StringLike, -- ** The InfiniteListLike class 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 Data.ListLike.Base import Data.ListLike.CharString import Data.ListLike.FoldableLL import Data.ListLike.Instances() import Data.ListLike.DList import Data.ListLike.FMList import Data.ListLike.String import Data.ListLike.Utils import Data.ListLike.IO {- $intro #intro# Welcome to ListLike. This module provides abstractions over typical list operations. It is designed to let you freely interchange different ways to represent sequences of data. It works with lists, various types of ByteStrings, and much more. In this module, you'll find generic versions of most of the functions you're used to using in the "Prelude", "Data.List", and "System.IO". They carry the same names, too. Therefore, you'll want to be careful how you import the module. I suggest using: >import qualified Data.ListLike as LL Then, you can use LL.fold, LL.map, etc. to get the generic version of the functions you want. Alternatively, you can hide the other versions from Prelude and import specific generic functions from here, such as: >import Prelude hiding (map) >import Data.ListLike (map) The module "Data.ListLike" actually simply re-exports the items found in a number of its sub-modules. If you want a smaller subset of "Data.ListLike", look at the documentation for its sub-modules and import the relevant one. 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. -} {- $noteslist Functions for operating on regular lists almost all use the native implementations in "Data.List", "Prelude", or similar standard modules. The exceptions are: * 'mapM' uses the default 'ListLike' implementation * 'hGet' does not exist for 'String' in the Haskell modules. It is implemented in terms of "Data.ByteString.Lazy". * 'hGetNonBlocking' is the same way. -} {- $notesarray 'Data.Array.Array' is an instance of 'ListLike'. Here are some notes about it: * The index you use must be an integral * 'ListLike' functions that take an index always take a 0-based index for compatibility with other 'ListLike' instances. This is translated by the instance functions into the proper offset from the bounds in the Array. * 'ListLike' functions preserve the original Array index numbers when possible. Functions such as 'cons' will reduce the lower bound to do their job. 'snoc' and 'append' increase the upper bound. 'drop' raises the lower bound and 'take' lowers the upper bound. * Functions that change the length of the array by an amount not known in advance, such as 'filter', will generate a new array with the lower bound set to 0. Furthermore, these functions cannot operate on infinite lists because they must know their length in order to generate the array. 'hGetContents' and its friends will therefore require the entire file to be read into memory before processing is possible. * 'empty', 'singleton', and 'fromList' also generate an array with the lower bound set to 0. * Many of these functions will generate runtime exceptions if you have not assigned a value to every slot in the array. -} {- $notesbytestring Both strict and lazy ByteStreams can be used with 'ListLike'. ByteString ListLike instances operate on 'Word8' elements. This is because both Data.ByteString.ByteString and Data.ByteString.Char8.ByteString have the same underlying type. If you wish to use the Char8 representation, the newtype wrappers 'CharString' and 'CharStringLazy' are available. Most 'ListLike' operations map directly to ByteStream options. Notable exceptions: * 'map' uses the 'ListLike' implementation. 'rigidMap' is more efficient. The same goes for 'concatMap' vs. 'rigidConcatMap'. * '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. * The lazy ByteStream module implements fewer funtions than the strict ByteStream module. In some cases, default implementations are used. In others, notably related to I\/O, the lazy ByteStreams are converted back and forth to strict ones as appropriate. -} ListLike-4.2.1/src/Data/ListLike/0000755000000000000000000000000012606470212014604 5ustar0000000000000000ListLike-4.2.1/src/Data/ListLike/CharString.hs0000644000000000000000000002475012606470212017214 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances ,TypeSynonymInstances #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.CharString Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable Newtype wrapper for ByteString to enable a Char-based interface Re-exported by "Data.ListLike". Written by John Lato, jwlato\@gmail.com -} module Data.ListLike.CharString ( CharString (..) ,CharStringLazy (..) ) 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, 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) 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 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 Control.Arrow -------------------------------------------------- -- ByteString -- | 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) instance FoldableLL CharString Char where foldl f i0 ls = BS.foldl f i0 (unCS ls) foldl' f i0 ls = BS.foldl' f i0 (unCS ls) foldl1 f ls = BS.foldl1 f (unCS ls) foldr f i0 ls = BS.foldr f i0 (unCS ls) foldr1 f ls = BS.foldr1 f (unCS ls) instance ListLike CharString Char where empty = CS BS.empty singleton = CS . BS.singleton cons x l = CS (BS.cons x (unCS l)) snoc l x = CS (BS.snoc (unCS l) x) append l r = CS $ BS.append (unCS l) (unCS r) head = BS.head . unCS last = BS.last . unCS tail = CS . BS.tail . unCS init = CS . BS.init . unCS null = BS.null . unCS length = fromIntegral . BS.length . unCS -- map = BS.map rigidMap f = CS . BS.map f . unCS reverse = CS . BS.reverse . unCS --intersperse = BS.intersperse concat = CS . BS.concat . map unCS . toList --concatMap = BS.concatMap rigidConcatMap f = CS . BS.concatMap (unCS . f) . unCS any p = BS.any p . unCS all p = BS.all p . unCS maximum = BS.maximum . unCS minimum = BS.minimum . unCS replicate i = CS . BS.replicate (fromIntegral i) take i = CS . BS.take (fromIntegral i) . unCS drop i = CS . BS.drop (fromIntegral i) . unCS splitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS takeWhile p = CS . BS.takeWhile p . unCS dropWhile p = CS . BS.dropWhile p . unCS span p = (CS *** CS) . BS.span p . unCS break p = (CS *** CS) . BS.break p . unCS group = fromList . map CS . BS.group . unCS inits = fromList . map CS . BS.inits . unCS tails = fromList . map CS . BS.tails . unCS isPrefixOf p f = BS.isPrefixOf (unCS p) (unCS f) --isSuffixOf = BS.isSuffixOf --isInfixOf = BS.isInfixOf elem x = BS.elem x . unCS notElem x = BS.notElem x . unCS find p = BS.find p . unCS filter p = CS . BS.filter p . unCS --partition = BS.partition index l i = BS.index (unCS l) (fromIntegral i) elemIndex i = BS.elemIndex i . unCS --elemIndices x = fromList . L.map fromIntegral . BS.elemIndices x findIndex f = BS.findIndex f . unCS --findIndices x = fromList . L.map fromIntegral . BS.findIndices x --sequence = BS.sequence --mapM = BS.mapM --mapM_ = BS.mapM_ --nub = BS.nub --delete = BS.delete --deleteFirsts = BS.deleteFirsts --union = BS.union --intersect = BS.intersect --sort = BS.sort --insert = BS.insert toList = BS.unpack . unCS fromList = CS . BS.pack fromListLike = fromList . toList --nubBy = BS.nubBy --deleteBy = BS.deleteBy --deleteFirstsBy = BS.deleteFirstsBy --unionBy = BS.unionBy --intersectBy = BS.intersectBy -- BS.groupBy is broken. groupBy f = fromList . BS.groupBy f -- the below works on ghc but generates a type error on hugs -- groupBy func = map fromList . L.groupBy func . toList --sortBy = BS.sortBy --insertBy = BS.insertBy genericLength = fromInteger . fromIntegral . BS.length . unCS genericTake i = CS . BS.take (fromIntegral i) . unCS genericDrop i = CS . BS.drop (fromIntegral i) . unCS genericSplitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS genericReplicate i = CS . BS.replicate (fromIntegral i) instance ListLikeIO CharString Char where hGetLine h = fmap CS $ BS.hGetLine h hGetContents = fmap CS . BS.hGetContents hGet h n = fmap CS $ BS.hGet h n hGetNonBlocking h n = fmap CS $ BS.hGetNonBlocking h n hPutStr h = BS.hPut h . unCS --hPutStrLn = BS.hPutStrLn getLine = fmap CS BS.getLine getContents = fmap CS BS.getContents putStr = BS.putStr . unCS putStrLn = BS.putStrLn . unCS interact f = BS.interact (unCS . f . CS) readFile = fmap CS . BS.readFile writeFile fp = BS.writeFile fp . unCS appendFile fp = BS.appendFile fp . unCS instance StringLike CharString where toString = BS.unpack . unCS fromString = CS . BS.pack -------------------------------------------------- -- ByteString.Lazy -- | 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) instance FoldableLL CharStringLazy Char where foldl f i0 ls = BSL.foldl f i0 (unCSL ls) foldl' f i0 ls = BSL.foldl' f i0 (unCSL ls) foldl1 f ls = BSL.foldl1 f (unCSL ls) foldr f i0 ls = BSL.foldr f i0 (unCSL ls) foldr1 f ls = BSL.foldr1 f (unCSL ls) mi64toi :: Maybe Int64 -> Maybe Int mi64toi Nothing = Nothing mi64toi (Just x) = Just (fromIntegral x) instance ListLike CharStringLazy Char where empty = CSL BSL.empty singleton = CSL . BSL.singleton cons x l = CSL (BSL.cons x (unCSL l)) snoc l x = CSL (BSL.snoc (unCSL l) x) append l r = CSL $ BSL.append (unCSL l) (unCSL r) head = BSL.head . unCSL last = BSL.last . unCSL tail = CSL . BSL.tail . unCSL init = CSL . BSL.init . unCSL null = BSL.null . unCSL length = fromIntegral . BSL.length . unCSL -- map = BSL.map rigidMap f = CSL . BSL.map f . unCSL reverse = CSL . BSL.reverse . unCSL --intersperse = BSL.intersperse concat = CSL . BSL.concat . map unCSL . toList --concatMap = BSL.concatMap rigidConcatMap f = CSL . BSL.concatMap (unCSL . f) . unCSL any p = BSL.any p . unCSL all p = BSL.all p . unCSL maximum = BSL.maximum . unCSL minimum = BSL.minimum . unCSL replicate i = CSL . BSL.replicate (fromIntegral i) take i = CSL . BSL.take (fromIntegral i) . unCSL drop i = CSL . BSL.drop (fromIntegral i) . unCSL splitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL takeWhile p = CSL . BSL.takeWhile p . unCSL dropWhile p = CSL . BSL.dropWhile p . unCSL span p = (CSL *** CSL) . BSL.span p . unCSL break p = (CSL *** CSL) . BSL.break p . unCSL group = fromList . map CSL . BSL.group . unCSL inits = fromList . map CSL . BSL.inits . unCSL tails = fromList . map CSL . BSL.tails . unCSL isPrefixOf p f = BSL.isPrefixOf (unCSL p) (unCSL f) --isSuffixOf = BSL.isSuffixOf --isInfixOf = BSL.isInfixOf elem x = BSL.elem x . unCSL notElem x = BSL.notElem x . unCSL find p = BSL.find p . unCSL filter p = CSL . BSL.filter p . unCSL --partition = BSL.partition index l i = BSL.index (unCSL l) (fromIntegral i) elemIndex i = mi64toi . BSL.elemIndex i . unCSL --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x findIndex f = mi64toi . BSL.findIndex f . unCSL --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x --sequence = BSL.sequence --mapM = BSL.mapM --mapM_ = BSL.mapM_ --nub = BSL.nub --delete = BSL.delete --deleteFirsts = BSL.deleteFirsts --union = BSL.union --intersect = BSL.intersect --sort = BSL.sort --insert = BSL.insert toList = BSL.unpack . unCSL fromList = CSL . BSL.pack fromListLike = fromList . toList --nubBy = BSL.nubBy --deleteBy = BSL.deleteBy --deleteFirstsBy = BSL.deleteFirstsBy --unionBy = BSL.unionBy --intersectBy = BSL.intersectBy -- BSL.groupBy is broken. groupBy f = fromList . BSL.groupBy f -- the below works on ghc but generates a type error on hugs -- groupBy func = map fromList . L.groupBy func . toList --sortBy = BSL.sortBy --insertBy = BSL.insertBy genericLength = fromInteger . fromIntegral . BSL.length . unCSL genericTake i = CSL . BSL.take (fromIntegral i) . unCSL genericDrop i = CSL . BSL.drop (fromIntegral i) . unCSL genericSplitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL genericReplicate i = CSL . BSL.replicate (fromIntegral i) strict2lazy :: BS.ByteString -> CharStringLazy strict2lazy b = CSL $ BSL.fromChunks [b] instance ListLikeIO CharStringLazy Char where hGetLine h = fmap strict2lazy $ BS.hGetLine h hGetContents = fmap CSL . BSL.hGetContents hGet h n = fmap CSL $ BSL.hGet h n hGetNonBlocking h n = fmap CSL $ BSL.hGetNonBlocking h n hPutStr h = BSL.hPut h . unCSL --hPutStrLn = BSL.hPutStrLn getLine = fmap strict2lazy BS.getLine getContents = fmap CSL BSL.getContents putStr = BSL.putStr . unCSL putStrLn = BSL.putStrLn . unCSL interact f = BSL.interact (unCSL . f . CSL) readFile = fmap CSL . BSL.readFile writeFile fp = BSL.writeFile fp . unCSL appendFile fp = BSL.appendFile fp . unCSL instance StringLike CharStringLazy where toString = BSL.unpack . unCSL fromString = CSL . BSL.pack ListLike-4.2.1/src/Data/ListLike/String.hs0000644000000000000000000000454712606470212016420 0ustar0000000000000000{- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.String Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable String-like functions Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.String ( StringLike(..) ) 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, 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) import qualified Data.List as L import Data.ListLike.Base {- | 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 {- | 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 = myLines {- | Breaks a string into a list of words -} words :: ListLike full s => s -> full words = myWords {- | Joins lines -} unlines :: ListLike full s => full -> s unlines = myUnlines {- | Joins words -} unwords :: ListLike full s => full -> s unwords = myUnwords -- For some reason, Hugs required splitting these out into -- separate functions. myLines :: (StringLike s, ListLike full s) => s -> full myLines = map fromString . L.lines . toString myWords :: (StringLike s, ListLike full s) => s -> full myWords = map fromString . L.words . toString myUnlines :: (StringLike s, ListLike full s) => full -> s myUnlines = fromString . L.unlines . map toString myUnwords :: (StringLike s, ListLike full s) => full -> s myUnwords = fromString . L.unwords . map toString ListLike-4.2.1/src/Data/ListLike/DList.hs0000644000000000000000000000251212606470212016157 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude, MultiParamTypeClasses, FlexibleInstances #-} -- | 'Data.ListLike.ListLike' instances for 'Data.DList.DList' module Data.ListLike.DList () where import qualified Prelude as P import Data.ListLike.Base import Data.ListLike.FoldableLL import Data.ListLike.IO import Data.ListLike.String import Data.DList (DList(..)) 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.String as S import Control.Category import Data.Char (Char(..)) instance FoldableLL (DList a) a where foldl = F.foldl foldr = D.foldr foldl1 = F.foldl1 foldr1 = F.foldr1 foldl' = F.foldl' foldr' = F.foldr' instance ListLike (DList a) a where empty = D.empty singleton = D.singleton cons = D.cons snoc = D.snoc append = D.append head = D.head tail = D.tail rigidMap = D.map null = null . D.toList toList = D.toList fromList = D.fromList replicate = D.replicate instance StringLike (DList Char) where toString = D.toList 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 unwords = D.fromList . S.unwords . map D.toList ListLike-4.2.1/src/Data/ListLike/Vector.hs0000644000000000000000000000070712606470212016406 0ustar0000000000000000-- | 'Data.ListLike.ListLike' instances for several @Data.Vector@ types. -- 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 ) where import Data.ListLike.Vector.Storable import Data.ListLike.Vector.Unboxed import Data.ListLike.Vector.Vector ListLike-4.2.1/src/Data/ListLike/Utils.hs0000644000000000000000000000472212606470212016245 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.Utils Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable Utilities for 'Data.ListLike.ListLike' and friends. More functions similar to 'Data.List' but not part of the main typeclass. Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.Utils (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list ) 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, 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 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 and :: ListLike full Bool => full -> Bool and = all (== True) -- | Returns True if any element is True or :: ListLike full Bool => full -> Bool or = any (== True) -- | The sum of the list sum :: (Num a, ListLike full a) => full -> a sum = getSum . foldMap Sum -- | The product of the list product :: (Num a, ListLike full a) => full -> a product = getProduct . foldMap Product ------------------------------ Zipping -- zip, zipWith in Base {- | Converts a list of pairs into two separate lists of elements -} unzip :: (ListLike full (itema, itemb), ListLike ra itema, ListLike rb itemb) => full -> (ra, rb) unzip inp = foldr convert (empty, empty) inp where convert (a, b) (as, bs) = ((cons a as), (cons b bs)) -- | 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) -- | 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 ListLike-4.2.1/src/Data/ListLike/Base.hs0000644000000000000000000005363112606470212016022 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances ,BangPatterns ,FlexibleContexts #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.Base Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable Generic operations over list-like structures Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.Base ( ListLike(..), 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 qualified Data.List as L import Data.ListLike.FoldableLL import qualified Control.Monad as M import Data.Monoid import Data.Maybe {- | The class implementing list-like functions. It is worth noting that types such as 'Data.Map.Map' can be instances of 'ListLike'. Due to their specific ways of operating, they may not behave in the expected way in some cases. For instance, 'cons' may not increase the size of a map if the key you have given is already in the map; it will just replace the value already there. Implementators must define at least: * singleton * head * tail * null or genericLength -} class (FoldableLL full item, Monoid full) => ListLike full item | full -> item where ------------------------------ Creation {- | The empty list -} empty :: full empty = mempty {- | Creates a single-element list out of an element -} singleton :: item -> full ------------------------------ Basic Functions {- | Like (:) for lists: adds an element to the beginning of a list -} cons :: item -> full -> full cons item l = append (singleton item) l {- | Adds an element to the *end* of a 'ListLike'. -} snoc :: full -> item -> full snoc l item = append l (singleton item) {- | Combines two lists. Like (++). -} append :: full -> full -> full append = mappend {- | Extracts the first element of a 'ListLike'. -} head :: full -> item {- | Extracts the last element of a 'ListLike'. -} last :: full -> item last l = case genericLength l of (0::Integer) -> error "Called last on empty list" 1 -> head l _ -> last (tail l) {- | Gives all elements after the head. -} tail :: full -> full {- | All elements of the list except the last one. See also 'inits'. -} init :: full -> full init l | null l = error "init: empty list" | null xs = empty | otherwise = cons (head l) (init xs) where xs = tail l {- | Tests whether the list is empty. -} null :: full -> Bool null x = genericLength x == (0::Integer) {- | Length of the list. See also 'genericLength'. -} length :: full -> Int length = genericLength ------------------------------ List Transformations {- | Apply a function to each element, returning any other valid 'ListLike'. 'rigidMap' will always be at least 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 | null inp = empty | otherwise = cons (func (head inp)) (map func (tail inp)) {- | Like 'map', but without the possibility of changing the type of the item. This can have performance benefits for things such as ByteStrings, since it will let the ByteString use its native low-level map implementation. -} rigidMap :: (item -> item) -> full -> full rigidMap = map {- | Reverse the elements in a list. -} reverse :: full -> full reverse l = rev l empty where rev rl a | null rl = a | otherwise = rev (tail rl) (cons (head rl) a) {- | Add an item between each element in the structure -} intersperse :: item -> full -> full intersperse sep l | null l = empty | null xs = singleton x | otherwise = cons x (cons sep (intersperse sep xs)) where x = head l xs = tail l ------------------------------ Reducing Lists (folds) -- See also functions in FoldableLLL ------------------------------ Special folds {- | Flatten the structure. -} concat :: (ListLike full' full, Monoid full) => full' -> full concat = fold {- | Map a function over the items and concatenate the results. See also 'rigidConcatMap'.-} concatMap :: (ListLike full' item') => (item -> full') -> full -> full' concatMap = foldMap {- | Like 'concatMap', but without the possibility of changing the type of the item. This can have performance benefits for some things such as ByteString. -} rigidConcatMap :: (item -> full) -> full -> full rigidConcatMap = concatMap {- | True if any items satisfy the function -} any :: (item -> Bool) -> full -> Bool any p = getAny . foldMap (Any . p) {- | True if all items satisfy the function -} all :: (item -> Bool) -> full -> Bool all p = getAll . foldMap (All . p) {- | The maximum value of the list -} maximum :: Ord item => full -> item maximum = foldr1 max {- | The minimum value of the list -} minimum :: Ord item => full -> item minimum = foldr1 min ------------------------------ Infinite lists {- | Generate a structure with the specified length with every element set to the item passed in. See also 'genericReplicate' -} replicate :: Int -> item -> full replicate = genericReplicate ------------------------------ Sublists {- | Takes the first n elements of the list. See also 'genericTake'. -} take :: Int -> full -> full take = genericTake {- | Drops the first n elements of the list. See also 'genericDrop' -} drop :: Int -> full -> full drop = genericDrop {- | Equivalent to @('take' n xs, 'drop' n xs)@. See also 'genericSplitAt'. -} splitAt :: Int -> full -> (full, full) splitAt = genericSplitAt {- | Returns all elements at start of list that satisfy the function. -} takeWhile :: (item -> Bool) -> full -> full takeWhile func l | null l = empty | func x = cons x (takeWhile func (tail l)) | otherwise = empty where x = head l {- | Drops all elements from the start of the list that satisfy the function. -} dropWhile :: (item -> Bool) -> full -> full dropWhile func l | null l = empty | func (head l) = dropWhile func (tail l) | otherwise = l {- | Drops all elements from the end of the list that satisfy the function. -} dropWhileEnd :: (item -> Bool) -> full -> full dropWhileEnd func = foldr (\x xs -> if func x && null xs then empty else cons x xs) empty {- | The equivalent of @('takeWhile' f xs, 'dropWhile' f xs)@ -} span :: (item -> Bool) -> full -> (full, full) span func l | null l = (empty, empty) | func x = (cons x ys, zs) | otherwise = (empty, l) where (ys, zs) = span func (tail l) x = head l {- | The equivalent of @'span' ('not' . f)@ -} break :: (item -> Bool) -> full -> (full, full) break p = span (not . p) {- | Split a list into sublists, each which contains equal arguments. For order-preserving types, concatenating these sublists will produce the original list. See also 'groupBy'. -} group :: (ListLike full' full, Eq item) => full -> full' group = groupBy (==) {- | All initial segments of the list, shortest first -} inits :: (ListLike full' full) => full -> full' inits l | null l = singleton empty | otherwise = append (singleton empty) (map (cons (head l)) theinits) where theinits = asTypeOf (inits (tail l)) [l] {- | All final segnemts, longest first -} tails :: ListLike full' full => full -> full' tails l | null l = singleton empty | otherwise = cons l (tails (tail l)) ------------------------------ Predicates {- | True when the first list is at the beginning of the second. -} isPrefixOf :: Eq item => full -> full -> Bool isPrefixOf needle haystack | null needle = True | null haystack = False | otherwise = (head needle) == (head haystack) && isPrefixOf (tail needle) (tail haystack) {- | True when the first list is at the beginning of the second. -} isSuffixOf :: Eq item => full -> full -> Bool isSuffixOf needle haystack = isPrefixOf (reverse needle) (reverse haystack) {- | True when the first list is wholly containted within the second -} isInfixOf :: Eq item => full -> full -> Bool isInfixOf needle haystack = any (isPrefixOf needle) thetails where thetails = asTypeOf (tails haystack) [haystack] ------------------------------ Searching {- | True if the item occurs in the list -} elem :: Eq item => item -> full -> Bool elem i = any (== i) {- | True if the item does not occur in the list -} notElem :: Eq item => item -> full -> Bool notElem i = all (/= i) {- | Take a function and return the first matching element, or Nothing if there is no such element. -} find :: (item -> Bool) -> full -> Maybe item find f l = case findIndex f l of Nothing -> Nothing Just x -> Just (index l x) {- | Returns only the elements that satisfy the function. -} 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) {- | Returns the lists that do and do not satisfy the function. Same as @('filter' p xs, 'filter' ('not' . p) xs)@ -} partition :: (item -> Bool) -> full -> (full, full) partition p xs = (filter p xs, filter (not . p) xs) ------------------------------ Indexing {- | 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 | null l = error "index: index not found" | i < 0 = error "index: index must be >= 0" | i == 0 = head l | otherwise = index (tail l) (i - 1) {- | Returns the index of the element, if it exists. -} elemIndex :: Eq item => item -> full -> Maybe Int elemIndex e l = findIndex (== e) l {- | 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 {- | Take a function and return the index of the first matching element, or Nothing if no element matches -} findIndex :: (item -> Bool) -> full -> Maybe Int findIndex f = listToMaybe . findIndices f {- | Returns the indices of all elements satisfying the function -} findIndices :: (ListLike result Int) => (item -> Bool) -> full -> result findIndices p xs = map snd $ filter (p . fst) $ thezips where thezips = asTypeOf (zip xs [0..]) [(head xs, 0::Int)] ------------------------------ Monadic operations {- | Evaluate each action in the sequence and collect the results -} sequence :: (Monad 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) {- | A map in monad space. Same as @'sequence' . 'map'@ See also 'rigidMapM' -} mapM :: (Monad m, ListLike full' item') => (item -> m item') -> full -> m full' mapM func l = sequence mapresult where mapresult = asTypeOf (map func l) [] {- | Like 'mapM', but without the possibility of changing the type of the item. This can have performance benefits with some types. -} rigidMapM :: Monad m => (item -> m item) -> full -> m full rigidMapM = mapM ------------------------------ "Set" operations {- | Removes duplicate elements from the list. See also 'nubBy' -} nub :: Eq item => full -> full nub = nubBy (==) {- | Removes the first instance of the element from the list. See also 'deleteBy' -} delete :: Eq item => item -> full -> full delete = deleteBy (==) {- | List difference. Removes from the first list the first instance of each element of the second list. See '(\\)' and 'deleteFirstsBy' -} deleteFirsts :: Eq item => full -> full -> full deleteFirsts = foldl (flip delete) {- | List union: the set of elements that occur in either list. Duplicate elements in the first list will remain duplicate. See also 'unionBy'. -} union :: Eq item => full -> full -> full union = unionBy (==) {- | List intersection: the set of elements that occur in both lists. See also 'intersectBy' -} intersect :: Eq item => full -> full -> full intersect = intersectBy (==) ------------------------------ Ordered lists {- | Sorts the list. On data types that do not preserve ordering, or enforce their own ordering, the result may not be what you expect. See also 'sortBy'. -} sort :: Ord item => full -> full 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 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 = 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 {- | Generates the structure from a list. -} fromList :: [item] -> full fromList [] = empty fromList (x:xs) = cons x (fromList xs) {- | Converts one ListLike to another. See also 'toList'. Default implementation is @fromListLike = map id@ -} fromListLike :: ListLike full' item => full -> full' fromListLike = map id ------------------------------ Generalized functions {- | Generic version of 'nub' -} 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 f l | null l = empty | otherwise = cons (head l) (nubBy f (filter (\y -> not (f (head l) y)) (tail l))) -} {- | Generic version of 'deleteBy' -} deleteBy :: (item -> item -> Bool) -> item -> full -> full deleteBy func i l | null l = empty | otherwise = if func i (head l) then tail l else cons (head l) (deleteBy func i (tail l)) {- | Generic version of 'deleteFirsts' -} deleteFirstsBy :: (item -> item -> Bool) -> full -> full -> full deleteFirstsBy func = foldl (flip (deleteBy func)) {- | Generic version of 'union' -} unionBy :: (item -> item -> Bool) -> full -> full -> full unionBy func x y = append x $ foldl (flip (deleteBy func)) (nubBy func y) x {- | Generic version of 'intersect' -} intersectBy :: (item -> item -> Bool) -> full -> full -> full intersectBy func xs ys = filter (\x -> any (func x) ys) xs {- | Generic version of 'group'. -} groupBy :: (ListLike full' full, Eq item) => (item -> item -> Bool) -> full -> full' groupBy eq l | null l = empty | otherwise = cons (cons x ys) (groupBy eq zs) where (ys, zs) = span (eq x) xs x = head l xs = tail l {- | Sort function taking a custom comparison function -} 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)) _ -> cons x ys ------------------------------ Generic Operations {- | Length of the list -} genericLength :: Num a => full -> a genericLength l = calclen 0 l where calclen !accum cl = if null cl then accum else calclen (accum + 1) (tail cl) {- | Generic version of 'take' -} genericTake :: Integral a => a -> full -> full genericTake n l | n <= 0 = empty | null l = empty | otherwise = cons (head l) (genericTake (n - 1) (tail l)) {- | Generic version of 'drop' -} genericDrop :: Integral a => a -> full -> full genericDrop n l | n <= 0 = l | null l = l | otherwise = genericDrop (n - 1) (tail l) {- | Generic version of 'splitAt' -} genericSplitAt :: Integral a => a -> full -> (full, full) genericSplitAt n l = (genericTake n l, genericDrop n l) {- | Generic version of 'replicate' -} genericReplicate :: Integral a => a -> item -> full genericReplicate count x | count <= 0 = empty | otherwise = map (\_ -> x) [1..count] {- instance (ListLike full item) => Monad full where m >>= k = foldr (append . k) empty m m >> k = foldr (append . (\_ -> k)) empty m return x = singleton x fail _ = empty instance (ListLike full item) => M.MonadPlus full where mzero = empty mplus = append -} {- | An extension to 'ListLike' for those data types that are capable of dealing with infinite lists. Some 'ListLike' functions are capable of working with finite or infinite lists. The functions here require infinite list capability in order to work at all. -} class (ListLike full item) => InfiniteListLike full item | full -> item where {- | An infinite list of repeated calls of the function to args -} iterate :: (item -> item) -> item -> full iterate f x = cons x (iterate f (f x)) {- | An infinite list where each element is the same -} repeat :: item -> full repeat x = xs where xs = cons x xs {- | Converts a finite list into a circular one -} cycle :: full -> full cycle xs | null xs = error "ListLike.cycle: empty list" | otherwise = xs' where xs' = append xs xs' -------------------------------------------------- -- This instance is here due to some default class functions instance ListLike [a] a where empty = [] singleton x = [x] cons x l = x : l snoc l x = l ++ [x] append = (++) head = L.head last = L.last tail = L.tail init = L.init null = L.null length = L.length map f = fromList . L.map f 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 rigidConcatMap = L.concatMap any = L.any all = L.all maximum = L.maximum minimum = L.minimum -- fold -- foldMap replicate = L.replicate take = L.take drop = L.drop splitAt = L.splitAt takeWhile = L.takeWhile dropWhile = L.dropWhile span = L.span break = L.break group = fromList . L.group inits = fromList . L.inits tails = fromList . L.tails isPrefixOf = L.isPrefixOf isSuffixOf = L.isSuffixOf isInfixOf = L.isInfixOf elem = L.elem notElem = L.notElem find = L.find filter = L.filter partition = L.partition index = (L.!!) elemIndex = L.elemIndex elemIndices item = fromList . L.elemIndices item findIndex = L.findIndex sequence = M.sequence . toList -- mapM = M.mapM nub = L.nub delete = L.delete deleteFirsts = (L.\\) union = L.union intersect = L.intersect sort = L.sort groupBy func = fromList . L.groupBy func unionBy = L.unionBy intersectBy = L.intersectBy sortBy = L.sortBy insert = L.insert genericLength = L.genericLength -------------------------------------------------- -- These utils are here instead of in Utils.hs because they are needed -- by default class functions {- | Takes two lists and returns a list of corresponding pairs. -} zip :: (ListLike full item, ListLike fullb itemb, ListLike result (item, itemb)) => full -> fullb -> result zip = zipWith (\a b -> (a, b)) {- | Takes two lists and combines them with a custom combining function -} zipWith :: (ListLike full item, ListLike fullb itemb, ListLike result resultitem) => (item -> itemb -> resultitem) -> full -> fullb -> result zipWith f a b | null a = empty | null b = empty | otherwise = cons (f (head a) (head b)) (zipWith f (tail a) (tail b)) ListLike-4.2.1/src/Data/ListLike/FoldableLL.hs0000644000000000000000000000736412606470212017112 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.FoldableLL Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable Generic tools for data structures that can be folded. Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.FoldableLL (-- * FoldableLL Class FoldableLL(..), -- * Utilities fold, foldMap, foldM, sequence_, mapM_ ) 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 foldable. A minimum complete definition provides 'foldl' and 'foldr'. Instances of 'FoldableLL' can be folded, and can be many and varied. These functions are used heavily in "Data.ListLike". -} class FoldableLL full item | full -> item where {- | Left-associative fold -} foldl :: (a -> item -> a) -> a -> full -> a {- | Strict version of 'foldl'. -} foldl' :: (a -> item -> a) -> a -> full -> a -- This implementation from Data.Foldable foldl' f a xs = foldr f' id xs a where f' x k z = k $! f z x -- | A variant of 'foldl' with no base case. Requires at least 1 -- list element. foldl1 :: (item -> item -> item) -> full -> item -- This implementation from Data.Foldable foldl1 f xs = fromMaybe (error "fold1: empty structure") (foldl mf Nothing xs) where mf Nothing y = Just y mf (Just x) y = Just (f x y) {- | Right-associative fold -} foldr :: (item -> b -> b) -> b -> full -> b -- | Strict version of 'foldr' foldr' :: (item -> b -> b) -> b -> full -> b -- This implementation from Data.Foldable foldr' f a xs = foldl f' id xs a where f' k x z = k $! f x z -- | Like 'foldr', but with no starting value foldr1 :: (item -> item -> item) -> full -> item -- This implementation from Data.Foldable foldr1 f xs = fromMaybe (error "foldr1: empty structure") (foldr mf Nothing xs) where mf x Nothing = Just x mf x (Just y) = Just (f x y) {- | Combine the elements of a structure using a monoid. @'fold' = 'foldMap' id@ -} fold :: (FoldableLL full item, Monoid item) => full -> item fold = foldMap id {- | Map each element to a monoid, then combine the results -} foldMap :: (FoldableLL full item, Monoid m) => (item -> m) -> full -> m foldMap f = foldr (mappend . f) mempty instance FoldableLL [a] a where foldl = L.foldl foldl1 = L.foldl1 foldl' = L.foldl' foldr = L.foldr foldr1 = L.foldr1 foldr' = F.foldr' {- instance (F.Foldable f) => FoldableLL (f a) a where foldl = F.foldl foldl1 = F.foldl1 foldl' = F.foldl' foldr = F.foldr foldr1 = F.foldr1 foldr' = F.foldr' -} -- Based on http://stackoverflow.com/a/12881193/1333025 {- | Monadic version of left fold, similar to 'Control.Monad.foldM'. -} foldM :: (Monad m, FoldableLL full item) => (a -> item -> m a) -> a -> full -> m a foldM f z xs = foldr (\x rest a -> f a x >>= rest) return xs z {- | A map in monad space, discarding results. -} mapM_ :: (Monad m, FoldableLL full item) => (item -> m b) -> full -> m () mapM_ func = foldr ((>>) . func) (return ()) {- | Evaluate each action, ignoring the results. Same as @'mapM_' 'id'@. -} sequence_ :: (Monad m, FoldableLL full (m item)) => full -> m () sequence_ = mapM_ id ListLike-4.2.1/src/Data/ListLike/Instances.hs0000644000000000000000000004215612606470212017077 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances ,TypeSynonymInstances #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.Instances Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable Instances of 'Data.ListLike.ListLike' and related classes. Re-exported by "Data.ListLike". Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.Instances () 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, 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) import qualified Prelude as P import Control.Monad import qualified Data.List as L import qualified Data.Sequence as S import Data.Sequence ((><), (|>), (<|)) import qualified Data.Foldable as F import Data.ListLike.Base import Data.ListLike.String import Data.ListLike.IO import Data.ListLike.FoldableLL import Data.ListLike.Text () import Data.ListLike.Vector () import Data.Int import Data.Monoid 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.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 qualified System.IO as IO import Data.Word -------------------------------------------------- -- [] -- Basic list instance is in Base.hs -- FoldableLL instance implied by Foldable 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) hPutStr = IO.hPutStr hPutStrLn = IO.hPutStrLn getLine = IO.getLine getContents = IO.getContents putStr = IO.putStr putStrLn = IO.putStrLn interact = IO.interact readFile = IO.readFile writeFile = IO.writeFile instance StringLike String where toString = id fromString = id instance InfiniteListLike [a] a where iterate = L.iterate repeat = L.repeat cycle = L.cycle -------------------------------------------------- -- ByteString instance FoldableLL BS.ByteString Word8 where foldl = BS.foldl foldl' = BS.foldl' foldl1 = BS.foldl1 foldr = BS.foldr foldr' = BS.foldr' foldr1 = BS.foldr1 instance ListLike BS.ByteString Word8 where empty = BS.empty singleton = BS.singleton cons = BS.cons snoc = BS.snoc append = BS.append head = BS.head last = BS.last tail = BS.tail init = BS.init null = BS.null length = BS.length -- map = rigidMap = BS.map reverse = BS.reverse intersperse = BS.intersperse concat = BS.concat . toList --concatMap = rigidConcatMap = BS.concatMap any = BS.any all = BS.all maximum = BS.maximum minimum = BS.minimum replicate = BS.replicate take = BS.take drop = BS.drop splitAt = BS.splitAt takeWhile = BS.takeWhile dropWhile = BS.dropWhile span = BS.span break = BS.break group = fromList . BS.group inits = fromList . BS.inits tails = fromList . BS.tails isPrefixOf = BS.isPrefixOf isSuffixOf = BS.isSuffixOf --isInfixOf = BS.isInfixOf elem = BS.elem notElem = BS.notElem find = BS.find filter = BS.filter --partition = BS.partition index = BS.index elemIndex = BS.elemIndex elemIndices x = fromList . BS.elemIndices x findIndex = BS.findIndex 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 --nub = BS.nub --delete = BS.delete --deleteFirsts = BS.deleteFirsts --union = BS.union --intersect = BS.intersect sort = BS.sort --insert = BS.insert toList = BS.unpack fromList = BS.pack fromListLike = fromList . toList --nubBy = BS.nubBy --deleteBy = BS.deleteBy --deleteFirstsBy = BS.deleteFirstsBy --unionBy = BS.unionBy --intersectBy = BS.intersectBy groupBy f = fromList . BS.groupBy f --sortBy = BS.sortBy --insertBy = BS.insertBy genericLength = fromInteger . fromIntegral . BS.length genericTake i = BS.take (fromIntegral i) genericDrop i = BS.drop (fromIntegral i) genericSplitAt i = BS.splitAt (fromIntegral i) genericReplicate i = BS.replicate (fromIntegral i) instance ListLikeIO BS.ByteString Word8 where hGetLine = BS.hGetLine hGetContents = BS.hGetContents hGet = BS.hGet hGetNonBlocking = BS.hGetNonBlocking hPutStr = BS.hPutStr hPutStrLn = BSC.hPutStrLn getLine = BS.getLine getContents = BS.getContents putStr = BS.putStr putStrLn = BSC.putStrLn interact = BS.interact readFile = BS.readFile writeFile = BS.writeFile appendFile = BS.appendFile instance StringLike BS.ByteString where toString = map (toEnum . fromIntegral) . BS.unpack fromString = BS.pack . map (fromIntegral . fromEnum) -------------------------------------------------- -- ByteString.Lazy instance FoldableLL BSL.ByteString Word8 where foldl = BSL.foldl foldl' = BSL.foldl' foldl1 = BSL.foldl1 foldr = BSL.foldr --foldr' = BSL.foldr' foldr1 = BSL.foldr1 mi64toi :: Maybe Int64 -> Maybe Int mi64toi Nothing = Nothing mi64toi (Just x) = Just (fromIntegral x) instance ListLike BSL.ByteString Word8 where empty = BSL.empty singleton = BSL.singleton cons = BSL.cons snoc = BSL.snoc append = BSL.append head = BSL.head last = BSL.last tail = BSL.tail init = BSL.init null = BSL.null length = fromIntegral . BSL.length -- map = BSL.map rigidMap = BSL.map reverse = BSL.reverse --intersperse = BSL.intersperse concat = BSL.concat . toList --concatMap = BSL.concatMap rigidConcatMap = BSL.concatMap any = BSL.any all = BSL.all maximum = BSL.maximum minimum = BSL.minimum replicate i = BSL.replicate (fromIntegral i) take i = BSL.take (fromIntegral i) drop i = BSL.drop (fromIntegral i) splitAt i = BSL.splitAt (fromIntegral i) takeWhile = BSL.takeWhile dropWhile = BSL.dropWhile span = BSL.span break = BSL.break group = fromList . BSL.group inits = fromList . BSL.inits tails = fromList . BSL.tails isPrefixOf = BSL.isPrefixOf --isSuffixOf = BSL.isSuffixOf --isInfixOf = BSL.isInfixOf elem = BSL.elem notElem = BSL.notElem find = BSL.find filter = BSL.filter --partition = BSL.partition index l i = BSL.index l (fromIntegral 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 = BSL.sequence --mapM = BSL.mapM --mapM_ = BSL.mapM_ --nub = BSL.nub --delete = BSL.delete --deleteFirsts = BSL.deleteFirsts --union = BSL.union --intersect = BSL.intersect --sort = BSL.sort --insert = BSL.insert toList = BSL.unpack fromList = BSL.pack fromListLike = fromList . toList --nubBy = BSL.nubBy --deleteBy = BSL.deleteBy --deleteFirstsBy = BSL.deleteFirstsBy --unionBy = BSL.unionBy --intersectBy = BSL.intersectBy -- BSL.groupBy is broken. groupBy f = fromList . BSL.groupBy f -- the below works on ghc but generates a type error on hugs -- groupBy func = map fromList . L.groupBy func . toList --sortBy = BSL.sortBy --insertBy = BSL.insertBy genericLength = fromInteger . fromIntegral . BSL.length genericTake i = BSL.take (fromIntegral i) genericDrop i = BSL.drop (fromIntegral i) genericSplitAt i = BSL.splitAt (fromIntegral i) genericReplicate i = BSL.replicate (fromIntegral i) strict2lazy :: BS.ByteString -> IO BSL.ByteString strict2lazy b = return (BSL.fromChunks [b]) instance ListLikeIO BSL.ByteString Word8 where hGetLine h = BS.hGetLine h >>= strict2lazy hGetContents = BSL.hGetContents hGet = BSL.hGet hGetNonBlocking = BSL.hGetNonBlocking hPutStr = BSL.hPut -- hPutStrLn = BSLC.hPutStrLn getLine = BS.getLine >>= strict2lazy getContents = BSL.getContents putStr = BSL.putStr putStrLn = BSLC.putStrLn interact = BSL.interact readFile = BSL.readFile writeFile = BSL.writeFile appendFile = BSL.appendFile instance StringLike BSL.ByteString where toString = map (toEnum . fromIntegral) . BSL.unpack fromString = BSL.pack . map (fromIntegral . fromEnum) -------------------------------------------------- -- Map -- N.B. the Map instance is broken because it treats the key as part of the -- element. Consider: -- let m = fromList [(False,0)] :: Map Bool Int -- let m' = cons (False, 1) m -- m' == fromList [(False,1)] =/= [(False,1), (False,0)] -- Map isn't a suitable candidate for ListLike... -------------------------------------------------- -- Arrays instance (Ix i) => FoldableLL (A.Array i e) e where foldl = F.foldl foldl1 = F.foldl1 foldl' = F.foldl' foldr = F.foldr foldr1 = F.foldr1 foldr' = F.foldr' 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 instance (Integral i, Ix i) => ListLike (A.Array i e) e where empty = mempty singleton i = A.listArray (0, 0) [i] 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 = -- 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 append = mappend head l = l ! (fst (A.bounds l)) last l = l ! (snd (A.bounds l)) tail l = A.array (blow + 1, bhigh) (tail (A.assocs l)) where (blow, bhigh) = A.bounds l init l = A.array (blow, bhigh - 1) (init (A.assocs l)) where (blow, bhigh) = A.bounds l null l = genericLength l == (0::Integer) length = genericLength -- map rigidMap = A.amap reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l)) -- intersperse -- concat -- concatMap -- rigidConcatMap any x = L.any x . A.elems all x = L.all x . A.elems maximum = L.maximum . A.elems minimum = L.minimum . A.elems replicate = genericReplicate take = genericTake drop = genericDrop -- splitAt -- takeWhile -- dropWhile -- span -- break -- group -- inits -- tails isPrefixOf l1 l2 = L.isPrefixOf (toList l1) (toList l2) isSuffixOf l1 l2 = L.isSuffixOf (toList l1) (toList l2) isInfixOf l1 l2 = L.isInfixOf (toList l1) (toList l2) elem i l = L.elem i (toList l) -- notElem filter f = fromList . L.filter f . toList -- partition index l i = l ! ((fromIntegral i) + offset) where offset = (fst $ A.bounds l) elemIndex i = L.elemIndex i . toList 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 -- rigidMapM = mapM nub = fromList . L.nub . toList -- delete -- deleteFirsts -- union -- 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 -- deleteFirstsBy -- unionBy -- intersectBy -- groupBy sortBy f l = A.listArray (A.bounds l) (L.sortBy f (A.elems l)) -- insertBy genericLength l = fromIntegral (bhigh - blow + 1) where (blow, bhigh) = A.bounds l genericTake count l | count > genericLength l = l | count <= 0 = empty | otherwise = A.listArray (blow, blow + (fromIntegral count) - 1) (L.genericTake count (A.elems l)) where (blow, _) = A.bounds l genericDrop count l = A.listArray (blow + (fromIntegral count), bhigh) (L.genericDrop count (A.elems l)) where (blow, bhigh) = A.bounds l -- geneicSplitAt genericReplicate count i = A.listArray (0, (fromIntegral count) - 1) (L.genericReplicate count i) instance (Integral i, Ix i) => StringLike (A.Array i Char) where toString = toList fromString = fromList -- lines -- words instance (Integral i, Ix i) => ListLikeIO (A.Array i Char) Char where hGetLine h = IO.hGetLine h >>= (return . fromList) hGetContents h = IO.hGetContents h >>= (return . fromList) hGet h i = ((hGet h i)::IO String) >>= (return . fromList) hGetNonBlocking h i = ((hGetNonBlocking h i):: IO String) >>= (return . fromList) hPutStr h = hPutStr h . toString hPutStrLn h = hPutStrLn h . toString getLine = IO.getLine >>= (return . fromString) getContents = IO.getContents >>= (return . fromString) putStr = IO.putStr . toString putStrLn = IO.putStrLn . toString -- interact -- readFile -- writeFile -- appendFile -- --------------------------- -- Data.Sequence instances instance ListLikeIO (S.Seq Char) Char where hGetLine h = IO.hGetLine h >>= (return . fromList) hGetContents h = IO.hGetContents h >>= (return . fromList) hGet h i = ((hGet h i)::IO String) >>= (return . fromList) hGetNonBlocking h i = ((hGetNonBlocking h i):: IO String) >>= (return . fromList) hPutStr h = hPutStr h . toString hPutStrLn h = hPutStrLn h . toString getLine = IO.getLine >>= (return . fromString) getContents = IO.getContents >>= (return . fromString) putStr = IO.putStr . toString putStrLn = IO.putStrLn . toString -- interact -- readFile -- writeFile -- appendFile instance StringLike (S.Seq Char) where toString = toList fromString = fromList instance FoldableLL (S.Seq a) a where foldl = F.foldl foldl' = F.foldl' foldl1 = F.foldl1 foldr = F.foldr foldr' = F.foldr' foldr1 = F.foldr1 instance ListLike (S.Seq a) a where empty = S.empty singleton = S.singleton cons = (<|) snoc = (|>) append = (><) head s = let (a S.:< _) = S.viewl s in a last s = let (_ S.:> a) = S.viewr s in a tail s = S.index (S.tails s) 1 init s = S.index (S.inits s) (S.length s - 1) null = S.null length = S.length map f = fromList . toList . fmap f --rigidMap = reverse = S.reverse --intersperse = --concat = --concatMap = --rigidConcatMap = any = F.any all = F.all maximum = F.maximum minimum = F.minimum replicate n = S.replicate (if n >= 0 then n else 0) take = S.take drop = S.drop splitAt = S.splitAt --takeWhile = --dropWhile = span = S.spanl -- break = --group = inits = fromList . toList . S.inits tails = fromList . toList . S.tails --isPrefixOf = --isSuffixOf = --isInfixOf = --elem = --notElem = --find = filter = S.filter partition = S.partition index = S.index elemIndex = S.elemIndexL elemIndices p = fromList . S.elemIndicesL p findIndex = S.findIndexL findIndices p = fromList . S.findIndicesL p --sequence = --mapM f = --nub = --delete = --deleteFirsts = --union = --intersect = sort = S.sort --insert = S.insert toList = F.toList fromList = S.fromList fromListLike = fromList . toList --nubBy = --deleteBy = --deleteFirstsBy = --unionBy = --intersectBy = --groupBy f = sortBy = S.sortBy --insertBy = genericLength = fromInteger . fromIntegral . S.length genericTake i = S.take (fromIntegral i) genericDrop i = S.drop (fromIntegral i) genericSplitAt i = S.splitAt (fromIntegral i) genericReplicate i = S.replicate (fromIntegral i) ListLike-4.2.1/src/Data/ListLike/IO.hs0000644000000000000000000000726712606470212015463 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FunctionalDependencies #-} {- Copyright (C) 2007 John Goerzen All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.IO Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato Stability : provisional Portability: portable String-like functions Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.IO ( ListLikeIO(..) ) 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, 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, putStr, getContents) import qualified System.IO as IO import Data.ListLike.Base {- | An extension to 'ListLike' for those data types that support I\/O. These functions mirror those in "System.IO" for the most part. They also share the same names; see the comments in "Data.ListLike" for help importing them. 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 * hGetContents * hGet * hGetNonBlocking * hPutStr -} class (ListLike full item) => ListLikeIO full item | full -> item where {- | Reads a line from the specified handle -} hGetLine :: IO.Handle -> IO full -- | Read entire handle contents. May be done lazily like -- 'System.IO.hGetContents'. hGetContents :: IO.Handle -> IO full -- | Read specified number of bytes. See 'System.IO.hGet' for -- particular semantics. hGet :: IO.Handle -> Int -> IO full -- | Non-blocking read. See 'System.IO.hGetNonBlocking' for more. hGetNonBlocking :: IO.Handle -> Int -> IO full -- | Writing entire data. hPutStr :: IO.Handle -> full -> IO () -- | Write data plus newline character. hPutStrLn :: IO.Handle -> full -> IO () hPutStrLn fp x = do hPutStr fp x IO.hPutStrLn fp "" -- | Read one line getLine :: IO full getLine = hGetLine IO.stdin -- | Read entire content from stdin. See 'hGetContents'. getContents :: IO full getContents = hGetContents IO.stdin -- | Write data to stdout. putStr :: full -> IO () putStr = hPutStr IO.stdout -- | Write data plus newline character to stdout. putStrLn :: full -> IO () putStrLn = hPutStrLn IO.stdout -- | 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 = do c <- getContents putStr (func c) -- | Read file. May be lazy. readFile :: FilePath -> IO full readFile fn = do fp <- IO.openFile fn IO.ReadMode hGetContents fp -- | Write data to file. writeFile :: FilePath -> full -> IO () writeFile fn x = do fp <- IO.openFile fn IO.WriteMode hPutStr fp x IO.hClose fp -- | Append data to file. appendFile :: FilePath -> full -> IO () appendFile fn x = do fp <- IO.openFile fn IO.AppendMode hPutStr fp x IO.hClose fp ListLike-4.2.1/src/Data/ListLike/Text.hs0000644000000000000000000000025612606470212016067 0ustar0000000000000000module Data.ListLike.Text ( module Data.ListLike.Text.Text ,module Data.ListLike.Text.TextLazy ) where import Data.ListLike.Text.Text import Data.ListLike.Text.TextLazy ListLike-4.2.1/src/Data/ListLike/FMList.hs0000644000000000000000000000351412606470212016301 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} -- | 'Data.ListLike.ListLike' instances for 'Data.FMList.FMList' module Data.ListLike.FMList () where import qualified Prelude as P import Data.ListLike.Base import Data.ListLike.FoldableLL import Data.ListLike.IO import Data.ListLike.String import Data.FMList (FMList(..)) import qualified Data.FMList as FM 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.String as S import Control.Monad.Zip (MonadZip) import qualified Control.Monad.Zip as Z import Data.Function import Data.Char (Char(..)) instance FoldableLL (FMList a) a where foldl = F.foldl foldr = F.foldr foldl1 = F.foldl1 foldr1 = F.foldr1 foldl' = F.foldl' foldr' = F.foldr' instance ListLike (FMList a) a where empty = FM.empty singleton = FM.singleton cons = FM.cons snoc = FM.snoc append = FM.append head = FM.head tail = FM.tail last = FM.last init = FM.init fromList = FM.fromList toList = FM.toList null = FM.null genericLength = FM.genericLength length = FM.length reverse = FM.reverse filter = FM.filter take = FM.take takeWhile = FM.takeWhile drop = FM.drop dropWhile = FM.dropWhile instance InfiniteListLike (FMList a) a where iterate = FM.iterate repeat = FM.repeat cycle a = (a `FM.append` cycle a) `FM.append` a instance IsString (FMList Char) where 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 unlines = FM.fromList . S.unlines . map FM.toList unwords = FM.fromList . S.unwords . map FM.toList instance MonadZip FMList where mzipWith = FM.zipWith ListLike-4.2.1/src/Data/ListLike/Text/0000755000000000000000000000000012606470212015530 5ustar0000000000000000ListLike-4.2.1/src/Data/ListLike/Text/TextLazy.hs0000644000000000000000000000546412606470212017661 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances #-} 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) import Data.ListLike.Base as LL import Data.ListLike.FoldableLL import Data.ListLike.IO import Data.ListLike.String import qualified Data.ByteString as BS instance FoldableLL T.Text Char where foldl = T.foldl foldl' = T.foldl' foldl1 = T.foldl1 foldr = T.foldr foldr1 = T.foldr1 instance ListLike T.Text Char where empty = T.empty singleton = T.singleton cons = T.cons snoc = T.snoc append = T.append head = T.head last = T.last tail = T.tail init = T.init null = T.null length = fromIntegral . T.length rigidMap = T.map reverse = T.reverse intersperse = T.intersperse concat = T.concat . toList rigidConcatMap = T.concatMap any = T.any all = T.all maximum = T.maximum minimum = T.minimum replicate n = T.replicate (fromIntegral n) . T.singleton take = T.take . fromIntegral drop = T.drop . fromIntegral splitAt = T.splitAt . fromIntegral takeWhile = T.takeWhile dropWhile = T.dropWhile span = T.span break = T.break group = fromList . T.group inits = fromList . T.inits tails = fromList . T.tails isPrefixOf = T.isPrefixOf isSuffixOf = T.isSuffixOf 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 groupBy f = fromList . T.groupBy f genericLength = fromInteger . fromIntegral . T.length genericTake i = T.take (fromIntegral i) genericDrop i = T.drop (fromIntegral i) 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 instance ListLikeIO T.Text Char where hGetLine = TI.hGetLine hGetContents = TI.hGetContents hGet h = fmap (T.fromStrict . decodeUtf8) . BS.hGet h hGetNonBlocking h = fmap (T.fromStrict . decodeUtf8) . BS.hGetNonBlocking h hPutStr = TI.hPutStr hPutStrLn = TI.hPutStrLn getLine = TI.getLine getContents = TI.getContents putStr = TI.putStr putStrLn = TI.putStrLn interact = TI.interact readFile = TI.readFile writeFile = TI.writeFile appendFile = TI.appendFile 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 ListLike-4.2.1/src/Data/ListLike/Text/Text.hs0000644000000000000000000000535612606470212017021 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances #-} 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 Data.Text.Encoding (decodeUtf8) import Data.ListLike.Base as LL import Data.ListLike.FoldableLL import Data.ListLike.IO import Data.ListLike.String import qualified Data.ByteString as BS instance FoldableLL T.Text Char where foldl = T.foldl foldl' = T.foldl' foldl1 = T.foldl1 foldr = T.foldr --foldr' = T.foldr' foldr1 = T.foldr1 instance ListLike T.Text Char where empty = T.empty singleton = T.singleton cons = T.cons snoc = T.snoc append = T.append head = T.head last = T.last tail = T.tail init = T.init null = T.null length = T.length rigidMap = T.map reverse = T.reverse intersperse = T.intersperse concat = T.concat . toList rigidConcatMap = T.concatMap any = T.any all = T.all maximum = T.maximum minimum = T.minimum replicate n = T.replicate n . T.singleton take = T.take drop = T.drop splitAt = T.splitAt takeWhile = T.takeWhile dropWhile = T.dropWhile span = T.span break = T.break group = fromList . T.group inits = fromList . T.inits tails = fromList . T.tails isPrefixOf = T.isPrefixOf isSuffixOf = T.isSuffixOf 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 groupBy f = fromList . T.groupBy f genericLength = fromInteger . fromIntegral . T.length genericTake i = T.take (fromIntegral i) genericDrop i = T.drop (fromIntegral i) 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 instance ListLikeIO T.Text Char where hGetLine = TI.hGetLine hGetContents = TI.hGetContents hGet h c = BS.hGet h c >>= return . decodeUtf8 hGetNonBlocking h i = BS.hGetNonBlocking h i >>= return . decodeUtf8 hPutStr = TI.hPutStr hPutStrLn = TI.hPutStrLn getLine = TI.getLine getContents = TI.getContents putStr = TI.putStr putStrLn = TI.putStrLn interact = TI.interact readFile = TI.readFile writeFile = TI.writeFile appendFile = TI.appendFile 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 ListLike-4.2.1/src/Data/ListLike/Vector/0000755000000000000000000000000012606470212016046 5ustar0000000000000000ListLike-4.2.1/src/Data/ListLike/Vector/Vector.hs0000644000000000000000000000517112606470212017650 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances #-} 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 instance FoldableLL (V.Vector a) a where foldl = V.foldl foldl' = V.foldl' foldl1 = V.foldl1 foldr = V.foldr foldr' = V.foldr' foldr1 = V.foldr1 instance ListLike (V.Vector a) a where empty = V.empty singleton = V.singleton cons = V.cons snoc = V.snoc append = mappend head = V.head last = V.last tail = V.tail init = V.init null = V.null length = V.length rigidMap = V.map reverse = V.reverse --intersperse = concat = V.concat . toList rigidConcatMap = V.concatMap any = V.any all = V.all maximum = V.maximum minimum = V.minimum replicate = V.replicate take = V.take drop = V.drop --splitAt = takeWhile = V.takeWhile dropWhile = V.dropWhile span = V.span break = V.break --group = --inits = --tails = isPrefixOf = isPrefixOf' isSuffixOf = isSuffixOf' elem = V.elem find = V.find filter = V.filter index = (!) findIndex = V.findIndex 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 = genericReplicate i = V.replicate (fromIntegral i) sequence = liftM fromList . P.sequence . toList mapM func = liftM fromList . P.mapM func . toList 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' 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' needle haystack | V.null needle = True | V.length needle < V.length haystack = needle == V.slice (V.length haystack - V.length needle) (V.length needle) haystack | V.length needle == V.length haystack = needle == haystack | otherwise = False ListLike-4.2.1/src/Data/ListLike/Vector/Storable.hs0000644000000000000000000000533012606470212020156 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances #-} 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.Monoid import Foreign.Storable (Storable) instance Storable a => FoldableLL (V.Vector a) a where foldl = V.foldl foldl' = V.foldl' foldl1 = V.foldl1 foldr = V.foldr foldr' = V.foldr' foldr1 = V.foldr1 instance Storable a => ListLike (V.Vector a) a where empty = V.empty singleton = V.singleton cons = V.cons snoc = V.snoc append = mappend head = V.head last = V.last tail = V.tail init = V.init null = V.null length = V.length rigidMap = V.map reverse = V.reverse --intersperse = concat = V.concat . toList rigidConcatMap = V.concatMap any = V.any all = V.all maximum = V.maximum minimum = V.minimum replicate = V.replicate take = V.take drop = V.drop --splitAt = takeWhile = V.takeWhile dropWhile = V.dropWhile span = V.span break = V.break --group = --inits = --tails = isPrefixOf = isPrefixOf' isSuffixOf = isSuffixOf' elem = V.elem find = V.find filter = V.filter index = (!) findIndex = V.findIndex 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 = genericReplicate i = V.replicate (fromIntegral i) sequence = liftM fromList . P.sequence . toList mapM func = liftM fromList . P.mapM func . toList 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' 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' needle haystack | V.null needle = True | V.length needle < V.length haystack = needle == V.slice (V.length haystack - V.length needle) (V.length needle) haystack | V.length needle == V.length haystack = needle == haystack | otherwise = False ListLike-4.2.1/src/Data/ListLike/Vector/Generic.hs0000644000000000000000000000575212606470212017767 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleContexts ,FlexibleInstances ,OverlappingInstances ,UndecidableInstances #-} -- | ListLike instance for any type supporting the @Data.Vector.Generic@ -- interface. To avoid collisions with other Vector instances, this module -- must be imported directly. module Data.ListLike.Vector.Generic () 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 instance V.Vector v a => FoldableLL (v a) a where foldl = V.foldl foldl' = V.foldl' foldl1 = V.foldl1 foldr = V.foldr foldr' = V.foldr' foldr1 = V.foldr1 instance (Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where empty = V.empty singleton = V.singleton cons = V.cons snoc = V.snoc append = mappend head = V.head last = V.last tail = V.tail init = V.init null = V.null length = V.length rigidMap = V.map reverse = V.reverse --intersperse = concat = V.concat . toList rigidConcatMap = V.concatMap any = V.any all = V.all maximum = V.maximum minimum = V.minimum replicate = V.replicate take = V.take drop = V.drop --splitAt = takeWhile = V.takeWhile dropWhile = V.dropWhile span = V.span break = V.break --group = --inits = --tails = isPrefixOf = isPrefixOf' isSuffixOf = isSuffixOf' elem = V.elem find = V.find filter = V.filter index = (!) findIndex = V.findIndex 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 = genericReplicate i = V.replicate (fromIntegral i) sequence = liftM fromList . P.sequence . toList mapM func = liftM fromList . P.mapM func . toList 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' 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' needle haystack | V.null needle = True | V.length needle < V.length haystack = needle == V.slice (V.length haystack - V.length needle) (V.length needle) haystack | V.length needle == V.length haystack = needle == haystack | otherwise = False ListLike-4.2.1/src/Data/ListLike/Vector/Unboxed.hs0000644000000000000000000000525112606470212020011 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses ,FlexibleInstances #-} 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 instance Unbox a => FoldableLL (V.Vector a) a where foldl = V.foldl foldl' = V.foldl' foldl1 = V.foldl1 foldr = V.foldr foldr' = V.foldr' foldr1 = V.foldr1 instance Unbox a => ListLike (V.Vector a) a where empty = V.empty singleton = V.singleton cons = V.cons snoc = V.snoc append = mappend head = V.head last = V.last tail = V.tail init = V.init null = V.null length = V.length rigidMap = V.map reverse = V.reverse --intersperse = concat = V.concat . toList rigidConcatMap = V.concatMap any = V.any all = V.all maximum = V.maximum minimum = V.minimum replicate = V.replicate take = V.take drop = V.drop --splitAt = takeWhile = V.takeWhile dropWhile = V.dropWhile span = V.span break = V.break --group = --inits = --tails = isPrefixOf = isPrefixOf' isSuffixOf = isSuffixOf' elem = V.elem find = V.find filter = V.filter index = (!) findIndex = V.findIndex 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 = genericReplicate i = V.replicate (fromIntegral i) sequence = liftM fromList . P.sequence . toList mapM func = liftM fromList . P.mapM func . toList 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' 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' needle haystack | V.null needle = True | V.length needle < V.length haystack = needle == V.slice (V.length haystack - V.length needle) (V.length needle) haystack | V.length needle == V.length haystack = needle == haystack | otherwise = False