utility-ht-0.0.17.2/0000755000175000001440000000000014642227107015067 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/utility-ht.cabal0000644000175000001440000000611514642227107020172 0ustar00thielemausers00000000000000Cabal-Version: 2.2 Name: utility-ht Version: 0.0.17.2 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann Category: Data, List Synopsis: Various small helper functions for Lists, Maybes, Tuples, Functions Description: Various small helper functions for Lists, Maybes, Tuples, Functions. Some of these functions are improved implementations of standard functions. They have the same name as their standard counterparts. Others are equivalent to functions from the @base@ package, but if you import them from this utility package then you can write code that runs on older GHC versions or other compilers like Hugs and JHC. . All modules are plain Haskell 98. The package depends exclusively on the @base@ package and only that portions of @base@ that are simple to port. Thus you do not risk a dependency avalanche by importing it. However, further splitting the base package might invalidate this statement. . Alternative packages: @Useful@, @MissingH@ Tested-With: GHC==7.0.2, GHC==7.2.2, GHC==7.4.2, GHC==7.8.4 Tested-With: GHC==8.6.5, GHC==9.4.5, GHC==9.6.1 Build-Type: Simple Stability: Stable Extra-Source-Files: Makefile Source-Repository head type: darcs location: http://code.haskell.org/~thielema/utility/ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/utility/ tag: 0.0.17.2 Library Build-Depends: base >=2 && <5 Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: Data.Bits.HT Data.Bool.HT Data.Eq.HT Data.Function.HT Data.Ix.Enum Data.List.HT Data.List.Key Data.List.Match Data.List.Reverse.StrictElement Data.List.Reverse.StrictSpine Data.Maybe.HT Data.Either.HT Data.Monoid.HT Data.Ord.HT Data.Record.HT Data.String.HT Data.Tuple.HT Data.Tuple.Lazy Data.Tuple.Strict Control.Monad.HT Control.Applicative.HT Control.Functor.HT Data.Strictness.HT Text.Read.HT Text.Show.HT Other-Modules: Data.Bool.HT.Private Data.List.HT.Private Data.List.Key.Private Data.List.Match.Private Data.List.Reverse.Private Data.Function.HT.Private Data.Record.HT.Private Data.Tuple.Example Test-Suite test Type: exitcode-stdio-1.0 Build-Depends: QuickCheck >=1.1 && <3, doctest-exitcode-stdio >=0.0 && <0.1, doctest-lib >=0.1 && <0.1.2, base >=3 && <5 Default-Language: Haskell98 Main-Is: Test.hs GHC-Options: -Wall Hs-source-dirs: src Other-Modules: Test.Utility DocTest.Data.List.Reverse.StrictElement DocTest.Data.List.Reverse.StrictSpine DocTest.Data.List.Reverse.Private DocTest.Data.List.Match.Private DocTest.Data.List.HT.Private DocTest.Data.Monoid.HT DocTest.Data.Maybe.HT DocTest.Data.Bool.HT.Private DocTest.Data.Function.HT.Private DocTest.Data.Ix.Enum utility-ht-0.0.17.2/Setup.lhs0000644000175000001440000000011514642227107016674 0ustar00thielemausers00000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain utility-ht-0.0.17.2/LICENSE0000644000175000001440000000272114642227107016076 0ustar00thielemausers00000000000000Copyright (c) 2009, Henning Thielemann All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT OWNER 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. utility-ht-0.0.17.2/Makefile0000644000175000001440000000105314642227107016526 0ustar00thielemausers00000000000000ghci: ghci -i:src -Wall src/Data/List/HT.hs jhc: jhc -i src --build-hl utility-ht.jhc-cabal jhc-test: jhc -p utility-ht -i src src/Test.hs run-test: update-test runhaskell Setup configure --user --enable-tests runhaskell Setup build runhaskell Setup haddock runhaskell Setup test --show-details=streaming update-test: test-module.list doctest-extract-0.1 -i src/ -o src/ --module-prefix DocTest --executable-main=Test.hs --import-tested $$(cat test-module.list) test-module.list: utility-ht.cabal grep '^ \+DocTest\.' $< | cut -d. -f2- >$@ utility-ht-0.0.17.2/src/0000755000175000001440000000000014642227107015656 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Test.hs0000644000175000001440000000200514642227107017126 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract. module Main where import qualified DocTest.Data.List.Reverse.StrictElement import qualified DocTest.Data.List.Reverse.StrictSpine import qualified DocTest.Data.List.Reverse.Private import qualified DocTest.Data.List.Match.Private import qualified DocTest.Data.List.HT.Private import qualified DocTest.Data.Monoid.HT import qualified DocTest.Data.Maybe.HT import qualified DocTest.Data.Bool.HT.Private import qualified DocTest.Data.Function.HT.Private import qualified DocTest.Data.Ix.Enum import qualified Test.DocTest.Driver as DocTest main :: IO () main = DocTest.run $ do DocTest.Data.List.Reverse.StrictElement.test DocTest.Data.List.Reverse.StrictSpine.test DocTest.Data.List.Reverse.Private.test DocTest.Data.List.Match.Private.test DocTest.Data.List.HT.Private.test DocTest.Data.Monoid.HT.test DocTest.Data.Maybe.HT.test DocTest.Data.Bool.HT.Private.test DocTest.Data.Function.HT.Private.test DocTest.Data.Ix.Enum.test utility-ht-0.0.17.2/src/DocTest/0000755000175000001440000000000014642227107017223 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/0000755000175000001440000000000014642227107020074 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Ix/0000755000175000001440000000000014642227107020454 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Ix/Enum.hs0000644000175000001440000000346114642227107021720 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/Ix/Enum.hs module DocTest.Data.Ix.Enum where import Data.Ix.Enum import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest test :: DocTest.T () test = do DocTest.printPrefix "Data.Ix.Enum:31: " {-# LINE 31 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 31 "src/Data/Ix/Enum.hs" #-} range ('x','z') ) [ExpectedLine [LineChunk "\"xyz\""]] DocTest.printPrefix "Data.Ix.Enum:33: " {-# LINE 33 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 33 "src/Data/Ix/Enum.hs" #-} range (LT,GT) ) [ExpectedLine [LineChunk "[LT,EQ,GT]"]] DocTest.printPrefix "Data.Ix.Enum:39: " {-# LINE 39 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 39 "src/Data/Ix/Enum.hs" #-} index ('a','z') 'e' ) [ExpectedLine [LineChunk "4"]] DocTest.printPrefix "Data.Ix.Enum:45: " {-# LINE 45 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 45 "src/Data/Ix/Enum.hs" #-} unsafeIndex ('a','z') 'e' ) [ExpectedLine [LineChunk "4"]] DocTest.printPrefix "Data.Ix.Enum:51: " {-# LINE 51 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 51 "src/Data/Ix/Enum.hs" #-} inRange ('a','z') 'e' ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.Ix.Enum:53: " {-# LINE 53 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 53 "src/Data/Ix/Enum.hs" #-} inRange ('x','z') 'a' ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.Ix.Enum:59: " {-# LINE 59 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 59 "src/Data/Ix/Enum.hs" #-} rangeSize ('x','z') ) [ExpectedLine [LineChunk "3"]] DocTest.printPrefix "Data.Ix.Enum:65: " {-# LINE 65 "src/Data/Ix/Enum.hs" #-} DocTest.example( {-# LINE 65 "src/Data/Ix/Enum.hs" #-} unsafeRangeSize ('x','z') ) [ExpectedLine [LineChunk "3"]] utility-ht-0.0.17.2/src/DocTest/Data/Function/0000755000175000001440000000000014642227107021661 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Function/HT/0000755000175000001440000000000014642227107022174 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Function/HT/Private.hs0000644000175000001440000000267614642227107024155 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/Function/HT/Private.hs {-# LINE 7 "src/Data/Function/HT/Private.hs" #-} module DocTest.Data.Function.HT.Private where import Data.Function.HT.Private import qualified Test.DocTest.Driver as DocTest {-# LINE 8 "src/Data/Function/HT/Private.hs" #-} import Test.QuickCheck (NonNegative(NonNegative)) test :: DocTest.T () test = do DocTest.printPrefix "Data.Function.HT.Private:22: " {-# LINE 22 "src/Data/Function/HT/Private.hs" #-} DocTest.property( {-# LINE 22 "src/Data/Function/HT/Private.hs" #-} \(NonNegative n) x -> nest n succ x == nest1 n succ (x::Integer) ) DocTest.printPrefix "Data.Function.HT.Private:23: " {-# LINE 23 "src/Data/Function/HT/Private.hs" #-} DocTest.property( {-# LINE 23 "src/Data/Function/HT/Private.hs" #-} \(NonNegative n) x -> nest n succ x == nest2 n succ (x::Integer) ) DocTest.printPrefix "Data.Function.HT.Private:48: " {-# LINE 48 "src/Data/Function/HT/Private.hs" #-} DocTest.property( {-# LINE 48 "src/Data/Function/HT/Private.hs" #-} \a0 a (NonNegative n) -> powerAssociative (+) a0 a n == (powerAssociativeList (+) a0 a n :: Integer) ) DocTest.printPrefix "Data.Function.HT.Private:49: " {-# LINE 49 "src/Data/Function/HT/Private.hs" #-} DocTest.property( {-# LINE 49 "src/Data/Function/HT/Private.hs" #-} \a0 a (NonNegative n) -> powerAssociative (+) a0 a n == (powerAssociativeNaive (+) a0 a n :: Integer) ) utility-ht-0.0.17.2/src/DocTest/Data/Bool/0000755000175000001440000000000014642227107020767 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Bool/HT/0000755000175000001440000000000014642227107021302 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Bool/HT/Private.hs0000644000175000001440000000163514642227107023255 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/Bool/HT/Private.hs module DocTest.Data.Bool.HT.Private where import Data.Bool.HT.Private import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest test :: DocTest.T () test = do DocTest.printPrefix "Data.Bool.HT.Private:55: " {-# LINE 55 "src/Data/Bool/HT/Private.hs" #-} DocTest.example( {-# LINE 55 "src/Data/Bool/HT/Private.hs" #-} True ?: ("yes", "no") ) [ExpectedLine [LineChunk "\"yes\""]] DocTest.printPrefix "Data.Bool.HT.Private:57: " {-# LINE 57 "src/Data/Bool/HT/Private.hs" #-} DocTest.example( {-# LINE 57 "src/Data/Bool/HT/Private.hs" #-} False ?: ("yes", "no") ) [ExpectedLine [LineChunk "\"no\""]] DocTest.printPrefix "Data.Bool.HT.Private:73: " {-# LINE 73 "src/Data/Bool/HT/Private.hs" #-} DocTest.property( {-# LINE 73 "src/Data/Bool/HT/Private.hs" #-} \a b -> implies a b == (a<=b) ) utility-ht-0.0.17.2/src/DocTest/Data/Maybe/0000755000175000001440000000000014642227107021131 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Maybe/HT.hs0000644000175000001440000000103714642227107022001 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/Maybe/HT.hs {-# LINE 6 "src/Data/Maybe/HT.hs" #-} module DocTest.Data.Maybe.HT where import Data.Maybe.HT import qualified Test.DocTest.Driver as DocTest {-# LINE 7 "src/Data/Maybe/HT.hs" #-} import Control.Monad (guard) test :: DocTest.T () test = do DocTest.printPrefix "Data.Maybe.HT:15: " {-# LINE 15 "src/Data/Maybe/HT.hs" #-} DocTest.property( {-# LINE 15 "src/Data/Maybe/HT.hs" #-} \b x -> (guard b >> x) == (toMaybe b =<< (x::Maybe Char)) ) utility-ht-0.0.17.2/src/DocTest/Data/Monoid/0000755000175000001440000000000014642227107021321 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/Monoid/HT.hs0000644000175000001440000000257214642227107022176 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/Monoid/HT.hs {-# LINE 9 "src/Data/Monoid/HT.hs" #-} module DocTest.Data.Monoid.HT where import Data.Monoid.HT import qualified Test.DocTest.Driver as DocTest {-# LINE 10 "src/Data/Monoid/HT.hs" #-} import qualified Test.QuickCheck as QC import Control.Monad (mfilter) import Data.Function.HT (powerAssociative) import Data.Monoid (mconcat, mappend, mempty) test :: DocTest.T () test = do DocTest.printPrefix "Data.Monoid.HT:34: " {-# LINE 34 "src/Data/Monoid/HT.hs" #-} DocTest.property( {-# LINE 34 "src/Data/Monoid/HT.hs" #-} \b m -> when b m == mfilter (const b) (m::Maybe Ordering) ) DocTest.printPrefix "Data.Monoid.HT:35: " {-# LINE 35 "src/Data/Monoid/HT.hs" #-} DocTest.property( {-# LINE 35 "src/Data/Monoid/HT.hs" #-} \b m -> when b m == mfilter (const b) (m::String) ) DocTest.printPrefix "Data.Monoid.HT:41: " {-# LINE 41 "src/Data/Monoid/HT.hs" #-} DocTest.property( {-# LINE 41 "src/Data/Monoid/HT.hs" #-} QC.forAll (QC.choose (0,20)) $ \k xs -> power (fromIntegral k) xs == mconcat (replicate k (xs::String)) ) DocTest.printPrefix "Data.Monoid.HT:46: " {-# LINE 46 "src/Data/Monoid/HT.hs" #-} DocTest.property( {-# LINE 46 "src/Data/Monoid/HT.hs" #-} QC.forAll (QC.choose (0,20)) $ \k xs -> power k xs == powerAssociative mappend mempty (xs::String) k ) utility-ht-0.0.17.2/src/DocTest/Data/List/0000755000175000001440000000000014642227107021007 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/List/HT/0000755000175000001440000000000014642227107021322 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/List/HT/Private.hs0000644000175000001440000007434014642227107023300 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/List/HT/Private.hs {-# LINE 21 "src/Data/List/HT/Private.hs" #-} module DocTest.Data.List.HT.Private where import Data.List.HT.Private import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest {-# LINE 22 "src/Data/List/HT/Private.hs" #-} import qualified Test.QuickCheck as QC import Test.Utility (forAllPredicates) import Test.QuickCheck (NonNegative(NonNegative), Positive(Positive), NonEmptyList(NonEmpty)) import qualified Data.List as List import Data.List (transpose) import Data.Maybe.HT (toMaybe) import Data.Maybe (mapMaybe, isNothing) import Data.Char (isLetter, isUpper, toUpper) import Data.Eq.HT (equating) import Control.Monad (liftM2) divMaybe :: Int -> Int -> Maybe Int divMaybe m n = case divMod n m of (q,0) -> Just q; _ -> Nothing forAllMaybeFn :: (QC.Testable test) => ((Int -> Maybe Int) -> test) -> QC.Property forAllMaybeFn prop = QC.forAll (QC.choose (1,4)) $ prop . divMaybe test :: DocTest.T () test = do DocTest.printPrefix "Data.List.HT.Private:101: " {-# LINE 101 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 101 "src/Data/List/HT/Private.hs" #-} groupBy (<) "abcdebcdef" ) [ExpectedLine [LineChunk "[\"abcde\",\"bcdef\"]"]] DocTest.printPrefix "Data.List.HT.Private:108: " {-# LINE 108 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 108 "src/Data/List/HT/Private.hs" #-} List.groupBy (<) "abcdebcdef" ) [ExpectedLine [LineChunk "[\"abcdebcdef\"]"]] DocTest.printPrefix "Data.List.HT.Private:179: " {-# LINE 179 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 179 "src/Data/List/HT/Private.hs" #-} words "a a" ) [ExpectedLine [LineChunk "[\"a\",\"a\"]"]] DocTest.printPrefix "Data.List.HT.Private:181: " {-# LINE 181 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 181 "src/Data/List/HT/Private.hs" #-} chop (' '==) "a a" ) [ExpectedLine [LineChunk "[\"a\",\"\",\"a\"]"]] DocTest.printPrefix "Data.List.HT.Private:184: " {-# LINE 184 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 184 "src/Data/List/HT/Private.hs" #-} lines "a\n\na" ) [ExpectedLine [LineChunk "[\"a\",\"\",\"a\"]"]] DocTest.printPrefix "Data.List.HT.Private:186: " {-# LINE 186 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 186 "src/Data/List/HT/Private.hs" #-} chop ('\n'==) "a\n\na" ) [ExpectedLine [LineChunk "[\"a\",\"\",\"a\"]"]] DocTest.printPrefix "Data.List.HT.Private:189: " {-# LINE 189 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 189 "src/Data/List/HT/Private.hs" #-} lines "a\n" ) [ExpectedLine [LineChunk "[\"a\"]"]] DocTest.printPrefix "Data.List.HT.Private:191: " {-# LINE 191 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 191 "src/Data/List/HT/Private.hs" #-} chop ('\n'==) "a\n" ) [ExpectedLine [LineChunk "[\"a\",\"\"]"]] DocTest.printPrefix "Data.List.HT.Private:220: " {-# LINE 220 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 220 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> uncurry (++) (breakAfter p xs) == xs ) DocTest.printPrefix "Data.List.HT.Private:239: " {-# LINE 239 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 239 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterFoldr p xs ) DocTest.printPrefix "Data.List.HT.Private:247: " {-# LINE 247 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 247 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterBreak p xs ) DocTest.printPrefix "Data.List.HT.Private:254: " {-# LINE 254 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 254 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterTakeUntil p xs ) DocTest.printPrefix "Data.List.HT.Private:267: " {-# LINE 267 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 267 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> takeUntil p xs == fst (breakAfter p xs) ) DocTest.printPrefix "Data.List.HT.Private:280: " {-# LINE 280 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 280 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> concat (segmentAfter p xs) == xs ) DocTest.printPrefix "Data.List.HT.Private:281: " {-# LINE 281 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 281 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> length (filter p xs) == length (tail (segmentAfter p xs)) ) DocTest.printPrefix "Data.List.HT.Private:282: " {-# LINE 282 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 282 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p -> all (p . last) . init . segmentAfter p ) DocTest.printPrefix "Data.List.HT.Private:283: " {-# LINE 283 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 283 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p -> all (all (not . p) . init) . init . segmentAfter p ) DocTest.printPrefix "Data.List.HT.Private:287: " {-# LINE 287 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 287 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p x -> flip seq True . (!!100) . concat . segmentAfter p . cycle . (x:) ) DocTest.printPrefix "Data.List.HT.Private:309: " {-# LINE 309 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 309 "src/Data/List/HT/Private.hs" #-} segmentBefore isUpper "AbcdXyz" ) [ExpectedLine [LineChunk "[\"\",\"Abcd\",\"Xyz\"]"]] DocTest.printPrefix "Data.List.HT.Private:311: " {-# LINE 311 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 311 "src/Data/List/HT/Private.hs" #-} segmentBefore isUpper "kAbcdXYZ" ) [ExpectedLine [LineChunk "[\"k\",\"Abcd\",\"X\",\"Y\",\"Z\"]"]] DocTest.printPrefix "Data.List.HT.Private:314: " {-# LINE 314 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 314 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> concat (segmentBefore p xs) == xs ) DocTest.printPrefix "Data.List.HT.Private:315: " {-# LINE 315 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 315 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> length (filter p xs) == length (tail (segmentBefore p xs)) ) DocTest.printPrefix "Data.List.HT.Private:316: " {-# LINE 316 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 316 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p -> all (p . head) . tail . segmentBefore p ) DocTest.printPrefix "Data.List.HT.Private:317: " {-# LINE 317 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 317 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p -> all (all (not . p) . tail) . tail . segmentBefore p ) DocTest.printPrefix "Data.List.HT.Private:318: " {-# LINE 318 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 318 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p x -> flip seq True . (!!100) . concat . segmentBefore p . cycle . (x:) ) DocTest.printPrefix "Data.List.HT.Private:330: " {-# LINE 330 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 330 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> segmentBefore p xs == segmentBefore' p xs ) DocTest.printPrefix "Data.List.HT.Private:341: " {-# LINE 341 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 341 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> segmentBefore p xs == segmentBefore'' p xs ) DocTest.printPrefix "Data.List.HT.Private:353: " {-# LINE 353 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 353 "src/Data/List/HT/Private.hs" #-} segmentBeforeJust (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" ) [ExpectedLine [LineChunk "(\"123\",[('A',\"5345\"),('B',\"---\")])"]] DocTest.printPrefix "Data.List.HT.Private:369: " {-# LINE 369 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 369 "src/Data/List/HT/Private.hs" #-} segmentAfterJust (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" ) [ExpectedLine [LineChunk "([(\"123\",'A'),(\"5345\",'B')],\"---\")"]] DocTest.printPrefix "Data.List.HT.Private:382: " {-# LINE 382 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 382 "src/Data/List/HT/Private.hs" #-} segmentBeforeRight [Left 'a', Right LT, Right GT, Left 'b'] ) [ExpectedLine [LineChunk "(\"a\",[(LT,\"\"),(GT,\"b\")])"]] DocTest.printPrefix "Data.List.HT.Private:385: " {-# LINE 385 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 385 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> segmentBeforeJust f xs == segmentBeforeRight (map (\x -> maybe (Left x) Right (f x)) xs) ) DocTest.printPrefix "Data.List.HT.Private:399: " {-# LINE 399 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 399 "src/Data/List/HT/Private.hs" #-} segmentAfterRight [Left 'a', Right LT, Right GT, Left 'b'] ) [ExpectedLine [LineChunk "([(\"a\",LT),(\"\",GT)],\"b\")"]] DocTest.printPrefix "Data.List.HT.Private:402: " {-# LINE 402 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 402 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> segmentAfterJust f xs == segmentAfterRight (map (\x -> maybe (Left x) Right (f x)) xs) ) DocTest.printPrefix "Data.List.HT.Private:425: " {-# LINE 425 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 425 "src/Data/List/HT/Private.hs" #-} removeEach "abc" ) [ExpectedLine [LineChunk "[('a',\"bc\"),('b',\"ac\"),('c',\"ab\")]"]] DocTest.printPrefix "Data.List.HT.Private:427: " {-# LINE 427 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 427 "src/Data/List/HT/Private.hs" #-} removeEach "a" ) [ExpectedLine [LineChunk "[('a',\"\")]"]] DocTest.printPrefix "Data.List.HT.Private:429: " {-# LINE 429 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 429 "src/Data/List/HT/Private.hs" #-} removeEach "" ) [ExpectedLine [LineChunk "[]"]] DocTest.printPrefix "Data.List.HT.Private:437: " {-# LINE 437 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 437 "src/Data/List/HT/Private.hs" #-} splitEverywhere "abc" ) [ExpectedLine [LineChunk "[(\"\",'a',\"bc\"),(\"a\",'b',\"c\"),(\"ab\",'c',\"\")]"]] DocTest.printPrefix "Data.List.HT.Private:439: " {-# LINE 439 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 439 "src/Data/List/HT/Private.hs" #-} splitEverywhere "a" ) [ExpectedLine [LineChunk "[(\"\",'a',\"\")]"]] DocTest.printPrefix "Data.List.HT.Private:441: " {-# LINE 441 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 441 "src/Data/List/HT/Private.hs" #-} splitEverywhere "" ) [ExpectedLine [LineChunk "[]"]] DocTest.printPrefix "Data.List.HT.Private:464: " {-# LINE 464 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 464 "src/Data/List/HT/Private.hs" #-} \(NonEmpty xs) -> splitLast (xs::String) == (init xs, last xs) ) DocTest.printPrefix "Data.List.HT.Private:484: " {-# LINE 484 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 484 "src/Data/List/HT/Private.hs" #-} \xs -> maybe True ((init xs, last xs) == ) (viewR (xs::String)) ) DocTest.printPrefix "Data.List.HT.Private:505: " {-# LINE 505 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 505 "src/Data/List/HT/Private.hs" #-} \xs -> switchR True (\ixs lxs -> ixs == init xs && lxs == last xs) (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:519: " {-# LINE 519 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 519 "src/Data/List/HT/Private.hs" #-} \n xs -> takeRev n (xs::String) == reverse (take n (reverse xs)) ) DocTest.printPrefix "Data.List.HT.Private:528: " {-# LINE 528 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 528 "src/Data/List/HT/Private.hs" #-} \n xs -> dropRev n (xs::String) == reverse (drop n (reverse xs)) ) DocTest.printPrefix "Data.List.HT.Private:536: " {-# LINE 536 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 536 "src/Data/List/HT/Private.hs" #-} \n xs -> splitAtRev n (xs::String) == (dropRev n xs, takeRev n xs) ) DocTest.printPrefix "Data.List.HT.Private:537: " {-# LINE 537 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 537 "src/Data/List/HT/Private.hs" #-} \n xs -> (xs::String) == uncurry (++) (splitAtRev n xs) ) DocTest.printPrefix "Data.List.HT.Private:551: " {-# LINE 551 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 551 "src/Data/List/HT/Private.hs" #-} maybePrefixOf "abc" "abcdef" ) [ExpectedLine [LineChunk "Just \"def\""]] DocTest.printPrefix "Data.List.HT.Private:553: " {-# LINE 553 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 553 "src/Data/List/HT/Private.hs" #-} maybePrefixOf "def" "abcdef" ) [ExpectedLine [LineChunk "Nothing"]] DocTest.printPrefix "Data.List.HT.Private:562: " {-# LINE 562 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 562 "src/Data/List/HT/Private.hs" #-} maybeSuffixOf "abc" "abcdef" ) [ExpectedLine [LineChunk "Nothing"]] DocTest.printPrefix "Data.List.HT.Private:564: " {-# LINE 564 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 564 "src/Data/List/HT/Private.hs" #-} maybeSuffixOf "def" "abcdef" ) [ExpectedLine [LineChunk "Just \"abc\""]] DocTest.printPrefix "Data.List.HT.Private:575: " {-# LINE 575 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 575 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> partitionMaybe f xs == (mapMaybe f xs, filter (isNothing . f) xs) ) DocTest.printPrefix "Data.List.HT.Private:576: " {-# LINE 576 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 576 "src/Data/List/HT/Private.hs" #-} forAllPredicates $ \p xs -> partition p xs == partitionMaybe (\x -> toMaybe (p x) x) xs ) DocTest.printPrefix "Data.List.HT.Private:589: " {-# LINE 589 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 589 "src/Data/List/HT/Private.hs" #-} takeWhileJust [Just 'a', Just 'b', Nothing, Just 'c'] ) [ExpectedLine [LineChunk "\"ab\""]] DocTest.printPrefix "Data.List.HT.Private:594: " {-# LINE 594 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 594 "src/Data/List/HT/Private.hs" #-} takeWhileJust $ map (fmap fst . viewL) ["abc","def","","xyz"] ) [ExpectedLine [LineChunk "\"ad\""]] DocTest.printPrefix "Data.List.HT.Private:615: " {-# LINE 615 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 615 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> dropWhileNothing f xs == dropWhileNothingRec f xs ) DocTest.printPrefix "Data.List.HT.Private:622: " {-# LINE 622 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 622 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> snd (breakJust f xs) == dropWhileNothing f xs ) DocTest.printPrefix "Data.List.HT.Private:633: " {-# LINE 633 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 633 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> breakJust f xs == breakJustRemoveEach f xs ) DocTest.printPrefix "Data.List.HT.Private:641: " {-# LINE 641 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 641 "src/Data/List/HT/Private.hs" #-} forAllMaybeFn $ \f xs -> breakJust f xs == breakJustPartial f xs ) DocTest.printPrefix "Data.List.HT.Private:669: " {-# LINE 669 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 669 "src/Data/List/HT/Private.hs" #-} sieve 6 ['a'..'z'] ) [ExpectedLine [LineChunk "\"agmsy\""]] DocTest.printPrefix "Data.List.HT.Private:676: " {-# LINE 676 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 676 "src/Data/List/HT/Private.hs" #-} \(Positive n) xs -> sieve n xs == sieve' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:679: " {-# LINE 679 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 679 "src/Data/List/HT/Private.hs" #-} \(Positive n) xs -> sieve n xs == sieve'' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:682: " {-# LINE 682 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 682 "src/Data/List/HT/Private.hs" #-} \(Positive n) xs -> sieve n xs == sieve''' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:691: " {-# LINE 691 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 691 "src/Data/List/HT/Private.hs" #-} sliceHorizontal 6 ['a'..'z'] ) [ExpectedLine [LineChunk "[\"agmsy\",\"bhntz\",\"ciou\",\"djpv\",\"ekqw\",\"flrx\"]"]] DocTest.printPrefix "Data.List.HT.Private:694: " {-# LINE 694 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 694 "src/Data/List/HT/Private.hs" #-} \(NonEmpty xs) -> QC.forAll (QC.choose (1, length xs)) $ \n -> sliceHorizontal n xs == transpose (sliceVertical n (xs::String)) ) DocTest.printPrefix "Data.List.HT.Private:695: " {-# LINE 695 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 695 "src/Data/List/HT/Private.hs" #-} \(NonEmpty xs) -> QC.forAll (QC.choose (1, length xs)) $ \n -> sliceVertical n xs == transpose (sliceHorizontal n (xs::String)) ) DocTest.printPrefix "Data.List.HT.Private:699: " {-# LINE 699 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 699 "src/Data/List/HT/Private.hs" #-} sliceHorizontal 4 ([]::[Int]) ) [ExpectedLine [LineChunk "[[],[],[],[]]"]] DocTest.printPrefix "Data.List.HT.Private:707: " {-# LINE 707 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 707 "src/Data/List/HT/Private.hs" #-} \(NonNegative n) xs -> sliceHorizontal n xs == sliceHorizontal' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:711: " {-# LINE 711 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 711 "src/Data/List/HT/Private.hs" #-} \(Positive n) xs -> sliceHorizontal n xs == sliceHorizontal'' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:720: " {-# LINE 720 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 720 "src/Data/List/HT/Private.hs" #-} sliceVertical 6 ['a'..'z'] ) [ExpectedLine [LineChunk "[\"abcdef\",\"ghijkl\",\"mnopqr\",\"stuvwx\",\"yz\"]"]] DocTest.printPrefix "Data.List.HT.Private:729: " {-# LINE 729 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 729 "src/Data/List/HT/Private.hs" #-} \(NonNegative n) xs -> equating (take 100000) (sliceVertical n xs) (sliceVertical' n (xs::String)) ) DocTest.printPrefix "Data.List.HT.Private:742: " {-# LINE 742 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 742 "src/Data/List/HT/Private.hs" #-} \(NonEmpty xs) ys -> replace xs xs ys == (ys::String) ) DocTest.printPrefix "Data.List.HT.Private:743: " {-# LINE 743 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 743 "src/Data/List/HT/Private.hs" #-} \(NonEmpty xs) (NonEmpty ys) -> equating (take 1000) (replace xs ys (cycle xs)) (cycle (ys::String)) ) DocTest.printPrefix "Data.List.HT.Private:881: " {-# LINE 881 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 881 "src/Data/List/HT/Private.hs" #-} \xs -> shearTranspose xs == map reverse (shear (xs::[String])) ) DocTest.printPrefix "Data.List.HT.Private:916: " {-# LINE 916 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 916 "src/Data/List/HT/Private.hs" #-} \xs ys -> let f x y = (x::Char,y::Int) in concat (outerProduct f xs ys) == liftM2 f xs ys ) DocTest.printPrefix "Data.List.HT.Private:939: " {-# LINE 939 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 939 "src/Data/List/HT/Private.hs" #-} \ys xs -> let ps = map (<=) ys in takeWhileMulti ps xs == takeWhileMulti' ps (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:993: " {-# LINE 993 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 993 "src/Data/List/HT/Private.hs" #-} lengthAtLeast 0 "" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:995: " {-# LINE 995 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 995 "src/Data/List/HT/Private.hs" #-} lengthAtLeast 3 "ab" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:997: " {-# LINE 997 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 997 "src/Data/List/HT/Private.hs" #-} lengthAtLeast 3 "abc" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:999: " {-# LINE 999 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 999 "src/Data/List/HT/Private.hs" #-} lengthAtLeast 3 $ repeat 'a' ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1001: " {-# LINE 1001 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1001 "src/Data/List/HT/Private.hs" #-} lengthAtLeast 3 $ "abc" ++ undefined ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1004: " {-# LINE 1004 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1004 "src/Data/List/HT/Private.hs" #-} \n xs -> lengthAtLeast n (xs::String) == (length xs >= n) ) DocTest.printPrefix "Data.List.HT.Private:1013: " {-# LINE 1013 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1013 "src/Data/List/HT/Private.hs" #-} lengthAtMost 0 "" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1015: " {-# LINE 1015 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1015 "src/Data/List/HT/Private.hs" #-} lengthAtMost 3 "ab" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1017: " {-# LINE 1017 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1017 "src/Data/List/HT/Private.hs" #-} lengthAtMost 3 "abc" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1019: " {-# LINE 1019 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1019 "src/Data/List/HT/Private.hs" #-} lengthAtMost 3 "abcd" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1021: " {-# LINE 1021 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1021 "src/Data/List/HT/Private.hs" #-} lengthAtMost 3 $ repeat 'a' ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1023: " {-# LINE 1023 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1023 "src/Data/List/HT/Private.hs" #-} lengthAtMost 3 $ "abcd" ++ undefined ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1026: " {-# LINE 1026 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1026 "src/Data/List/HT/Private.hs" #-} \n xs -> lengthAtMost n (xs::String) == (length xs <= n) ) DocTest.printPrefix "Data.List.HT.Private:1035: " {-# LINE 1035 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1035 "src/Data/List/HT/Private.hs" #-} \n xs -> lengthAtMost0 n (xs::String) == (length xs <= n) ) DocTest.printPrefix "Data.List.HT.Private:1082: " {-# LINE 1082 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1082 "src/Data/List/HT/Private.hs" #-} \n (NonEmpty xs) -> rotate n xs == rotate' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:1089: " {-# LINE 1089 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1089 "src/Data/List/HT/Private.hs" #-} \(NonNegative n) xs -> rotate n xs == rotate'' n (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:1099: " {-# LINE 1099 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1099 "src/Data/List/HT/Private.hs" #-} mergeBy (<=) "agh" "begz" ) [ExpectedLine [LineChunk "\"abegghz\""]] DocTest.printPrefix "Data.List.HT.Private:1107: " {-# LINE 1107 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1107 "src/Data/List/HT/Private.hs" #-} allEqual "aab" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1109: " {-# LINE 1109 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1109 "src/Data/List/HT/Private.hs" #-} allEqual "aaa" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1111: " {-# LINE 1111 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1111 "src/Data/List/HT/Private.hs" #-} allEqual "aa" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1113: " {-# LINE 1113 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1113 "src/Data/List/HT/Private.hs" #-} allEqual "a" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1115: " {-# LINE 1115 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1115 "src/Data/List/HT/Private.hs" #-} allEqual "" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1122: " {-# LINE 1122 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1122 "src/Data/List/HT/Private.hs" #-} isAscending "abc" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1124: " {-# LINE 1124 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1124 "src/Data/List/HT/Private.hs" #-} isAscending "abb" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1126: " {-# LINE 1126 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1126 "src/Data/List/HT/Private.hs" #-} isAscending "aba" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1128: " {-# LINE 1128 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1128 "src/Data/List/HT/Private.hs" #-} isAscending "cba" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1130: " {-# LINE 1130 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1130 "src/Data/List/HT/Private.hs" #-} isAscending "a" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1132: " {-# LINE 1132 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1132 "src/Data/List/HT/Private.hs" #-} isAscending "" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1145: " {-# LINE 1145 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1145 "src/Data/List/HT/Private.hs" #-} mapAdjacent (<=) "" ) [ExpectedLine [LineChunk "[]"]] DocTest.printPrefix "Data.List.HT.Private:1147: " {-# LINE 1147 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1147 "src/Data/List/HT/Private.hs" #-} mapAdjacent (<=) "a" ) [ExpectedLine [LineChunk "[]"]] DocTest.printPrefix "Data.List.HT.Private:1149: " {-# LINE 1149 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1149 "src/Data/List/HT/Private.hs" #-} mapAdjacent (<=) "aba" ) [ExpectedLine [LineChunk "[True,False]"]] DocTest.printPrefix "Data.List.HT.Private:1151: " {-# LINE 1151 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1151 "src/Data/List/HT/Private.hs" #-} mapAdjacent (,) "abc" ) [ExpectedLine [LineChunk "[('a','b'),('b','c')]"]] DocTest.printPrefix "Data.List.HT.Private:1154: " {-# LINE 1154 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1154 "src/Data/List/HT/Private.hs" #-} \x xs -> mapAdjacent subtract (scanl (+) x xs) == (xs::[Integer]) ) DocTest.printPrefix "Data.List.HT.Private:1162: " {-# LINE 1162 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1162 "src/Data/List/HT/Private.hs" #-} \xs -> mapAdjacent (,) xs == mapAdjacentPointfree (,) (xs::String) ) DocTest.printPrefix "Data.List.HT.Private:1169: " {-# LINE 1169 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1169 "src/Data/List/HT/Private.hs" #-} let f x y z = [x,y]++show(z::Int) in mapAdjacent1 f 'a' [('b',1), ('c',2), ('d',3)] ) [ExpectedLine [LineChunk "[\"ab1\",\"bc2\",\"cd3\"]"]] DocTest.printPrefix "Data.List.HT.Private:1178: " {-# LINE 1178 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1178 "src/Data/List/HT/Private.hs" #-} equalWith (<=) "ab" "bb" ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.HT.Private:1180: " {-# LINE 1180 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1180 "src/Data/List/HT/Private.hs" #-} equalWith (<=) "aa" "bbb" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1182: " {-# LINE 1182 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1182 "src/Data/List/HT/Private.hs" #-} equalWith (==) "aa" "aaa" ) [ExpectedLine [LineChunk "False"]] DocTest.printPrefix "Data.List.HT.Private:1185: " {-# LINE 1185 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1185 "src/Data/List/HT/Private.hs" #-} \as bs -> let f a b = abs (a-b) <= (10::Int) in equalWith f as bs == equalWithRec f as bs ) DocTest.printPrefix "Data.List.HT.Private:1186: " {-# LINE 1186 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1186 "src/Data/List/HT/Private.hs" #-} \as bs -> let f a b = abs (a-b) <= (10::Int) in equalWith f as bs == equalWithLiftM f as bs ) DocTest.printPrefix "Data.List.HT.Private:1222: " {-# LINE 1222 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1222 "src/Data/List/HT/Private.hs" #-} range 0 :: [Integer] ) [ExpectedLine [LineChunk "[]"]] DocTest.printPrefix "Data.List.HT.Private:1224: " {-# LINE 1224 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1224 "src/Data/List/HT/Private.hs" #-} range 1 :: [Integer] ) [ExpectedLine [LineChunk "[0]"]] DocTest.printPrefix "Data.List.HT.Private:1226: " {-# LINE 1226 "src/Data/List/HT/Private.hs" #-} DocTest.example( {-# LINE 1226 "src/Data/List/HT/Private.hs" #-} range 8 :: [Integer] ) [ExpectedLine [LineChunk "[0,1,2,3,4,5,6,7]"]] DocTest.printPrefix "Data.List.HT.Private:1229: " {-# LINE 1229 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1229 "src/Data/List/HT/Private.hs" #-} \(NonNegative n) -> length (range n :: [Integer]) == n ) DocTest.printPrefix "Data.List.HT.Private:1256: " {-# LINE 1256 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1256 "src/Data/List/HT/Private.hs" #-} \x -> equating (take 1000) (List.iterate (x+) x) (iterateAssociative (+) (x::Integer)) ) DocTest.printPrefix "Data.List.HT.Private:1275: " {-# LINE 1275 "src/Data/List/HT/Private.hs" #-} DocTest.property( {-# LINE 1275 "src/Data/List/HT/Private.hs" #-} \x -> equating (take 1000) (List.iterate (x+) x) (iterateLeaky (+) (x::Integer)) ) utility-ht-0.0.17.2/src/DocTest/Data/List/Match/0000755000175000001440000000000014642227107022043 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/List/Match/Private.hs0000644000175000001440000001442714642227107024021 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/List/Match/Private.hs {-# LINE 15 "src/Data/List/Match/Private.hs" #-} module DocTest.Data.List.Match.Private where import Data.List.Match.Private import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest {-# LINE 16 "src/Data/List/Match/Private.hs" #-} import qualified Data.List.Match.Private as Match import qualified Data.List as List import qualified Test.QuickCheck as QC newtype List = List [Integer] deriving (Show) instance QC.Arbitrary List where arbitrary = fmap List QC.arbitrary shrink (List xs) = map List $ QC.shrink xs newtype Shape = Shape [Ordering] deriving (Show) instance QC.Arbitrary Shape where arbitrary = fmap Shape QC.arbitrary shrink (Shape xs) = map Shape $ QC.shrink xs test :: DocTest.T () test = do DocTest.printPrefix "Data.List.Match.Private:34: " {-# LINE 34 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 34 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.take xs ys == List.take (length xs) ys ) DocTest.printPrefix "Data.List.Match.Private:46: " {-# LINE 46 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 46 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.drop xs ys == List.drop (length xs) ys ) DocTest.printPrefix "Data.List.Match.Private:47: " {-# LINE 47 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 47 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.take xs ys ++ Match.drop xs ys == ys ) DocTest.printPrefix "Data.List.Match.Private:54: " {-# LINE 54 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 54 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.drop xs ys == dropRec xs ys ) DocTest.printPrefix "Data.List.Match.Private:63: " {-# LINE 63 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 63 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.drop xs ys == drop0 xs ys ) DocTest.printPrefix "Data.List.Match.Private:70: " {-# LINE 70 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 70 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.drop xs ys == drop1 xs ys ) DocTest.printPrefix "Data.List.Match.Private:75: " {-# LINE 75 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 75 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.drop xs ys == drop2 xs ys ) DocTest.printPrefix "Data.List.Match.Private:84: " {-# LINE 84 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 84 "src/Data/List/Match/Private.hs" #-} laxTail "" ) [ExpectedLine [LineChunk "\"\""]] DocTest.printPrefix "Data.List.Match.Private:86: " {-# LINE 86 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 86 "src/Data/List/Match/Private.hs" #-} laxTail "a" ) [ExpectedLine [LineChunk "\"\""]] DocTest.printPrefix "Data.List.Match.Private:88: " {-# LINE 88 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 88 "src/Data/List/Match/Private.hs" #-} laxTail "ab" ) [ExpectedLine [LineChunk "\"b\""]] DocTest.printPrefix "Data.List.Match.Private:94: " {-# LINE 94 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 94 "src/Data/List/Match/Private.hs" #-} \(List xs) -> Match.laxTail xs == Match.laxTail0 xs ) DocTest.printPrefix "Data.List.Match.Private:99: " {-# LINE 99 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 99 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.splitAt xs ys == (Match.take xs ys, Match.drop xs ys) ) DocTest.printPrefix "Data.List.Match.Private:100: " {-# LINE 100 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 100 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.splitAt xs ys == List.splitAt (length xs) ys ) DocTest.printPrefix "Data.List.Match.Private:110: " {-# LINE 110 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 110 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.takeRev xs ys == reverse (Match.take xs (reverse ys)) ) DocTest.printPrefix "Data.List.Match.Private:114: " {-# LINE 114 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 114 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.dropRev xs ys == reverse (Match.drop xs (reverse ys)) ) DocTest.printPrefix "Data.List.Match.Private:122: " {-# LINE 122 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 122 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> equalLength xs ys == (length xs == length ys) ) DocTest.printPrefix "Data.List.Match.Private:134: " {-# LINE 134 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 134 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> compareLength xs ys == compare (length xs) (length ys) ) DocTest.printPrefix "Data.List.Match.Private:144: " {-# LINE 144 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 144 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength0 xs ys ) DocTest.printPrefix "Data.List.Match.Private:156: " {-# LINE 156 "src/Data/List/Match/Private.hs" #-} DocTest.property( {-# LINE 156 "src/Data/List/Match/Private.hs" #-} \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength1 xs ys ) DocTest.printPrefix "Data.List.Match.Private:166: " {-# LINE 166 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 166 "src/Data/List/Match/Private.hs" #-} lessOrEqualLength "" undefined ) [ExpectedLine [LineChunk "True"]] DocTest.printPrefix "Data.List.Match.Private:181: " {-# LINE 181 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 181 "src/Data/List/Match/Private.hs" #-} shorterList (shorterList (repeat 'a') (repeat 'b')) "abc" ) [ExpectedLine [LineChunk "\"abc\""]] DocTest.printPrefix "Data.List.Match.Private:200: " {-# LINE 200 "src/Data/List/Match/Private.hs" #-} DocTest.example( {-# LINE 200 "src/Data/List/Match/Private.hs" #-} List.take 3 $ shorterListEq ("abc" ++ repeat 'a') ("abcdef" ++ repeat 'b') ) [ExpectedLine [LineChunk "\"abc\""]] utility-ht-0.0.17.2/src/DocTest/Data/List/Reverse/0000755000175000001440000000000014642227107022422 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/DocTest/Data/List/Reverse/Private.hs0000644000175000001440000000275414642227107024400 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/List/Reverse/Private.hs {-# LINE 9 "src/Data/List/Reverse/Private.hs" #-} module DocTest.Data.List.Reverse.Private where import Data.List.Reverse.Private import qualified Test.DocTest.Driver as DocTest {-# LINE 10 "src/Data/List/Reverse/Private.hs" #-} import Test.Utility (forAllPredicates) import qualified Data.List.Reverse.StrictElement as Rev import Prelude hiding (dropWhile, takeWhile) test :: DocTest.T () test = do DocTest.printPrefix "Data.List.Reverse.Private:16: " {-# LINE 16 "src/Data/List/Reverse/Private.hs" #-} DocTest.property( {-# LINE 16 "src/Data/List/Reverse/Private.hs" #-} forAllPredicates $ \p xs -> dropWhile p xs == Rev.dropWhile p xs ) DocTest.printPrefix "Data.List.Reverse.Private:23: " {-# LINE 23 "src/Data/List/Reverse/Private.hs" #-} DocTest.property( {-# LINE 23 "src/Data/List/Reverse/Private.hs" #-} forAllPredicates $ \p xs -> takeWhile0 p xs == Rev.takeWhile p xs ) DocTest.printPrefix "Data.List.Reverse.Private:32: " {-# LINE 32 "src/Data/List/Reverse/Private.hs" #-} DocTest.property( {-# LINE 32 "src/Data/List/Reverse/Private.hs" #-} forAllPredicates $ \p xs -> takeWhile1 p xs == Rev.takeWhile p xs ) DocTest.printPrefix "Data.List.Reverse.Private:46: " {-# LINE 46 "src/Data/List/Reverse/Private.hs" #-} DocTest.property( {-# LINE 46 "src/Data/List/Reverse/Private.hs" #-} forAllPredicates $ \p xs -> takeWhile2 p xs == Rev.takeWhile p xs ) utility-ht-0.0.17.2/src/DocTest/Data/List/Reverse/StrictSpine.hs0000644000175000001440000000542014642227107025226 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/List/Reverse/StrictSpine.hs {-# LINE 14 "src/Data/List/Reverse/StrictSpine.hs" #-} module DocTest.Data.List.Reverse.StrictSpine where import Data.List.Reverse.StrictSpine import qualified Test.DocTest.Driver as DocTest {-# LINE 15 "src/Data/List/Reverse/StrictSpine.hs" #-} import Test.Utility (forAllPredicates, defined) import qualified Data.List.Reverse.StrictSpine as Rev import qualified Data.List.Match as Match import qualified Data.List as List import Data.Tuple.HT (mapFst, mapPair, swap) _suppressUnusedImportWarning :: (a -> Bool) -> [a] -> [a] _suppressUnusedImportWarning = Data.List.Reverse.StrictSpine.dropWhile test :: DocTest.T () test = do DocTest.printPrefix "Data.List.Reverse.StrictSpine:26: " {-# LINE 26 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 26 "src/Data/List/Reverse/StrictSpine.hs" #-} forAllPredicates $ \p xs -> Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:27: " {-# LINE 27 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 27 "src/Data/List/Reverse/StrictSpine.hs" #-} \x xs pad -> defined $ length $ Rev.dropWhile ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:34: " {-# LINE 34 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 34 "src/Data/List/Reverse/StrictSpine.hs" #-} forAllPredicates $ \p xs -> Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:35: " {-# LINE 35 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 35 "src/Data/List/Reverse/StrictSpine.hs" #-} \x xs pad -> defined $ Rev.takeWhile ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:46: " {-# LINE 46 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 46 "src/Data/List/Reverse/StrictSpine.hs" #-} forAllPredicates $ \p xs -> Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:47: " {-# LINE 47 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 47 "src/Data/List/Reverse/StrictSpine.hs" #-} forAllPredicates $ \p xs -> Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) ) DocTest.printPrefix "Data.List.Reverse.StrictSpine:48: " {-# LINE 48 "src/Data/List/Reverse/StrictSpine.hs" #-} DocTest.property( {-# LINE 48 "src/Data/List/Reverse/StrictSpine.hs" #-} \x xs pad -> defined $ mapFst length $ Rev.span ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs ) utility-ht-0.0.17.2/src/DocTest/Data/List/Reverse/StrictElement.hs0000644000175000001440000000475714642227107025555 0ustar00thielemausers00000000000000-- Do not edit! Automatically created with doctest-extract from src/Data/List/Reverse/StrictElement.hs {-# LINE 15 "src/Data/List/Reverse/StrictElement.hs" #-} module DocTest.Data.List.Reverse.StrictElement where import Data.List.Reverse.StrictElement import qualified Test.DocTest.Driver as DocTest {-# LINE 16 "src/Data/List/Reverse/StrictElement.hs" #-} import Test.Utility (forAllPredicates, defined) import qualified Data.List.Reverse.StrictElement as Rev import qualified Data.List.Match as Match import qualified Data.List as List import Data.Tuple.HT (mapPair, swap) _suppressUnusedImportWarning :: (a -> Bool) -> [a] -> [a] _suppressUnusedImportWarning = Data.List.Reverse.StrictElement.dropWhile test :: DocTest.T () test = do DocTest.printPrefix "Data.List.Reverse.StrictElement:31: " {-# LINE 31 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 31 "src/Data/List/Reverse/StrictElement.hs" #-} forAllPredicates $ \p xs -> Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) ) DocTest.printPrefix "Data.List.Reverse.StrictElement:32: " {-# LINE 32 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 32 "src/Data/List/Reverse/StrictElement.hs" #-} \x xs pad -> defined $ Match.take (pad::[()]) $ Rev.dropWhile ((x::Char)/=) $ cycle $ x:xs ) DocTest.printPrefix "Data.List.Reverse.StrictElement:41: " {-# LINE 41 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 41 "src/Data/List/Reverse/StrictElement.hs" #-} forAllPredicates $ \p xs -> Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) ) DocTest.printPrefix "Data.List.Reverse.StrictElement:52: " {-# LINE 52 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 52 "src/Data/List/Reverse/StrictElement.hs" #-} forAllPredicates $ \p xs -> Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) ) DocTest.printPrefix "Data.List.Reverse.StrictElement:53: " {-# LINE 53 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 53 "src/Data/List/Reverse/StrictElement.hs" #-} forAllPredicates $ \p xs -> Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) ) DocTest.printPrefix "Data.List.Reverse.StrictElement:54: " {-# LINE 54 "src/Data/List/Reverse/StrictElement.hs" #-} DocTest.property( {-# LINE 54 "src/Data/List/Reverse/StrictElement.hs" #-} \x xs pad -> defined $ Match.take (pad::[()]) $ fst $ Rev.span ((x::Char)/=) $ cycle $ x:xs ) utility-ht-0.0.17.2/src/Test/0000755000175000001440000000000014642227107016575 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Test/Utility.hs0000644000175000001440000000125014642227107020572 0ustar00thielemausers00000000000000-- cf. Test.NumericPrelude.Utility module Test.Utility where import qualified Test.QuickCheck as QC import Data.List.HT (mapAdjacent, ) import qualified Data.List as List -- compare the lists simultaneously equalLists :: Eq a => [[a]] -> Bool equalLists xs = let equalElems ys = and (mapAdjacent (==) ys) && length xs == length ys in all equalElems (List.transpose xs) equalInfLists :: Eq a => Int -> [[a]] -> Bool equalInfLists n xs = equalLists (map (take n) xs) forAllPredicates :: (QC.Testable test) => ((Char -> Bool) -> test) -> QC.Property forAllPredicates prop = QC.property $ \x -> prop (x<=) defined :: (Eq a) => a -> Bool defined a = a==a utility-ht-0.0.17.2/src/Text/0000755000175000001440000000000014642227107016602 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Text/Show/0000755000175000001440000000000014642227107017522 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Text/Show/HT.hs0000644000175000001440000000073414642227107020375 0ustar00thielemausers00000000000000module Text.Show.HT where {-| Show a value using an infix operator. -} {-# INLINE showsInfixPrec #-} showsInfixPrec :: (Show a, Show b) => String -> Int -> Int -> a -> b -> ShowS showsInfixPrec opStr opPrec prec x y = showParen (prec >= opPrec) (showsPrec opPrec x . showString " " . showString opStr . showString " " . showsPrec opPrec y) concatS :: [ShowS] -> ShowS concatS = flip (foldr ($)) {- precedences appPrec :: Int appPrec = 10 -} utility-ht-0.0.17.2/src/Text/Read/0000755000175000001440000000000014642227107017455 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Text/Read/HT.hs0000644000175000001440000000166214642227107020331 0ustar00thielemausers00000000000000module Text.Read.HT where {-| Parse a string containing an infix operator. -} {-# INLINE readsInfixPrec #-} readsInfixPrec :: (Read a, Read b) => String -> Int -> Int -> (a -> b -> c) -> ReadS c readsInfixPrec opStr opPrec prec cons = readParen (prec >= opPrec) ((\s -> [(const . cons, s)]) .> readsPrec opPrec .> (filter ((opStr==).fst) . lex) .> readsPrec opPrec) {-| Compose two parsers sequentially. -} infixl 9 .> (.>) :: ReadS (b -> c) -> ReadS b -> ReadS c (.>) ra rb = concatMap (\(f,rest) -> map (\(b, rest') -> (f b, rest')) (rb rest)) . ra readMany :: (Read a) => String -> [a] readMany x = let contReadList [] = [] contReadList (y:[]) = fst y : readMany (snd y) contReadList _ = error "readMany: ambiguous parses" in contReadList (reads x) maybeRead :: Read a => String -> Maybe a maybeRead str = case reads str of [(x,"")] -> Just x _ -> Nothing utility-ht-0.0.17.2/src/Control/0000755000175000001440000000000014642227107017276 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Control/Functor/0000755000175000001440000000000014642227107020716 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Control/Functor/HT.hs0000644000175000001440000000336214642227107021571 0ustar00thielemausers00000000000000module Control.Functor.HT where import qualified Data.Tuple.HT as Tuple import Data.Tuple.HT (fst3, snd3, thd3) import qualified Prelude as P import Prelude (Functor, fmap, flip, const, (.), ($), fst, snd) void :: Functor f => f a -> f () void = fmap (const ()) map :: Functor f => (a -> b) -> f a -> f b map = fmap for :: Functor f => f a -> (a -> b) -> f b for = flip fmap {- | Caution: Every pair member has a reference to the argument of 'unzip'. Depending on the consumption pattern this may cause a memory leak. For lists, I think, you should generally prefer 'List.unzip'. -} unzip :: Functor f => f (a, b) -> (f a, f b) unzip x = (fmap fst x, fmap snd x) {- | Caution: See 'unzip'. -} unzip3 :: Functor f => f (a, b, c) -> (f a, f b, f c) unzip3 x = (fmap fst3 x, fmap snd3 x, fmap thd3 x) {- | Caution: See 'unzip'. -} uncurry :: Functor f => (f a -> f b -> g) -> f (a, b) -> g uncurry f = P.uncurry f . unzip {- | Caution: See 'unzip'. -} uncurry3 :: Functor f => (f a -> f b -> f c -> g) -> f (a, b, c) -> g uncurry3 f = Tuple.uncurry3 f . unzip3 mapFst :: Functor f => (a -> f c) -> (a, b) -> f (c, b) mapFst f ~(a,b) = fmap (flip (,) b) $ f a mapSnd :: Functor f => (b -> f c) -> (a, b) -> f (a, c) mapSnd f ~(a,b) = fmap ((,) a) $ f b mapFst3 :: Functor f => (a -> f d) -> (a,b,c) -> f (d,b,c) mapFst3 f ~(a,b,c) = fmap (\x -> (x,b,c)) $ f a mapSnd3 :: Functor f => (b -> f d) -> (a,b,c) -> f (a,d,c) mapSnd3 f ~(a,b,c) = fmap (\x -> (a,x,c)) $ f b mapThd3 :: Functor f => (c -> f d) -> (a,b,c) -> f (a,b,d) mapThd3 f ~(a,b,c) = fmap ((,,) a b) $ f c {- | Generalization of 'Data.List.HT.outerProduct'. -} outerProduct :: (Functor f, Functor g) => (a -> b -> c) -> f a -> g b -> f (g c) outerProduct f xs ys = fmap (flip fmap ys . f) xs utility-ht-0.0.17.2/src/Control/Applicative/0000755000175000001440000000000014642227107021537 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Control/Applicative/HT.hs0000644000175000001440000000414314642227107022410 0ustar00thielemausers00000000000000module Control.Applicative.HT where import qualified Data.Tuple.HT as Tuple import Control.Applicative (Applicative, liftA2, liftA3, (<$>), (<*>), ) mapPair :: (Applicative f) => (a -> f c, b -> f d) -> (a,b) -> f (c,d) mapPair fg = uncurry (liftA2 (,)) . Tuple.mapPair fg mapTriple :: (Applicative m) => (a -> m d, b -> m e, c -> m f) -> (a,b,c) -> m (d,e,f) mapTriple fgh = Tuple.uncurry3 (liftA3 (,,)) . Tuple.mapTriple fgh curry :: (Applicative f) => (f (a,b) -> g) -> f a -> f b -> g curry f a b = f $ lift2 (,) a b curry3 :: (Applicative f) => (f (a,b,c) -> g) -> f a -> f b -> f c -> g curry3 f a b c = f $ lift3 (,,) a b c {-# INLINE lift #-} lift :: Applicative m => (a -> r) -> m a -> m r lift = fmap {-# INLINE lift2 #-} lift2 :: Applicative m => (a -> b -> r) -> m a -> m b -> m r lift2 = liftA2 {-# INLINE lift3 #-} lift3 :: Applicative m => (a -> b -> c -> r) -> m a -> m b -> m c -> m r lift3 = liftA3 {-# INLINE lift4 #-} lift4 :: Applicative m => (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r lift4 fn a b c d = fn <$> a <*> b <*> c <*> d {-# INLINE lift5 #-} lift5 :: Applicative m => (a -> b -> c -> d -> e -> r) -> m a -> m b -> m c -> m d -> m e -> m r lift5 fn a b c d e = fn <$> a <*> b <*> c <*> d <*> e {-# INLINE lift6 #-} lift6 :: Applicative m => (a -> b -> c -> d -> e -> f -> r) -> m a -> m b -> m c -> m d -> m e -> m f -> m r lift6 fn a b c d e f = fn <$> a <*> b <*> c <*> d <*> e <*> f {-# DEPRECATED liftA4 "use App.lift4" #-} {-# INLINE liftA4 #-} liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e liftA4 f a b c d = f <$> a <*> b <*> c <*> d {-# DEPRECATED liftA5 "use App.lift5" #-} {-# INLINE liftA5 #-} liftA5 :: Applicative f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g liftA5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e {-# DEPRECATED liftA6 "use App.lift6" #-} {-# INLINE liftA6 #-} liftA6 :: Applicative f => (a -> b -> c -> d -> e -> g -> h) -> f a -> f b -> f c -> f d -> f e -> f g -> f h liftA6 f a b c d e g = f <$> a <*> b <*> c <*> d <*> e <*> g utility-ht-0.0.17.2/src/Control/Monad/0000755000175000001440000000000014642227107020334 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Control/Monad/HT.hs0000644000175000001440000000735014642227107021210 0ustar00thielemausers00000000000000module Control.Monad.HT where import qualified Control.Monad as M import qualified Data.List as List import Prelude hiding (repeat, until, ) infixr 1 <=< {- | Also present in newer versions of the 'base' package. -} (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<) f g = (f =<<) . g {- | Monadic 'List.repeat'. -} repeat :: (Monad m) => m a -> m [a] repeat x = let go = lift2 (:) x go in go nest :: (Monad m) => Int -> (a -> m a) -> a -> m a nest n f x0 = M.foldM (\x () -> f x) x0 (List.replicate n ()) {-# DEPRECATED untilM "use M.until" #-} {- | repeat action until result fulfills condition -} until, untilM :: (Monad m) => (a -> Bool) -> m a -> m a untilM = until until p m = let go = do x <- m if p x then return x else go in go {-# DEPRECATED iterateLimitM "use M.iterateLimit" #-} {- | parameter order equal to that of 'nest' -} iterateLimit, iterateLimitM :: Monad m => Int -> (a -> m a) -> a -> m [a] iterateLimitM = iterateLimit iterateLimit m f = let aux n x = lift (x:) $ if n==0 then return [] else aux (n-1) =<< f x in aux m {- | I think this makes only sense in a lazy monad like @Trans.State.Lazy@ or @IO.Lazy@. -} iterate :: Monad m => (a -> m a) -> a -> m [a] iterate f = let go x = lift (x:) $ go =<< f x in go {- | Lazy monadic conjunction. That is, when the first action returns @False@, then @False@ is immediately returned, without running the second action. -} andLazy :: (Monad m) => m Bool -> m Bool -> m Bool andLazy m0 m1 = m0 >>= \b -> if b then m1 else return False {- | Lazy monadic disjunction. That is, when the first action returns @True@, then @True@ is immediately returned, without running the second action. -} orLazy :: (Monad m) => m Bool -> m Bool -> m Bool orLazy m0 m1 = m0 >>= \b -> if b then return True else m1 void :: (Monad m) => m a -> m () void = lift (const ()) for :: Monad m => [a] -> (a -> m b) -> m [b] for = M.forM map :: Monad m => (a -> m b) -> [a] -> m [b] map = M.mapM zipWith :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWith = M.zipWithM chain :: (Monad m) => [a -> m a] -> (a -> m a) chain = foldr (flip (<=<)) return -- there is also mfilter, but this should be part of Control.Monad.Plus filter :: Monad m => (a -> m Bool) -> [a] -> m [a] filter = M.filterM replicate :: Monad m => Int -> m a -> m [a] replicate = M.replicateM lift :: Monad m => (a -> r) -> m a -> m r lift = M.liftM lift2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r lift2 = M.liftM2 lift3 :: Monad m => (a -> b -> c -> r) -> m a -> m b -> m c -> m r lift3 = M.liftM3 lift4 :: Monad m => (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r lift4 = M.liftM4 lift5 :: Monad m => (a -> b -> c -> d -> e -> r) -> m a -> m b -> m c -> m d -> m e -> m r lift5 = M.liftM5 {- that's just (=<<) liftJoin :: (Monad m) => (a -> m b) -> m a -> m b liftJoin f ma = join (lift f ma) -} liftJoin2 :: (Monad m) => (a -> b -> m c) -> m a -> m b -> m c liftJoin2 f ma mb = M.join (lift2 f ma mb) liftJoin3 :: (Monad m) => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d liftJoin3 f ma mb mc = M.join (lift3 f ma mb mc) liftJoin4 :: (Monad m) => (a -> b -> c -> d -> m e) -> m a -> m b -> m c -> m d -> m e liftJoin4 f ma mb mc md = M.join (lift4 f ma mb mc md) liftJoin5 :: (Monad m) => (a -> b -> c -> d -> e -> m f) -> m a -> m b -> m c -> m d -> m e -> m f liftJoin5 f ma mb mc md me = M.join (lift5 f ma mb mc md me) {- Add functions with restricted types? Shall their element types be monoids? Should we add these functions to a Foldable.HT module in order to save the underscore? (>>) mapM_ zipWithM_ sequence_ ... -} utility-ht-0.0.17.2/src/Data/0000755000175000001440000000000014642227107016527 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Strictness/0000755000175000001440000000000014642227107020670 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Strictness/HT.hs0000644000175000001440000000120214642227107021532 0ustar00thielemausers00000000000000module Data.Strictness.HT where {-# INLINE arguments1 #-} arguments1 :: (a -> x) -> a -> x arguments1 f a = f $! a {-# INLINE arguments2 #-} arguments2 :: (a -> b -> x) -> a -> b -> x arguments2 f a b = (f $! a) $! b {-# INLINE arguments3 #-} arguments3 :: (a -> b -> c -> x) -> a -> b -> c -> x arguments3 f a b c = ((f $! a) $! b) $! c {-# INLINE arguments4 #-} arguments4 :: (a -> b -> c -> d -> x) -> a -> b -> c -> d -> x arguments4 f a b c d = (((f $! a) $! b) $! c) $! d {-# INLINE arguments5 #-} arguments5 :: (a -> b -> c -> d -> e -> x) -> a -> b -> c -> d -> e -> x arguments5 f a b c d e = ((((f $! a) $! b) $! c) $! d) $! e utility-ht-0.0.17.2/src/Data/Tuple/0000755000175000001440000000000014642227107017620 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Tuple/Example.hs0000644000175000001440000000173214642227107021552 0ustar00thielemausers00000000000000module Data.Tuple.Example where import qualified Data.Tuple.Lazy as Lazy import qualified Data.Tuple.Strict as Strict import Data.List.HT (sieve, ) partitionLazy :: (a -> Bool) -> [a] -> ([a], [a]) partitionLazy p = foldr (\x -> (if p x then Lazy.mapFst else Lazy.mapSnd) (x:)) ([], []) partitionStrict :: (a -> Bool) -> [a] -> ([a], [a]) partitionStrict p = foldr (\x -> (if p x then Strict.mapFst else Strict.mapSnd) (x:)) ([], []) mainPartitionRuns :: IO () mainPartitionRuns = print $ partitionLazy (>=0) $ repeat (0::Int) mainPartitionBlocks :: IO () mainPartitionBlocks = print $ partitionStrict (>=0) $ repeat (0::Int) printSomeChars :: (Show a) => a -> IO () printSomeChars = putStrLn . sieve 100000 . show mainMemoryOk :: IO () mainMemoryOk = printSomeChars $ Strict.mapSnd (1+) $ (iterate (1+) (0::Int), 0::Int) mainMemoryLeak :: IO () mainMemoryLeak = printSomeChars $ Lazy.mapSnd (1+) $ (iterate (1+) (0::Int), 0::Int) utility-ht-0.0.17.2/src/Data/Tuple/Strict.hs0000644000175000001440000000251414642227107021426 0ustar00thielemausers00000000000000module Data.Tuple.Strict where -- * Pair {-# INLINE mapPair #-} mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) mapPair (f,g) (a,b) = (f a, g b) {-# INLINE mapFst #-} mapFst :: (a -> c) -> (a,b) -> (c,b) mapFst f (a,b) = (f a, b) {-# INLINE mapSnd #-} mapSnd :: (b -> c) -> (a,b) -> (a,c) mapSnd f (a,b) = (a, f b) {-# INLINE zipPair #-} zipPair :: (a,b) -> (c,d) -> ((a,c),(b,d)) zipPair (a,b) (c,d) = ((a,c),(b,d)) {-# INLINE zipWithPair #-} zipWithPair :: (a -> c -> e, b -> d -> f) -> (a,b) -> (c,d) -> (e,f) zipWithPair (e,f) (a,b) (c,d) = (e a c, f b d) {-# INLINE swap #-} swap :: (a,b) -> (b,a) swap (a,b) = (b,a) -- * Triple {-# INLINE mapTriple #-} mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f) mapTriple (f,g,h) (a,b,c) = (f a, g b, h c) {-# INLINE mapFst3 #-} mapFst3 :: (a -> d) -> (a,b,c) -> (d,b,c) mapFst3 f (a,b,c) = (f a, b, c) {-# INLINE mapSnd3 #-} mapSnd3 :: (b -> d) -> (a,b,c) -> (a,d,c) mapSnd3 f (a,b,c) = (a, f b, c) {-# INLINE mapThd3 #-} mapThd3 :: (c -> d) -> (a,b,c) -> (a,b,d) mapThd3 f (a,b,c) = (a, b, f c) {-# INLINE zipWithTriple #-} zipWithTriple :: (a -> d -> g, b -> e -> h, c -> f -> i) -> (a,b,c) -> (d,e,f) -> (g,h,i) zipWithTriple (g,h,i) (a,b,c) (d,e,f) = (g a d, h b e, i c f) {-# INLINE uncurry3 #-} uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f (a,b,c) = f a b c utility-ht-0.0.17.2/src/Data/Tuple/Lazy.hs0000644000175000001440000000415114642227107021074 0ustar00thielemausers00000000000000module Data.Tuple.Lazy where -- * Pair {- | Cf. '(Control.Arrow.***)'. Apply two functions on corresponding values in a pair, where the pattern match on the pair constructor is lazy. This is crucial in recursions such as the one of 'partition'. One the other hand there are applications where strict application is crucial, e.g. @mapSnd f ab@ where the left pair member is a large lazy list. With the lazy @mapSnd@ we make the application of @f@ depend on the whole pair @ab@. See "Data.Tuple.Example" for two examples where one variant is definitely better than the other one. -} {- Instead of lazy pattern matching with \code{(a,b)} we may use \function{fst} and \function{snd}. -} {-# INLINE mapPair #-} mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) mapPair ~(f,g) ~(a,b) = (f a, g b) -- | 'Control.Arrow.first' {-# INLINE mapFst #-} mapFst :: (a -> c) -> (a,b) -> (c,b) mapFst f ~(a,b) = (f a, b) -- | 'Control.Arrow.second' {-# INLINE mapSnd #-} mapSnd :: (b -> c) -> (a,b) -> (a,c) mapSnd f ~(a,b) = (a, f b) {-# INLINE zipPair #-} zipPair :: (a,b) -> (c,d) -> ((a,c),(b,d)) zipPair ~(a,b) ~(c,d) = ((a,c),(b,d)) {-# INLINE zipWithPair #-} zipWithPair :: (a -> c -> e, b -> d -> f) -> (a,b) -> (c,d) -> (e,f) zipWithPair ~(e,f) ~(a,b) ~(c,d) = (e a c, f b d) {-# INLINE swap #-} swap :: (a,b) -> (b,a) swap ~(a,b) = (b,a) {-# INLINE forcePair #-} forcePair :: (a,b) -> (a,b) forcePair ~(a,b) = (a,b) -- * Triple {-# INLINE mapTriple #-} mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f) mapTriple ~(f,g,h) ~(a,b,c) = (f a, g b, h c) {-# INLINE mapFst3 #-} mapFst3 :: (a -> d) -> (a,b,c) -> (d,b,c) mapFst3 f ~(a,b,c) = (f a, b, c) {-# INLINE mapSnd3 #-} mapSnd3 :: (b -> d) -> (a,b,c) -> (a,d,c) mapSnd3 f ~(a,b,c) = (a, f b, c) {-# INLINE mapThd3 #-} mapThd3 :: (c -> d) -> (a,b,c) -> (a,b,d) mapThd3 f ~(a,b,c) = (a, b, f c) {-# INLINE zipWithTriple #-} zipWithTriple :: (a -> d -> g, b -> e -> h, c -> f -> i) -> (a,b,c) -> (d,e,f) -> (g,h,i) zipWithTriple ~(g,h,i) ~(a,b,c) ~(d,e,f) = (g a d, h b e, i c f) {-# INLINE uncurry3 #-} uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f ~(a,b,c) = f a b c utility-ht-0.0.17.2/src/Data/Tuple/HT.hs0000644000175000001440000000207214642227107020470 0ustar00thielemausers00000000000000module Data.Tuple.HT ( -- * Pair mapPair, mapFst, mapSnd, swap, sortPair, forcePair, double, -- * Triple fst3, snd3, thd3, mapTriple, mapFst3, mapSnd3, mapThd3, curry3, uncurry3, triple, ) where import Data.Tuple.Lazy {- | Known as @dup@ in the 'Arrow' literature. -} {-# INLINE double #-} double :: a -> (a,a) double a = (a,a) {-# INLINE triple #-} triple :: a -> (a,a,a) triple a = (a,a,a) {-# INLINE fst3 #-} fst3 :: (a,b,c) -> a fst3 (x,_,_) = x {-# INLINE snd3 #-} snd3 :: (a,b,c) -> b snd3 (_,x,_) = x {-# INLINE thd3 #-} thd3 :: (a,b,c) -> c thd3 (_,_,x) = x {-# INLINE curry3 #-} curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d curry3 f a b c = f (a,b,c) {- | This is convenient for quick hacks but I suggest that you better define a type for an ordered pair for your application at hand. This way, you can clearly see from the type that a pair is ordered. -} sortPair, _sortPairMinMax :: (Ord a) => (a,a) -> (a,a) sortPair (x,y) = if x<=y then (x,y) else (y,x) _sortPairMinMax (x,y) = (min x y, max x y) utility-ht-0.0.17.2/src/Data/String/0000755000175000001440000000000014642227107017775 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/String/HT.hs0000644000175000001440000000070114642227107020642 0ustar00thielemausers00000000000000module Data.String.HT where import qualified Data.List.Reverse.StrictSpine as Rev import Data.Char (isSpace, ) {- | Remove leading and trailing spaces. We use spine strict 'Rev.dropWhile' instead of the element strict version. This is more efficient for finite 'String's because 'isSpace' is expensive. The downside is that 'trim' does not work for infinite 'String's. -} trim :: String -> String trim = Rev.dropWhile isSpace . dropWhile isSpace utility-ht-0.0.17.2/src/Data/Record/0000755000175000001440000000000014642227107017745 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Record/HT.hs0000644000175000001440000000015314642227107020613 0ustar00thielemausers00000000000000module Data.Record.HT ( R.compare, R.equal, ) where import qualified Data.Record.HT.Private as R utility-ht-0.0.17.2/src/Data/Record/HT/0000755000175000001440000000000014642227107020260 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Record/HT/Private.hs0000644000175000001440000000157214642227107022233 0ustar00thielemausers00000000000000module Data.Record.HT.Private where import Data.Monoid (mconcat, ) import Data.List.HT (switchL, ) {- | Lexicographically compare a list of attributes of two records. Example: > compare [comparing fst, comparing snd] -} {-# INLINE compare #-} compare :: [a -> a -> Ordering] -> a -> a -> Ordering compare cs x y = mconcat $ map (\c -> c x y) cs {-# INLINE compare1 #-} compare1 :: [a -> a -> Ordering] -> a -> a -> Ordering compare1 cs x y = switchL EQ const $ dropWhile (EQ==) $ map (\c -> c x y) cs {-# INLINE compare2 #-} compare2 :: [a -> a -> Ordering] -> a -> a -> Ordering compare2 cs x y = head $ dropWhile (EQ==) (map (\c -> c x y) cs) ++ [EQ] {- | Check whether a selected set of fields of two records is equal. Example: > equal [equating fst, equating snd] -} {-# INLINE equal #-} equal :: [a -> a -> Bool] -> a -> a -> Bool equal cs x y = all (\c -> c x y) cs utility-ht-0.0.17.2/src/Data/Ord/0000755000175000001440000000000014642227107017253 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Ord/HT.hs0000644000175000001440000000122214642227107020117 0ustar00thielemausers00000000000000module Data.Ord.HT where import Data.Function.HT (compose2, ) {-# INLINE comparing #-} comparing :: Ord b => (a -> b) -> a -> a -> Ordering comparing = compose2 compare {- | @limit (lower,upper) x@ restricts @x@ to the range from @lower@ to @upper@. Don't expect a sensible result for @lower>upper@. Called @clamp@ elsewhere. -} {-# INLINE limit #-} limit :: (Ord a) => (a,a) -> a -> a limit (l,u) = max l . min u {- | @limit (lower,upper) x@ checks whether @x@ is in the range from @lower@ to @upper@. Don't expect a sensible result for @lower>upper@. -} {-# INLINE inRange #-} inRange :: (Ord a) => (a,a) -> a -> Bool inRange (l,u) x = l<=x && x<=u utility-ht-0.0.17.2/src/Data/Monoid/0000755000175000001440000000000014642227107017754 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Monoid/HT.hs0000644000175000001440000000264414642227107020631 0ustar00thielemausers00000000000000module Data.Monoid.HT (cycle, (<>), when, power) where import Data.Monoid (Monoid, mappend, mempty, ) import Data.Function (fix, ) import Prelude (Integer, Bool, Ordering(..), compare, divMod, error) {- $setup >>> import qualified Test.QuickCheck as QC >>> import Control.Monad (mfilter) >>> import Data.Function.HT (powerAssociative) >>> import Data.Monoid (mconcat, mappend, mempty) -} {- | Generalization of 'Data.List.cycle' to any monoid. -} cycle :: Monoid m => m -> m cycle x = fix (mappend x) infixr 6 <> {- | Infix synonym for 'mappend'. -} (<>) :: Monoid m => m -> m -> m (<>) = mappend {- | prop> \b m -> when b m == mfilter (const b) (m::Maybe Ordering) prop> \b m -> when b m == mfilter (const b) (m::String) -} when :: Monoid m => Bool -> m -> m when b m = if b then m else mempty {- | prop> QC.forAll (QC.choose (0,20)) $ \k xs -> power (fromIntegral k) xs == mconcat (replicate k (xs::String)) In contrast to 'powerAssociative' the 'power' function uses 'mempty' only for the zeroth power. prop> QC.forAll (QC.choose (0,20)) $ \k xs -> power k xs == powerAssociative mappend mempty (xs::String) k -} power :: Monoid m => Integer -> m -> m power k m = case compare k 0 of LT -> error "Monoid.power: negative exponent" EQ -> mempty GT -> let (k2,r) = divMod k 2 p = power k2 m p2 = p<>p in case r of 0 -> p2 _ -> m<>p2 utility-ht-0.0.17.2/src/Data/Either/0000755000175000001440000000000014642227107017747 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Either/HT.hs0000644000175000001440000000113114642227107020612 0ustar00thielemausers00000000000000module Data.Either.HT ( mapLeft, mapRight, mapBoth, maybeLeft, maybeRight, swap, ) where mapLeft :: (a -> b) -> Either a c -> Either b c mapLeft f = either (Left . f) Right mapRight :: (b -> c) -> Either a b -> Either a c mapRight f = either Left (Right . f) mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d mapBoth f g = either (Left . f) (Right . g) maybeLeft :: Either a b -> Maybe a maybeLeft = either Just (const Nothing) maybeRight :: Either a b -> Maybe b maybeRight = either (const Nothing) Just swap :: Either a b -> Either b a swap = either Right Left utility-ht-0.0.17.2/src/Data/Maybe/0000755000175000001440000000000014642227107017564 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Maybe/HT.hs0000644000175000001440000000215614642227107020437 0ustar00thielemausers00000000000000module Data.Maybe.HT where import Data.Maybe (fromMaybe, ) import Control.Monad (msum, ) {- $setup >>> import Control.Monad (guard) -} {- It was proposed as addition to Data.Maybe and rejected at that time. -} {- | Returns 'Just' if the precondition is fulfilled. prop> \b x -> (guard b >> x) == (toMaybe b =<< (x::Maybe Char)) -} {-# INLINE toMaybe #-} toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True x = Just x infixl 6 ?-> {- | This is an infix version of 'fmap' for writing 'Data.Bool.HT.select' style expressions using test functions, that produce 'Maybe's. The precedence is chosen to be higher than '(:)', in order to allow: > alternatives default $ > checkForA ?-> (\a -> f a) : > checkForB ?-> (\b -> g b) : > [] The operation is left associative in order to allow to write > checkForA ?-> f ?-> g which is equivalent to > checkForA ?-> g . f due to the functor law. -} (?->) :: Maybe a -> (a -> b) -> Maybe b (?->) = flip fmap alternatives :: a -> [Maybe a] -> a alternatives deflt = fromMaybe deflt . msum utility-ht-0.0.17.2/src/Data/List/0000755000175000001440000000000014642227107017442 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/List/Match.hs0000644000175000001440000000036314642227107021034 0ustar00thielemausers00000000000000module Data.List.Match ( L.take, L.drop, L.splitAt, L.takeRev, L.dropRev, L.replicate, L.equalLength, L.compareLength, L.lessOrEqualLength, L.shorterList, ) where import qualified Data.List.Match.Private as L utility-ht-0.0.17.2/src/Data/List/Key.hs0000644000175000001440000000104114642227107020522 0ustar00thielemausers00000000000000{- | Variant of "Data.List" functions like 'Data.List.group', 'Data.List.sort' where the comparison is performed on a key computed from the list elements. In principle these functions could be replaced by e.g. @sortBy (compare `on` f)@, but @f@ will be re-computed for every comparison. If the evaluation of @f@ is expensive, our functions are better, since they buffer the results of @f@. -} module Data.List.Key ( L.nub, L.sort, L.minimum, L.maximum, L.group, L.merge, ) where import qualified Data.List.Key.Private as L utility-ht-0.0.17.2/src/Data/List/HT.hs0000644000175000001440000000427114642227107020315 0ustar00thielemausers00000000000000module Data.List.HT ( -- * Improved standard functions L.inits, L.tails, L.groupBy, L.group, L.unzip, L.partition, L.span, L.break, -- * Split L.chop, L.breakAfter, L.takeUntil, L.segmentAfter, L.segmentBefore, L.segmentAfterJust, segmentAfterMaybe, L.segmentBeforeJust, segmentBeforeMaybe, L.segmentAfterRight, L.segmentBeforeRight, L.removeEach, L.splitEverywhere, -- * inspect ends of a list L.splitLast, L.viewL, L.viewR, L.switchL, L.switchR, -- * List processing starting at the end L.dropRev, L.takeRev, L.splitAtRev, dropWhileRev, takeWhileRev, -- * List processing with Maybe and Either L.maybePrefixOf, L.maybeSuffixOf, L.partitionMaybe, L.takeWhileJust, L.dropWhileNothing, L.breakJust, L.spanJust, L.unzipEithers, -- * Sieve and slice L.sieve, L.sliceHorizontal, L.sliceVertical, -- * Search&replace L.search, L.replace, L.multiReplace, -- * Lists of lists L.shear, L.shearTranspose, L.outerProduct, -- * Miscellaneous L.takeWhileMulti, L.rotate, L.mergeBy, L.allEqual, L.isAscending, L.isAscendingLazy, L.mapAdjacent, L.mapAdjacent1, L.equalWith, L.range, L.padLeft, L.padRight, L.iterateAssociative, L.iterateLeaky, L.lengthAtLeast, L.lengthAtMost, ) where import qualified Data.List.HT.Private as L import qualified Data.List.Reverse.StrictElement as Rev {-# DEPRECATED dropWhileRev "Use dropWhile from Data.List.Reverse.StrictElement or Data.List.Reverse.StrictSpine instead" #-} dropWhileRev :: (a -> Bool) -> [a] -> [a] dropWhileRev = Rev.dropWhile {-# DEPRECATED takeWhileRev "Use takeWhile from Data.List.Reverse.StrictElement or Data.List.Reverse.StrictSpine instead" #-} takeWhileRev :: (a -> Bool) -> [a] -> [a] takeWhileRev = Rev.takeWhile {-# DEPRECATED segmentBeforeMaybe "use segmentBeforeJust instead" #-} segmentBeforeMaybe :: (a -> Maybe b) -> [a] -> ([a], [(b, [a])]) segmentBeforeMaybe = L.segmentBeforeJust {-# DEPRECATED segmentAfterMaybe "use segmentAfterJust instead" #-} segmentAfterMaybe :: (a -> Maybe b) -> [a] -> ([([a], b)], [a]) segmentAfterMaybe = L.segmentAfterJust utility-ht-0.0.17.2/src/Data/List/Match/0000755000175000001440000000000014642227107020476 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/List/Match/Private.hs0000644000175000001440000001330114642227107022442 0ustar00thielemausers00000000000000module Data.List.Match.Private where import Data.Maybe (fromJust, isNothing, ) import Data.Maybe.HT (toMaybe, ) import Data.Tuple.HT (mapFst, forcePair, ) import Data.Bool.HT (if', ) import qualified Data.List as List import Control.Functor.HT (void, ) import Prelude hiding (take, drop, splitAt, replicate, ) -- $setup -- >>> import qualified Data.List.Match.Private as Match -- >>> import qualified Data.List as List -- >>> -- >>> import qualified Test.QuickCheck as QC -- >>> -- >>> newtype List = List [Integer] deriving (Show) -- >>> instance QC.Arbitrary List where -- >>> arbitrary = fmap List QC.arbitrary -- >>> shrink (List xs) = map List $ QC.shrink xs -- >>> -- >>> newtype Shape = Shape [Ordering] deriving (Show) -- >>> instance QC.Arbitrary Shape where -- >>> arbitrary = fmap Shape QC.arbitrary -- >>> shrink (Shape xs) = map Shape $ QC.shrink xs {- | Make a list as long as another one prop> \(Shape xs) (List ys) -> Match.take xs ys == List.take (length xs) ys -} {- @flip (zipWith const)@ is not as lazy, e.g. would be @take [] undefined = undefined@, but it should be @take [] undefined = []@. -} take :: [b] -> [a] -> [a] take = zipWith (flip const) {- | Drop as many elements as the first list is long prop> \(Shape xs) (List ys) -> Match.drop xs ys == List.drop (length xs) ys prop> \(Shape xs) (List ys) -> Match.take xs ys ++ Match.drop xs ys == ys -} drop :: [b] -> [a] -> [a] drop xs ys0 = foldl (\ys _ -> laxTail ys) ys0 xs -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == dropRec xs ys {- Shares suffix with input, that is it is more efficient than the implementations below. -} dropRec :: [b] -> [a] -> [a] dropRec (_:xs) (_:ys) = dropRec xs ys dropRec _ ys = ys -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop0 xs ys drop0 :: [b] -> [a] -> [a] drop0 xs ys = -- catMaybes ( map fromJust (dropWhile isNothing (zipWith (toMaybe . null) (iterate laxTail xs) ys)) -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop1 xs ys drop1 :: [b] -> [a] -> [a] drop1 xs ys = map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys)) -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop2 xs ys drop2 :: [b] -> [a] -> [a] drop2 xs ys = snd $ head $ dropWhile (not . null . fst) $ zip (iterate laxTail xs) (iterate laxTail ys) {- | >>> laxTail "" "" >>> laxTail "a" "" >>> laxTail "ab" "b" -} laxTail :: [a] -> [a] laxTail xt = case xt of [] -> []; _:xs -> xs -- | prop> \(List xs) -> Match.laxTail xs == Match.laxTail0 xs laxTail0 :: [a] -> [a] laxTail0 = List.drop 1 {- | prop> \(Shape xs) (List ys) -> Match.splitAt xs ys == (Match.take xs ys, Match.drop xs ys) prop> \(Shape xs) (List ys) -> Match.splitAt xs ys == List.splitAt (length xs) ys -} splitAt :: [b] -> [a] -> ([a],[a]) splitAt nt xt = forcePair $ case (nt,xt) of (_:ns, x:xs) -> mapFst (x:) $ splitAt ns xs (_, xs) -> ([],xs) -- | prop> \(Shape xs) (List ys) -> Match.takeRev xs ys == reverse (Match.take xs (reverse ys)) takeRev :: [b] -> [a] -> [a] takeRev ys xs = drop (drop ys xs) xs -- | prop> \(Shape xs) (List ys) -> Match.dropRev xs ys == reverse (Match.drop xs (reverse ys)) dropRev :: [b] -> [a] -> [a] dropRev ys xs = take (drop ys xs) xs {- | Check whether two lists with different element types have equal length. It holds prop> \(Shape xs) (List ys) -> equalLength xs ys == (length xs == length ys) but 'equalLength' is more efficient. -} equalLength :: [a] -> [b] -> Bool equalLength xs ys = void xs == void ys {- | Compare the length of two lists over different types. It holds prop> \(Shape xs) (List ys) -> compareLength xs ys == compare (length xs) (length ys) but 'compareLength' is more efficient. -} compareLength :: [a] -> [b] -> Ordering compareLength xs ys = compare (void xs) (void ys) {- | this one uses explicit recursion prop> \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength0 xs ys -} compareLength0 :: [a] -> [b] -> Ordering compareLength0 = let recourse (_:xs) (_:ys) = recourse xs ys recourse [] [] = EQ recourse (_:_) [] = GT recourse [] (_:_) = LT in recourse {- | strict comparison prop> \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength1 xs ys -} compareLength1 :: [a] -> [b] -> Ordering compareLength1 xs ys = compare (length xs) (length ys) {- | @lessOrEqualLength x y@ is almost the same as @compareLength x y <= EQ@, but >>> lessOrEqualLength "" undefined True whereas @compareLength [] undefined <= EQ = undefined@. -} lessOrEqualLength :: [a] -> [b] -> Bool lessOrEqualLength [] _ = True lessOrEqualLength _ [] = False lessOrEqualLength (_:xs) (_:ys) = lessOrEqualLength xs ys {- | Returns the shorter one of two lists. It works also for infinite lists as much as possible. E.g. >>> shorterList (shorterList (repeat 'a') (repeat 'b')) "abc" "abc" The trick is, that the skeleton of the resulting list is constructed using 'zipWith' without touching the elements. The contents is then computed (only) if requested. -} shorterList :: [a] -> [a] -> [a] shorterList xs ys = let useX = lessOrEqualLength xs ys in zipWith (if' useX) xs ys {- | This is lazier than 'shorterList' in a different aspect: It returns a common prefix even if it is undefined, which list is the shorter one. However, it requires a proper 'Eq' instance and if elements are undefined, it may fail even earlier. >>> List.take 3 $ shorterListEq ("abc" ++ repeat 'a') ("abcdef" ++ repeat 'b') "abc" -} shorterListEq :: (Eq a) => [a] -> [a] -> [a] shorterListEq xs ys = let useX = lessOrEqualLength xs ys in zipWith (\x y -> if' (x==y || useX) x y) xs ys {- | Specialisation of 'Data.Functor.$>'. -} replicate :: [a] -> b -> [b] replicate xs y = take xs (repeat y) utility-ht-0.0.17.2/src/Data/List/Key/0000755000175000001440000000000014642227107020172 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/List/Key/Private.hs0000644000175000001440000000534614642227107022150 0ustar00thielemausers00000000000000module Data.List.Key.Private where import Data.Function.HT (compose2, ) import Data.List (nubBy, sortBy, minimumBy, maximumBy, ) import Prelude hiding (minimum, maximum, ) attach :: (a -> b) -> [a] -> [(b,a)] attach key = map (\x -> (key x, x)) aux :: (((key, a) -> (key, a) -> b) -> [(key, a)] -> c) -> (key -> key -> b) -> (a -> key) -> ([a] -> c) aux listFunc cmpFunc key = listFunc (compose2 cmpFunc fst) . attach key aux' :: ((a -> a -> b) -> [a] -> c) -> (key -> key -> b) -> (a -> key) -> ([a] -> c) aux' listFunc cmpFunc key = listFunc (compose2 cmpFunc key) {- | Divides a list into sublists such that the members in a sublist share the same key. It uses semantics of 'Data.List.HT.groupBy', not that of 'Data.List.groupBy'. -} group :: Eq b => (a -> b) -> [a] -> [[a]] group key = map (map snd) . aux groupBy (==) key {- | Will be less efficient than 'group' if @key@ is computationally expensive. This is so because the key is re-evaluated for each list item. Alternatively you may write @groupBy ((==) `on` key)@. -} group' :: Eq b => (a -> b) -> [a] -> [[a]] group' = aux' groupBy (==) propGroup :: (Eq a, Eq b) => (a -> b) -> [a] -> Bool propGroup key xs = group key xs == group' key xs {- | argmin -} minimum :: Ord b => (a -> b) -> [a] -> a minimum key = snd . aux minimumBy compare key {- | argmax -} maximum :: Ord b => (a -> b) -> [a] -> a maximum key = snd . aux maximumBy compare key sort :: Ord b => (a -> b) -> [a] -> [a] sort key = map snd . aux sortBy compare key merge :: Ord b => (a -> b) -> [a] -> [a] -> [a] merge key xs ys = map snd $ mergeBy (compose2 (<=) fst) (attach key xs) (attach key ys) nub :: Eq b => (a -> b) -> [a] -> [a] nub key = map snd . aux nubBy (==) key -- * helper functions groupBy :: (a -> a -> Bool) -> [a] -> [[a]] groupBy p = map (uncurry (:)) . groupByNonEmpty p groupByNonEmpty :: (a -> a -> Bool) -> [a] -> [(a,[a])] groupByNonEmpty p = foldr (\x0 yt -> let (xr,yr) = case yt of (x1,xs):ys -> if p x0 x1 then (x1:xs,ys) else ([],yt) [] -> ([],yt) in (x0,xr):yr) [] groupByEmpty :: (a -> a -> Bool) -> [a] -> [[a]] groupByEmpty p = uncurry (:) . foldr (\x0 ~(y,ys) -> if (case y of x1:_ -> p x0 x1; _ -> True) then (x0:y,ys) else (x0:[],y:ys)) ([],[]) mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] mergeBy p = let recourse [] yl = yl recourse xl [] = xl recourse xl@(x:xs) yl@(y:ys) = uncurry (:) $ if p x y then (x, recourse xs yl) else (y, recourse xl ys) in recourse utility-ht-0.0.17.2/src/Data/List/HT/0000755000175000001440000000000014642227107017755 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/List/HT/Private.hs0000644000175000001440000010405114642227107021724 0ustar00thielemausers00000000000000module Data.List.HT.Private where import Data.List as List (find, transpose, unfoldr, isPrefixOf, findIndices, foldl', mapAccumL, ) import Data.Maybe as Maybe (fromMaybe, catMaybes, isJust, mapMaybe, ) import Data.Maybe.HT (toMaybe, ) import Control.Monad.HT ((<=<), ) import Control.Monad (guard, msum, mplus, liftM2, ) import Control.Applicative ((<$>), (<*>), ) import Data.Tuple.HT (mapPair, mapFst, mapSnd, forcePair, swap, ) import qualified Control.Functor.HT as Func import qualified Data.List.Key.Private as Key import qualified Data.List.Match.Private as Match import qualified Data.List.Reverse.StrictElement as Rev import Prelude hiding (unzip, break, span, ) -- $setup -- >>> import qualified Test.QuickCheck as QC -- >>> import Test.Utility (forAllPredicates) -- >>> import Test.QuickCheck (NonNegative(NonNegative), Positive(Positive), NonEmptyList(NonEmpty)) -- >>> import qualified Data.List as List -- >>> import Data.List (transpose) -- >>> import Data.Maybe.HT (toMaybe) -- >>> import Data.Maybe (mapMaybe, isNothing) -- >>> import Data.Char (isLetter, isUpper, toUpper) -- >>> import Data.Eq.HT (equating) -- >>> import Control.Monad (liftM2) -- >>> -- >>> divMaybe :: Int -> Int -> Maybe Int -- >>> divMaybe m n = case divMod n m of (q,0) -> Just q; _ -> Nothing -- >>> -- >>> forAllMaybeFn :: (QC.Testable test) => ((Int -> Maybe Int) -> test) -> QC.Property -- >>> forAllMaybeFn prop = QC.forAll (QC.choose (1,4)) $ prop . divMaybe -- * Improved standard functions {- | This function is lazier than the one suggested in the Haskell 98 report. It is @inits undefined = [] : undefined@, in contrast to @Data.List.inits undefined = undefined@. -} {- suggested in -} inits :: [a] -> [[a]] inits = map reverse . scanl (flip (:)) [] {- | As lazy as 'inits' but less efficient because of repeated 'map'. -} initsLazy :: [a] -> [[a]] initsLazy xt = [] : case xt of [] -> [] x:xs -> map (x:) (initsLazy xs) {- | Suggested implementation in the Haskell 98 report. It is not as lazy as possible. -} inits98 :: [a] -> [[a]] inits98 [] = [[]] inits98 (x:xs) = [[]] ++ map (x:) (inits98 xs) inits98' :: [a] -> [[a]] inits98' = foldr (\x prefixes -> [] : map (x:) prefixes) [[]] {- | This function is lazier than the one suggested in the Haskell 98 report. It is @tails undefined = ([] : undefined) : undefined@, in contrast to @Data.List.tails undefined = undefined@. -} tails :: [a] -> [[a]] tails xt = uncurry (:) $ case xt of [] -> ([],[]) _:xs -> (xt, tails xs) tails' :: [a] -> [[a]] tails' = fst . breakAfter null . iterate tail tails98 :: [a] -> [[a]] tails98 [] = [[]] tails98 xxs@(_:xs) = xxs : tails98 xs {- | This function compares adjacent elements of a list. If two adjacent elements satisfy a relation then they are put into the same sublist. Example: >>> groupBy (<) "abcdebcdef" ["abcde","bcdef"] In contrast to that 'Data.List.groupBy' compares the head of each sublist with each candidate for this sublist. This yields >>> List.groupBy (<) "abcdebcdef" ["abcdebcdef"] The second @'b'@ is compared with the leading @'a'@. Thus it is put into the same sublist as @'a'@. The sublists are never empty. Thus the more precise result type would be @[(a,[a])]@. -} groupBy :: (a -> a -> Bool) -> [a] -> [[a]] groupBy = Key.groupBy group :: (Eq a) => [a] -> [[a]] group = groupBy (==) {- | Like standard 'unzip' but more lazy. It is @Data.List.unzip undefined == undefined@, but @unzip undefined == (undefined, undefined)@. -} unzip :: [(a,b)] -> ([a],[b]) unzip = forcePair . foldr (\ (x,y) ~(xs,ys) -> (x:xs,y:ys)) ([],[]) {- | 'Data.List.partition' of GHC 6.2.1 fails on infinite lists. But this one does not. -} {- The lazy pattern match @(y,z)@ is necessary since otherwise it fails on infinite lists. -} partition :: (a -> Bool) -> [a] -> ([a], [a]) partition p = forcePair . foldr (\x ~(y,z) -> if p x then (x : y, z) else (y, x : z)) ([],[]) {- | It is @Data.List.span f undefined = undefined@, whereas @span f undefined = (undefined, undefined)@. -} span, break :: (a -> Bool) -> [a] -> ([a],[a]) span p = let recourse xt = forcePair $ fromMaybe ([],xt) $ do (x,xs) <- viewL xt guard $ p x return $ mapFst (x:) $ recourse xs in recourse break p = span (not . p) -- * Split {- | Split the list at the occurrences of a separator into sub-lists. Remove the separators. This is somehow a generalization of 'lines' and 'words'. But note the differences: >>> words "a a" ["a","a"] >>> chop (' '==) "a a" ["a","","a"] >>> lines "a\n\na" ["a","","a"] >>> chop ('\n'==) "a\n\na" ["a","","a"] >>> lines "a\n" ["a"] >>> chop ('\n'==) "a\n" ["a",""] -} chop :: (a -> Bool) -> [a] -> [[a]] chop p = uncurry (:) . foldr (\ x ~(y,ys) -> if p x then ([],y:ys) else ((x:y),ys) ) ([],[]) chop' :: (a -> Bool) -> [a] -> [[a]] chop' p = let recourse = uncurry (:) . mapSnd (switchL [] (const recourse)) . break p in recourse chopAtRun :: (a -> Bool) -> [a] -> [[a]] chopAtRun p = let recourse [] = [[]] recourse y = let (z,zs) = break p (dropWhile p y) in z : recourse zs in recourse {- | Like 'break', but splits after the matching element. prop> forAllPredicates $ \p xs -> uncurry (++) (breakAfter p xs) == xs -} breakAfter :: (a -> Bool) -> [a] -> ([a], [a]) breakAfter = breakAfterRec breakAfterRec :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterRec p = let recourse [] = ([],[]) recourse (x:xs) = mapFst (x:) $ if p x then ([],xs) else recourse xs in forcePair . recourse {- The use of 'foldr' might allow for fusion, but unfortunately this simple implementation would copy the tail of the list. -} -- | prop> forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterFoldr p xs breakAfterFoldr :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterFoldr p = forcePair . foldr (\x yzs -> mapFst (x:) $ if p x then ([], uncurry (++) yzs) else yzs) ([],[]) -- | prop> forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterBreak p xs breakAfterBreak :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterBreak p xs = case break p xs of (ys, []) -> (ys, []) (ys, z:zs) -> (ys++[z], zs) -- | prop> forAllPredicates $ \p xs -> breakAfterRec p xs == breakAfterTakeUntil p xs breakAfterTakeUntil :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterTakeUntil p xs = forcePair $ (\ys -> (map fst ys, maybe [] (snd . snd) $ viewR ys)) $ takeUntil (p . fst) $ zip xs $ tail $ tails xs {- | Take all elements until one matches. The matching element is returned, too. This is the key difference to @takeWhile (not . p)@. It holds: prop> forAllPredicates $ \p xs -> takeUntil p xs == fst (breakAfter p xs) -} takeUntil :: (a -> Bool) -> [a] -> [a] takeUntil p = foldr (\x ys -> x : if p x then [] else ys) [] {- | Split the list after each occurence of a terminator. Keep the terminator. There is always a list for the part after the last terminator. It may be empty. See package @non-empty@ for more precise result type. prop> forAllPredicates $ \p xs -> concat (segmentAfter p xs) == xs prop> forAllPredicates $ \p xs -> length (filter p xs) == length (tail (segmentAfter p xs)) prop> forAllPredicates $ \p -> all (p . last) . init . segmentAfter p prop> forAllPredicates $ \p -> all (all (not . p) . init) . init . segmentAfter p This test captures both infinitely many groups and infinitely big groups: prop> forAllPredicates $ \p x -> flip seq True . (!!100) . concat . segmentAfter p . cycle . (x:) -} segmentAfter :: (a -> Bool) -> [a] -> [[a]] segmentAfter p = uncurry (:) . foldr (\x ~(y,ys) -> mapFst (x:) $ if p x then ([],y:ys) else (y,ys)) ([],[]) segmentAfter' :: (a -> Bool) -> [a] -> [[a]] segmentAfter' p = foldr (\ x ~yt@(y:ys) -> if p x then [x]:yt else (x:y):ys) [[]] {- | Split the list before each occurence of a leading character. Keep these characters. There is always a list for the part before the first leading character. It may be empty. See package @non-empty@ for more precise result type. >>> segmentBefore isUpper "AbcdXyz" ["","Abcd","Xyz"] >>> segmentBefore isUpper "kAbcdXYZ" ["k","Abcd","X","Y","Z"] prop> forAllPredicates $ \p xs -> concat (segmentBefore p xs) == xs prop> forAllPredicates $ \p xs -> length (filter p xs) == length (tail (segmentBefore p xs)) prop> forAllPredicates $ \p -> all (p . head) . tail . segmentBefore p prop> forAllPredicates $ \p -> all (all (not . p) . tail) . tail . segmentBefore p prop> forAllPredicates $ \p x -> flip seq True . (!!100) . concat . segmentBefore p . cycle . (x:) -} segmentBefore :: (a -> Bool) -> [a] -> [[a]] segmentBefore p = -- foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]] uncurry (:) . foldr (\ x ~(y,ys) -> let xs = x:y in if p x then ([],xs:ys) else (xs,ys)) ([],[]) -- | prop> forAllPredicates $ \p xs -> segmentBefore p xs == segmentBefore' p xs segmentBefore' :: (a -> Bool) -> [a] -> [[a]] segmentBefore' p = uncurry (:) . (\xst -> fromMaybe ([],xst) $ do ((x:xs):xss) <- Just xst guard $ not $ p x return (x:xs, xss)) . groupBy (\_ x -> not $ p x) -- | prop> forAllPredicates $ \p xs -> segmentBefore p xs == segmentBefore'' p xs segmentBefore'' :: (a -> Bool) -> [a] -> [[a]] segmentBefore'' p = (\xst -> case xst of ~(xs:xss) -> tail xs : xss) . groupBy (\_ x -> not $ p x) . (error "segmentBefore: dummy element" :) {- | >>> segmentBeforeJust (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" ("123",[('A',"5345"),('B',"---")]) -} segmentBeforeJust :: (a -> Maybe b) -> [a] -> ([a], [(b, [a])]) segmentBeforeJust f = forcePair . foldr (\ x ~(y,ys) -> case f x of Just b -> ([],(b,y):ys) Nothing -> (x:y,ys)) ([],[]) {- | >>> segmentAfterJust (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" ([("123",'A'),("5345",'B')],"---") -} segmentAfterJust :: (a -> Maybe b) -> [a] -> ([([a], b)], [a]) segmentAfterJust f = swap . uncurry (mapAccumL (\as0 (b,as1) -> (as1, (as0,b)))) . segmentBeforeJust f {- | >>> segmentBeforeRight [Left 'a', Right LT, Right GT, Left 'b'] ("a",[(LT,""),(GT,"b")]) prop> forAllMaybeFn $ \f xs -> segmentBeforeJust f xs == segmentBeforeRight (map (\x -> maybe (Left x) Right (f x)) xs) -} segmentBeforeRight :: [Either a b] -> ([a], [(b, [a])]) segmentBeforeRight = forcePair . foldr (\ x ~(y,ys) -> case x of Right b -> ([],(b,y):ys) Left a -> (a:y,ys)) ([],[]) {- | >>> segmentAfterRight [Left 'a', Right LT, Right GT, Left 'b'] ([("a",LT),("",GT)],"b") prop> forAllMaybeFn $ \f xs -> segmentAfterJust f xs == segmentAfterRight (map (\x -> maybe (Left x) Right (f x)) xs) -} segmentAfterRight :: [Either a b] -> ([([a], b)], [a]) segmentAfterRight = swap . uncurry (mapAccumL (\as0 (b,as1) -> (as1, (as0,b)))) . segmentBeforeRight -- cf. Matroid.hs {- | @removeEach xs@ represents a list of sublists of @xs@, where each element of @xs@ is removed and the removed element is separated. It seems to be much simpler to achieve with @zip xs (map (flip List.delete xs) xs)@, but the implementation of 'removeEach' does not need the 'Eq' instance and thus can also be used for lists of functions. See also the proposal >>> removeEach "abc" [('a',"bc"),('b',"ac"),('c',"ab")] >>> removeEach "a" [('a',"")] >>> removeEach "" [] -} removeEach :: [a] -> [(a, [a])] removeEach = map (\(ys, pivot, zs) -> (pivot,ys++zs)) . splitEverywhere {- | >>> splitEverywhere "abc" [("",'a',"bc"),("a",'b',"c"),("ab",'c',"")] >>> splitEverywhere "a" [("",'a',"")] >>> splitEverywhere "" [] -} splitEverywhere :: [a] -> [([a], a, [a])] splitEverywhere xs = map (\(y, zs0) -> case zs0 of z:zs -> (y,z,zs) [] -> error "splitEverywhere: empty list") (init (zip (inits xs) (tails xs))) -- * inspect ends of a list {-# DEPRECATED splitLast "use viewR instead" #-} {- | It holds @splitLast xs == (init xs, last xs)@, but 'splitLast' is more efficient if the last element is accessed after the initial ones, because it avoids memoizing list. prop> \(NonEmpty xs) -> splitLast (xs::String) == (init xs, last xs) -} splitLast :: [a] -> ([a], a) splitLast [] = error "splitLast: empty list" splitLast [x] = ([], x) splitLast (x:xs) = let (xs', lastx) = splitLast xs in (x:xs', lastx) {- | Should be prefered to 'head' and 'tail'. -} {-# INLINE viewL #-} viewL :: [a] -> Maybe (a, [a]) viewL (x:xs) = Just (x,xs) viewL [] = Nothing {- | Should be prefered to 'init' and 'last'. prop> \xs -> maybe True ((init xs, last xs) == ) (viewR (xs::String)) -} viewR :: [a] -> Maybe ([a], a) viewR = foldr (\x -> Just . forcePair . maybe ([],x) (mapFst (x:))) Nothing {- | Should be prefered to 'head' and 'tail'. -} {-# INLINE switchL #-} switchL :: b -> (a -> [a] -> b) -> [a] -> b switchL n _ [] = n switchL _ j (x:xs) = j x xs switchL' :: b -> (a -> [a] -> b) -> [a] -> b switchL' n j = maybe n (uncurry j) . viewL {- | Should be prefered to 'init' and 'last'. prop> \xs -> switchR True (\ixs lxs -> ixs == init xs && lxs == last xs) (xs::String) -} {-# INLINE switchR #-} switchR :: b -> ([a] -> a -> b) -> [a] -> b switchR n j = maybe n (uncurry j) . viewR -- * List processing starting at the end {- | @takeRev n@ is like @reverse . take n . reverse@ but it is lazy enough to work for infinite lists, too. prop> \n xs -> takeRev n (xs::String) == reverse (take n (reverse xs)) -} takeRev :: Int -> [a] -> [a] takeRev n xs = Match.drop (drop n xs) xs {- | @dropRev n@ is like @reverse . drop n . reverse@ but it is lazy enough to work for infinite lists, too. prop> \n xs -> dropRev n (xs::String) == reverse (drop n (reverse xs)) -} dropRev :: Int -> [a] -> [a] dropRev n xs = Match.take (drop n xs) xs {- | @splitAtRev n xs == (dropRev n xs, takeRev n xs)@. prop> \n xs -> splitAtRev n (xs::String) == (dropRev n xs, takeRev n xs) prop> \n xs -> (xs::String) == uncurry (++) (splitAtRev n xs) -} splitAtRev :: Int -> [a] -> ([a], [a]) splitAtRev n xs = Match.splitAt (drop n xs) xs -- * List processing with Maybe and Either {- | @maybePrefixOf xs ys@ is @Just zs@ if @xs@ is a prefix of @ys@, where @zs@ is @ys@ without the prefix @xs@. Otherwise it is @Nothing@. It is the same as 'Data.List.stripPrefix'. >>> maybePrefixOf "abc" "abcdef" Just "def" >>> maybePrefixOf "def" "abcdef" Nothing -} maybePrefixOf :: Eq a => [a] -> [a] -> Maybe [a] maybePrefixOf (x:xs) (y:ys) = guard (x==y) >> maybePrefixOf xs ys maybePrefixOf [] ys = Just ys maybePrefixOf _ [] = Nothing {- | >>> maybeSuffixOf "abc" "abcdef" Nothing >>> maybeSuffixOf "def" "abcdef" Just "abc" -} maybeSuffixOf :: Eq a => [a] -> [a] -> Maybe [a] maybeSuffixOf xs ys = fmap reverse $ maybePrefixOf (reverse xs) (reverse ys) {- | Partition a list into elements which evaluate to @Just@ or @Nothing@ by @f@. prop> forAllMaybeFn $ \f xs -> partitionMaybe f xs == (mapMaybe f xs, filter (isNothing . f) xs) prop> forAllPredicates $ \p xs -> partition p xs == partitionMaybe (\x -> toMaybe (p x) x) xs -} partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a]) partitionMaybe f = forcePair . foldr (\x -> maybe (mapSnd (x:)) (\y -> mapFst (y:)) (f x)) ([],[]) {- | This is the cousin of 'takeWhile' analogously to 'catMaybes' being the cousin of 'filter'. >>> takeWhileJust [Just 'a', Just 'b', Nothing, Just 'c'] "ab" Example: Keep the heads of sublists until an empty list occurs. >>> takeWhileJust $ map (fmap fst . viewL) ["abc","def","","xyz"] "ad" For consistency with 'takeWhile', 'partitionMaybe' and 'dropWhileNothing' it should have been: > takeWhileJust_ :: (a -> Maybe b) -> a -> [b] However, both variants are interchangeable: > takeWhileJust_ f == takeWhileJust . map f > takeWhileJust == takeWhileJust_ id -} takeWhileJust :: [Maybe a] -> [a] takeWhileJust = foldr (\x acc -> maybe [] (:acc) x) [] dropWhileNothing :: (a -> Maybe b) -> [a] -> Maybe (b, [a]) dropWhileNothing f = msum . map (Func.mapFst f <=< viewL) . tails -- | prop> forAllMaybeFn $ \f xs -> dropWhileNothing f xs == dropWhileNothingRec f xs dropWhileNothingRec :: (a -> Maybe b) -> [a] -> Maybe (b, [a]) dropWhileNothingRec f = let go [] = Nothing go (a:xs) = (flip (,) xs <$> f a) `mplus` go xs in go -- | prop> forAllMaybeFn $ \f xs -> snd (breakJust f xs) == dropWhileNothing f xs breakJust :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a])) breakJust f = let go [] = ([], Nothing) go (a:xs) = case f a of Nothing -> mapFst (a:) $ go xs Just b -> ([], Just (b, xs)) in go -- memory leak, because xs is hold all the time -- | prop> forAllMaybeFn $ \f xs -> breakJust f xs == breakJustRemoveEach f xs breakJustRemoveEach :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a])) breakJustRemoveEach f xs = switchL (xs, Nothing) const $ mapMaybe (\(ys,a,zs) -> (\b -> (ys, Just (b,zs))) <$> f a) $ splitEverywhere xs -- needs to apply 'f' twice at the end and uses partial functions -- | prop> forAllMaybeFn $ \f xs -> breakJust f xs == breakJustPartial f xs breakJustPartial :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a])) breakJustPartial f xs = let (ys,zs) = break (isJust . f) xs in (ys, mapFst (maybe (error "breakJust: unexpected Nothing") id . f) <$> viewL zs) spanJust :: (a -> Maybe b) -> [a] -> ([b], [a]) spanJust f = let go [] = ([], []) go xt@(a:xs) = case f a of Just b -> mapFst (b:) $ go xs Nothing -> ([], xt) in go unzipEithers :: [Either a b] -> ([a], [b]) unzipEithers = forcePair . foldr (either (\x -> mapFst (x:)) (\y -> mapSnd (y:))) ([],[]) -- * Sieve and slice {- | keep every k-th value from the list >>> sieve 6 ['a'..'z'] "agmsy" -} sieve, sieve', sieve'', sieve''' :: Int -> [a] -> [a] sieve k = unfoldr (\xs -> toMaybe (not (null xs)) (head xs, drop k xs)) -- | prop> \(Positive n) xs -> sieve n xs == sieve' n (xs::String) sieve' k = map head . sliceVertical k -- | prop> \(Positive n) xs -> sieve n xs == sieve'' n (xs::String) sieve'' k x = map (x!!) [0,k..(length x-1)] -- | prop> \(Positive n) xs -> sieve n xs == sieve''' n (xs::String) sieve''' k = map head . takeWhile (not . null) . iterate (drop k) {- sliceHorizontal is faster than sliceHorizontal' but consumes slightly more memory (although it needs no swapping) -} {- | >>> sliceHorizontal 6 ['a'..'z'] ["agmsy","bhntz","ciou","djpv","ekqw","flrx"] prop> \(NonEmpty xs) -> QC.forAll (QC.choose (1, length xs)) $ \n -> sliceHorizontal n xs == transpose (sliceVertical n (xs::String)) prop> \(NonEmpty xs) -> QC.forAll (QC.choose (1, length xs)) $ \n -> sliceVertical n xs == transpose (sliceHorizontal n (xs::String)) The properties do not hold for empty lists because of: >>> sliceHorizontal 4 ([]::[Int]) [[],[],[],[]] -} sliceHorizontal, sliceHorizontal', sliceHorizontal'', sliceHorizontal''' :: Int -> [a] -> [[a]] sliceHorizontal n = map (sieve n) . take n . iterate (drop 1) -- | prop> \(NonNegative n) xs -> sliceHorizontal n xs == sliceHorizontal' n (xs::String) sliceHorizontal' n = foldr (\x ys -> let y = last ys in Match.take ys ((x:y):ys)) (replicate n []) -- | prop> \(Positive n) xs -> sliceHorizontal n xs == sliceHorizontal'' n (xs::String) sliceHorizontal'' n = reverse . foldr (\x ~(y:ys) -> ys ++ [x:y]) (replicate n []) sliceHorizontal''' n = take n . transpose . takeWhile (not . null) . iterate (drop n) {- | >>> sliceVertical 6 ['a'..'z'] ["abcdef","ghijkl","mnopqr","stuvwx","yz"] -} sliceVertical, sliceVertical' :: Int -> [a] -> [[a]] sliceVertical n = map (take n) . takeWhile (not . null) . iterate (drop n) {- takeWhile must be performed before (map take) in order to handle (n==0) correctly -} -- | prop> \(NonNegative n) xs -> equating (take 100000) (sliceVertical n xs) (sliceVertical' n (xs::String)) sliceVertical' n = unfoldr (\x -> toMaybe (not (null x)) (splitAt n x)) -- * Search&replace search :: (Eq a) => [a] -> [a] -> [Int] search sub str = findIndices (isPrefixOf sub) (tails str) {- | prop> \(NonEmpty xs) ys -> replace xs xs ys == (ys::String) prop> \(NonEmpty xs) (NonEmpty ys) -> equating (take 1000) (replace xs ys (cycle xs)) (cycle (ys::String)) -} replace :: Eq a => [a] -> [a] -> [a] -> [a] replace src dst = let recourse [] = [] recourse str@(s:ss) = fromMaybe (s : recourse ss) (fmap ((dst++) . recourse) $ maybePrefixOf src str) in recourse markSublists :: (Eq a) => [a] -> [a] -> [Maybe [a]] markSublists sub ys = let ~(hd', rest') = foldr (\c ~(hd, rest) -> let xs = c:hd in case maybePrefixOf sub xs of Just suffix -> ([], Nothing : Just suffix : rest) Nothing -> (xs, rest)) ([],[]) ys in Just hd' : rest' replace' :: (Eq a) => [a] -> [a] -> [a] -> [a] replace' src dst xs = concatMap (fromMaybe dst) (markSublists src xs) {- | This is slightly wrong, because it re-replaces things. That's also the reason for inefficiency: The replacing can go on only when subsequent replacements are finished. Thus this functiob fails on infinite lists. -} replace'' :: (Eq a) => [a] -> [a] -> [a] -> [a] replace'' src dst = foldr (\x xs -> let y=x:xs in if isPrefixOf src y then dst ++ drop (length src) y else y) [] {- | prop \src dst xs -> replace src dst xs == multiReplace [(src,dst)] (xs::String) -} multiReplace :: Eq a => [([a], [a])] -> [a] -> [a] multiReplace dict = let recourse [] = [] recourse str@(s:ss) = fromMaybe (s : recourse ss) (msum $ map (\(src,dst) -> fmap ((dst++) . recourse) $ maybePrefixOf src str) dict) in recourse multiReplace' :: Eq a => [([a], [a])] -> [a] -> [a] multiReplace' dict = let recourse [] = [] recourse str@(s:ss) = maybe (s : recourse ss) (\(src, dst) -> dst ++ recourse (Match.drop src str)) (find (flip isPrefixOf str . fst) dict) in recourse -- * Lists of lists {- | Transform > [[00,01,02,...], [[00], > [10,11,12,...], --> [10,01], > [20,21,22,...], [20,11,02], > ...] ...] With @concat . shear@ you can perform a Cantor diagonalization, that is an enumeration of all elements of the sub-lists where each element is reachable within a finite number of steps. It is also useful for polynomial multiplication (convolution). -} shear :: [[a]] -> [[a]] shear = map catMaybes . shearTranspose . transposeFill transposeFill :: [[a]] -> [[Maybe a]] transposeFill = unfoldr (\xs -> toMaybe (not (null xs)) (mapSnd (Rev.dropWhile null) $ unzipCons xs)) unzipCons :: [[a]] -> ([Maybe a], [[a]]) unzipCons = unzip . map ((\my -> (fmap fst my, maybe [] snd my)) . viewL) {- | It's somehow inverse to zipCons, but the difficult part is, that a trailing empty list on the right side is suppressed. -} unzipConsSkew :: [[a]] -> ([Maybe a], [[a]]) unzipConsSkew = let aux [] [] = ([],[]) -- one empty list at the end will be removed aux xs ys = mapSnd (xs:) $ prep ys prep = forcePair . switchL ([],[]) (\y ys -> let my = viewL y in mapFst (fmap fst my :) $ aux (maybe [] snd my) ys) in prep shear' :: [[a]] -> [[a]] shear' xs@(_:_) = let (y:ys,zs) = unzip (map (splitAt 1) xs) zipConc (a:as) (b:bs) = (a++b) : zipConc as bs zipConc [] bs = bs zipConc as [] = as in y : zipConc ys (shear' (Rev.dropWhile null zs)) {- Dropping trailing empty lists is necessary, otherwise finite lists are filled with empty lists. -} shear' [] = [] {- | Transform > [[00,01,02,...], [[00], > [10,11,12,...], --> [01,10], > [20,21,22,...], [02,11,20], > ...] ...] It's like 'shear' but the order of elements in the sub list is reversed. Its implementation seems to be more efficient than that of 'shear'. If the order does not matter, better choose 'shearTranspose'. prop> \xs -> shearTranspose xs == map reverse (shear (xs::[String])) -} shearTranspose :: [[a]] -> [[a]] shearTranspose = foldr zipConsSkew [] zipConsSkew :: [a] -> [[a]] -> [[a]] zipConsSkew xt yss = uncurry (:) $ case xt of x:xs -> ([x], zipCons xs yss) [] -> ([], yss) {- | zipCons is like @zipWith (:)@ but it keeps lists which are too long This version works also for @zipCons something undefined@. -} zipCons :: [a] -> [[a]] -> [[a]] zipCons (x:xs) yt = let (y,ys) = switchL ([],[]) (,) yt in (x:y) : zipCons xs ys zipCons [] ys = ys -- | zipCons' is like @zipWith (:)@ but it keeps lists which are too long zipCons' :: [a] -> [[a]] -> [[a]] zipCons' (x:xs) (y:ys) = (x:y) : zipCons' xs ys zipCons' [] ys = ys zipCons' xs [] = map (:[]) xs {- | Operate on each combination of elements of the first and the second list. In contrast to the list instance of 'Monad.liftM2' it holds the results in a list of lists. prop> \xs ys -> let f x y = (x::Char,y::Int) in concat (outerProduct f xs ys) == liftM2 f xs ys -} outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]] outerProduct f xs ys = map (flip map ys . f) xs -- * Miscellaneous {- | Take while first predicate holds, then continue taking while second predicate holds, and so on. -} takeWhileMulti :: [a -> Bool] -> [a] -> [a] takeWhileMulti [] _ = [] takeWhileMulti _ [] = [] takeWhileMulti aps@(p:ps) axs@(x:xs) = if p x then x : takeWhileMulti aps xs else takeWhileMulti ps axs {- | prop> \ys xs -> let ps = map (<=) ys in takeWhileMulti ps xs == takeWhileMulti' ps (xs::String) -} takeWhileMulti' :: [a -> Bool] -> [a] -> [a] takeWhileMulti' ps xs = concatMap fst (tail (scanl (flip span . snd) (undefined,xs) ps)) {- Debug.QuickCheck.quickCheck (propTakeWhileMulti [(<0), (>0), odd, even, ((0::Int)==)]) -} {- | This is a combination of 'foldl'' and 'foldr' in the sense of 'propFoldl'r'. It is however more efficient because it avoids storing the whole input list as a result of sharing. -} foldl'r, foldl'rStrict, foldl'rNaive :: (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> (b,d) foldl'r f b0 g d0 = -- (\(k,d1) -> (k b0, d1)) . mapFst ($ b0) . foldr (\(a,c) ~(k,d) -> (\b -> k $! f b a, g c d)) (id,d0) foldl'rStrict f b0 g d0 = mapFst ($ b0) . foldr (\(a,c) ~(k,d) -> ((,) $! (\b -> k $! f b a)) $! g c d) (id,d0) foldl'rNaive f b g d xs = mapPair (foldl' f b, foldr g d) $ unzip xs propFoldl'r :: (Eq b, Eq d) => (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> Bool propFoldl'r f b g d xs = foldl'r f b g d xs == foldl'rNaive f b g d xs {- The results in GHCi surprise: *List.HT> mapSnd last $ foldl'rNaive (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a') (1000000,'a') (0.44 secs, 141032856 bytes) *List.HT> mapSnd last $ foldl'r (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a') (1000000,'a') (2.64 secs, 237424948 bytes) -} {- Debug.QuickCheck.quickCheck (\b d -> propFoldl'r (+) (b::Int) (++) (d::[Int])) -} {- | >>> lengthAtLeast 0 "" True >>> lengthAtLeast 3 "ab" False >>> lengthAtLeast 3 "abc" True >>> lengthAtLeast 3 $ repeat 'a' True >>> lengthAtLeast 3 $ "abc" ++ undefined True prop> \n xs -> lengthAtLeast n (xs::String) == (length xs >= n) -} lengthAtLeast :: Int -> [a] -> Bool lengthAtLeast n = if n<=0 then const True else not . null . drop (n-1) {- | >>> lengthAtMost 0 "" True >>> lengthAtMost 3 "ab" True >>> lengthAtMost 3 "abc" True >>> lengthAtMost 3 "abcd" False >>> lengthAtMost 3 $ repeat 'a' False >>> lengthAtMost 3 $ "abcd" ++ undefined False prop> \n xs -> lengthAtMost n (xs::String) == (length xs <= n) -} lengthAtMost :: Int -> [a] -> Bool lengthAtMost n = if n<0 then const False else null . drop n {- | prop> \n xs -> lengthAtMost0 n (xs::String) == (length xs <= n) -} lengthAtMost0 :: Int -> [a] -> Bool lengthAtMost0 n = (n>=) . length . take (n+1) {- Iterate until elements start to cycle. This implementation is inspired by Elements of Programming but I am still not satisfied where the iteration actually stops. -} iterateUntilCycle :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycle f a = let as = iterate f a in (a:) $ map fst $ takeWhile (uncurry (/=)) $ zip (tail as) (concatMap (\ai->[ai,ai]) as) {- iterateUntilCycleQ :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycleQ f a = let as = tail $ iterate f a in (a:) $ map fst $ takeWhile (uncurry (/=)) $ zip as (downsample2 (tail as)) -} iterateUntilCycleP :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycleP f a = let as = iterate f a in map fst $ takeWhile (\(a1,(a20,a21)) -> a1/=a20 && a1/=a21) $ zip as (pairs (tail as)) pairs :: [t] -> [(t, t)] pairs [] = [] pairs (_:[]) = error "pairs: odd number of elements" pairs (x0:x1:xs) = (x0,x1) : pairs xs {- | rotate left -} rotate, rotate', rotate'' :: Int -> [a] -> [a] rotate n x = Match.take x (drop (mod n (length x)) (cycle x)) {- | more efficient implementation of rotate' prop> \n (NonEmpty xs) -> rotate n xs == rotate' n (xs::String) -} rotate' n x = uncurry (flip (++)) (splitAt (mod n (length x)) x) {- | prop> \(NonNegative n) xs -> rotate n xs == rotate'' n (xs::String) -} rotate'' n x = Match.take x (drop n (cycle x)) {- | Given two lists that are ordered (i.e. @p x y@ holds for subsequent @x@ and @y@) 'mergeBy' them into a list that is ordered, again. >>> mergeBy (<=) "agh" "begz" "abegghz" -} mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] mergeBy = Key.mergeBy {- | >>> allEqual "aab" False >>> allEqual "aaa" True >>> allEqual "aa" True >>> allEqual "a" True >>> allEqual "" True -} allEqual :: Eq a => [a] -> Bool allEqual = and . mapAdjacent (==) {- | >>> isAscending "abc" True >>> isAscending "abb" True >>> isAscending "aba" False >>> isAscending "cba" False >>> isAscending "a" True >>> isAscending "" True -} isAscending :: (Ord a) => [a] -> Bool isAscending = and . isAscendingLazy isAscendingLazy :: (Ord a) => [a] -> [Bool] isAscendingLazy = mapAdjacent (<=) {- | This function combines every pair of neighbour elements in a list with a certain function. >>> mapAdjacent (<=) "" [] >>> mapAdjacent (<=) "a" [] >>> mapAdjacent (<=) "aba" [True,False] >>> mapAdjacent (,) "abc" [('a','b'),('b','c')] prop> \x xs -> mapAdjacent subtract (scanl (+) x xs) == (xs::[Integer]) -} mapAdjacent :: (a -> a -> b) -> [a] -> [b] mapAdjacent f xs = zipWith f xs (tail xs) {- | prop> \xs -> mapAdjacent (,) xs == mapAdjacentPointfree (,) (xs::String) -} mapAdjacentPointfree :: (a -> a -> b) -> [a] -> [b] mapAdjacentPointfree f = zipWith f <*> tail {- | >>> let f x y z = [x,y]++show(z::Int) in mapAdjacent1 f 'a' [('b',1), ('c',2), ('d',3)] ["ab1","bc2","cd3"] -} mapAdjacent1 :: (a -> a -> b -> c) -> a -> [(a,b)] -> [c] mapAdjacent1 f a xs = zipWith (\a0 (a1,b) -> f a0 a1 b) (a : map fst xs) xs {- | >>> equalWith (<=) "ab" "bb" True >>> equalWith (<=) "aa" "bbb" False >>> equalWith (==) "aa" "aaa" False prop> \as bs -> let f a b = abs (a-b) <= (10::Int) in equalWith f as bs == equalWithRec f as bs prop> \as bs -> let f a b = abs (a-b) <= (10::Int) in equalWith f as bs == equalWithLiftM f as bs -} equalWith, equalWithLiftM, equalWithRec :: (a -> b -> Bool) -> [a] -> [b] -> Bool equalWith f as bs = and $ zipWith (\ma mb -> case (ma,mb) of (Just a, Just b) -> f a b (Nothing, Nothing) -> True _ -> False) (map Just as ++ [Nothing]) (map Just bs ++ [Nothing]) equalWithLiftM f as bs = all (Just True ==) $ zipWith (\ma mb -> case (ma,mb) of (Nothing, Nothing) -> Just True _ -> liftM2 f ma mb) (map Just as ++ [Nothing]) (map Just bs ++ [Nothing]) equalWithRec f = let go (a:as) (b:bs) = f a b && go as bs go [] [] = True go _ _ = False in go {- | Enumerate without Enum context. For Enum equivalent to enumFrom. >>> range 0 :: [Integer] [] >>> range 1 :: [Integer] [0] >>> range 8 :: [Integer] [0,1,2,3,4,5,6,7] prop> \(NonNegative n) -> length (range n :: [Integer]) == n -} range :: Num a => Int -> [a] range n = take n (iterate (+1) 0) {-# INLINE padLeft #-} padLeft :: a -> Int -> [a] -> [a] padLeft c n xs = replicate (n - length xs) c ++ xs {-# INLINE padRight #-} padRight, padRight1 :: a -> Int -> [a] -> [a] padRight c n xs = take n $ xs ++ repeat c padRight1 c n xs = xs ++ replicate (n - length xs) c {- | For an associative operation @op@ this computes @iterateAssociative op a = iterate (op a) a@ but it is even faster than @map (powerAssociative op a a) [0..]@ since it shares temporary results. The idea is: From the list @map (powerAssociative op a a) [0,(2*n)..]@ we compute the list @map (powerAssociative op a a) [0,n..]@, and iterate that until @n==1@. prop> \x -> equating (take 1000) (List.iterate (x+) x) (iterateAssociative (+) (x::Integer)) -} iterateAssociative :: (a -> a -> a) -> a -> [a] iterateAssociative op a = foldr (\pow xs -> pow : concatMap (\x -> [x, op x pow]) xs) undefined (iterate (\x -> op x x) a) {- | This is equal to 'iterateAssociative'. The idea is the following: The list we search is the fixpoint of the function: "Square all elements of the list, then spread it and fill the holes with successive numbers of their left neighbour." This also preserves log n applications per value. However it has a space leak, because for the value with index @n@ all elements starting at @div n 2@ must be kept. prop> \x -> equating (take 1000) (List.iterate (x+) x) (iterateLeaky (+) (x::Integer)) -} iterateLeaky :: (a -> a -> a) -> a -> [a] iterateLeaky op x = let merge (a:as) b = a : merge b as merge _ _ = error "iterateLeaky: an empty list cannot occur" sqrs = map (\y -> op y y) z z = x : merge sqrs (map (op x) sqrs) in z utility-ht-0.0.17.2/src/Data/List/Reverse/0000755000175000001440000000000014642227107021055 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/List/Reverse/Private.hs0000644000175000001440000000242314642227107023024 0ustar00thielemausers00000000000000module Data.List.Reverse.Private where import qualified Data.List.Key.Private as Key import Data.List.HT (segmentAfter, viewR, groupBy) import Prelude hiding (dropWhile, takeWhile) -- $setup -- >>> import Test.Utility (forAllPredicates) -- >>> import qualified Data.List.Reverse.StrictElement as Rev -- >>> import Prelude hiding (dropWhile, takeWhile) {- | prop> forAllPredicates $ \p xs -> dropWhile p xs == Rev.dropWhile p xs -} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p = concat . init . segmentAfter (not . p) {- | prop> forAllPredicates $ \p xs -> takeWhile0 p xs == Rev.takeWhile p xs -} takeWhile0 :: (a -> Bool) -> [a] -> [a] takeWhile0 p = last . segmentAfter (not . p) {- | Doesn't seem to be superior to the naive implementation. prop> forAllPredicates $ \p xs -> takeWhile1 p xs == Rev.takeWhile p xs -} takeWhile1 :: (a -> Bool) -> [a] -> [a] takeWhile1 p = (\mx -> case mx of Just (_, xs@((True,_):_)) -> map snd xs _ -> []) . viewR . Key.aux groupBy (==) p {- | However it is more inefficient, because of repeatedly appending single elements. :-( prop> forAllPredicates $ \p xs -> takeWhile2 p xs == Rev.takeWhile p xs -} takeWhile2 :: (a -> Bool) -> [a] -> [a] takeWhile2 p = foldl (\xs x -> if p x then xs++[x] else []) [] utility-ht-0.0.17.2/src/Data/List/Reverse/StrictSpine.hs0000644000175000001440000000377714642227107023676 0ustar00thielemausers00000000000000{- | The functions in this module process the list from the end. They do not access elements at the beginning if not necessary. You can apply the function only to finite lists. Use these functions if the list is short and the test is expensive. -} module Data.List.Reverse.StrictSpine where import Data.Tuple.HT (mapFst, mapSnd, forcePair, ) import Prelude hiding (dropWhile, takeWhile, span, ) -- $setup -- >>> import Test.Utility (forAllPredicates, defined) -- >>> import qualified Data.List.Reverse.StrictSpine as Rev -- >>> import qualified Data.List.Match as Match -- >>> import qualified Data.List as List -- >>> import Data.Tuple.HT (mapFst, mapPair, swap) -- >>> -- >>> _suppressUnusedImportWarning :: (a -> Bool) -> [a] -> [a] -- >>> _suppressUnusedImportWarning = Data.List.Reverse.StrictSpine.dropWhile {- | prop> forAllPredicates $ \p xs -> Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) prop> \x xs pad -> defined $ length $ Rev.dropWhile ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs -} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p = foldr (\x xs -> if null xs && p x then [] else x:xs) [] {- | prop> forAllPredicates $ \p xs -> Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) prop> \x xs pad -> defined $ Rev.takeWhile ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs -} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p = snd . foldr (\x xys -> (if fst xys && p x then mapSnd (x:) else mapFst (const False)) xys) (True, []) {- | prop> forAllPredicates $ \p xs -> Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) prop> forAllPredicates $ \p xs -> Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) prop> \x xs pad -> defined $ mapFst length $ Rev.span ((x::Char)/=) $ Match.replicate (pad::[()]) undefined ++ x:xs -} span :: (a -> Bool) -> [a] -> ([a], [a]) span p = forcePair . foldr (\x xys -> (if null (fst xys) && p x then mapSnd else mapFst) (x:) xys) ([], []) utility-ht-0.0.17.2/src/Data/List/Reverse/StrictElement.hs0000644000175000001440000000420214642227107024171 0ustar00thielemausers00000000000000{- | The functions in this module process the list formally from the end. Actually they traverse the list from the start and check every element. This way they are strict in the elements and lazy in the list spline. Thus you can apply them to infinite lists. Use these functions if the list is long or the test is cheap. -} module Data.List.Reverse.StrictElement where import Data.Tuple.HT (mapFst, mapSnd, forcePair, ) import Prelude hiding (dropWhile, takeWhile, span, ) -- $setup -- >>> import Test.Utility (forAllPredicates, defined) -- >>> import qualified Data.List.Reverse.StrictElement as Rev -- >>> import qualified Data.List.Match as Match -- >>> import qualified Data.List as List -- >>> import Data.Tuple.HT (mapPair, swap) -- >>> -- >>> _suppressUnusedImportWarning :: (a -> Bool) -> [a] -> [a] -- >>> _suppressUnusedImportWarning = Data.List.Reverse.StrictElement.dropWhile {- | Remove the longest suffix of elements satisfying p. In contrast to @reverse . dropWhile p . reverse@ this works for infinite lists, too. prop> forAllPredicates $ \p xs -> Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) prop> \x xs pad -> defined $ Match.take (pad::[()]) $ Rev.dropWhile ((x::Char)/=) $ cycle $ x:xs -} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p = foldr (\x xs -> if p x && null xs then [] else x:xs) [] {- | Alternative version of @reverse . takeWhile p . reverse@. prop> forAllPredicates $ \p xs -> Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) -} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p = snd . foldr (\x xys -> (if p x && fst xys then mapSnd (x:) else mapFst (const False)) xys) (True, []) {- | prop> forAllPredicates $ \p xs -> Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) prop> forAllPredicates $ \p xs -> Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) prop> \x xs pad -> defined $ Match.take (pad::[()]) $ fst $ Rev.span ((x::Char)/=) $ cycle $ x:xs -} span :: (a -> Bool) -> [a] -> ([a], [a]) span p = forcePair . foldr (\x xys -> (if p x && null (fst xys) then mapSnd else mapFst) (x:) xys) ([], []) utility-ht-0.0.17.2/src/Data/Ix/0000755000175000001440000000000014642227107017107 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Ix/Enum.hs0000644000175000001440000000315114642227107020347 0ustar00thielemausers00000000000000{- | Implementations of 'Ix' methods in terms of 'Enum' methods. For a type @T@ of class 'Enum' you can easily define an 'Ix' instance by copying the following code into your module: >import qualified Data.Ix.Enum as IxEnum > >instance Ix T where > range = IxEnum.range > index = IxEnum.index > inRange = IxEnum.inRange > rangeSize = IxEnum.rangeSize > unsafeIndex = IxEnum.unsafeIndex > unsafeRangeSize = IxEnum.unsafeRangeSize -} module Data.Ix.Enum where import qualified Data.Ix as Ix import qualified GHC.Arr as Arr {-# INLINE range #-} {-# INLINE index #-} {-# INLINE unsafeIndex #-} {-# INLINE inRange #-} {-# INLINE rangeSize #-} {-# INLINE unsafeRangeSize #-} {- | >>> range ('x','z') "xyz" >>> range (LT,GT) [LT,EQ,GT] -} range :: Enum a => (a, a) -> [a] {- | >>> index ('a','z') 'e' 4 -} index :: Enum a => (a, a) -> a -> Int {- | >>> unsafeIndex ('a','z') 'e' 4 -} unsafeIndex :: Enum a => (a, a) -> a -> Int {- | >>> inRange ('a','z') 'e' True >>> inRange ('x','z') 'a' False -} inRange :: Enum a => (a, a) -> a -> Bool {- | >>> rangeSize ('x','z') 3 -} rangeSize :: Enum a => (a, a) -> Int {- | >>> unsafeRangeSize ('x','z') 3 -} unsafeRangeSize :: Enum a => (a, a) -> Int range (l,r) = map toEnum $ Ix.range (fromEnum l, fromEnum r) index (l,r) i = Ix.index (fromEnum l, fromEnum r) (fromEnum i) unsafeIndex (l,r) i = Arr.unsafeIndex (fromEnum l, fromEnum r) (fromEnum i) inRange (l,r) i = Ix.inRange (fromEnum l, fromEnum r) (fromEnum i) rangeSize (l,r) = Ix.rangeSize (fromEnum l, fromEnum r) unsafeRangeSize (l,r) = Arr.unsafeRangeSize (fromEnum l, fromEnum r) utility-ht-0.0.17.2/src/Data/Function/0000755000175000001440000000000014642227107020314 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Function/HT.hs0000644000175000001440000000063514642227107021167 0ustar00thielemausers00000000000000module Data.Function.HT ( Id, nest, powerAssociative, compose2, ) where import Data.Function.HT.Private (nest, powerAssociative, ) {- | Useful for adding type annotations like in > f . (id :: Id Char) . g -} type Id a = a -> a {- | Known as @on@ in newer versions of the @base@ package. -} {-# INLINE compose2 #-} compose2 :: (b -> b -> c) -> (a -> b) -> (a -> a -> c) compose2 g f x y = g (f x) (f y) utility-ht-0.0.17.2/src/Data/Function/HT/0000755000175000001440000000000014642227107020627 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Function/HT/Private.hs0000644000175000001440000000404614642227107022601 0ustar00thielemausers00000000000000module Data.Function.HT.Private where import Data.List (genericReplicate, unfoldr) import Data.Maybe.HT (toMaybe) import Data.Tuple.HT (swap) -- $setup -- >>> import Test.QuickCheck (NonNegative(NonNegative)) {- | Compositional power of a function, i.e. apply the function @n@ times to a value. It is rather the same as @iter@ in Simon Thompson: \"The Craft of Functional Programming\", page 172 -} {-# INLINE nest #-} nest :: Int -> (a -> a) -> a -> a nest 0 _ x = x nest n f x = f (nest (n-1) f x) {- | prop> \(NonNegative n) x -> nest n succ x == nest1 n succ (x::Integer) prop> \(NonNegative n) x -> nest n succ x == nest2 n succ (x::Integer) -} nest1, nest2 :: Int -> (a -> a) -> a -> a nest1 n f = foldr (.) id (replicate n f) nest2 n f x = iterate f x !! n {- | @powerAssociative@ is an auxiliary function that, for an associative operation @op@, computes the same value as @powerAssociative op a0 a n = foldr op a0 (genericReplicate n a)@ but applies "op" O(log n) times and works for large n. -} {-# INLINE powerAssociative #-} powerAssociative :: (a -> a -> a) -> a -> a -> Integer -> a powerAssociative op = let go acc _ 0 = acc go acc a n = go (if even n then acc else op acc a) (op a a) (div n 2) in go {- | prop> \a0 a (NonNegative n) -> powerAssociative (+) a0 a n == (powerAssociativeList (+) a0 a n :: Integer) prop> \a0 a (NonNegative n) -> powerAssociative (+) a0 a n == (powerAssociativeNaive (+) a0 a n :: Integer) -} powerAssociativeList, powerAssociativeNaive :: (a -> a -> a) -> a -> a -> Integer -> a powerAssociativeList op a0 a n = foldl (\acc (bit,pow) -> if bit==0 then acc else op acc pow) a0 $ zip (unfoldr (\k -> toMaybe (k>0) $ swap $ divMod k 2) n) (iterate (\pow -> op pow pow) a) powerAssociativeNaive op a0 a n = foldr op a0 (genericReplicate n a) infixl 0 $% {- | Flipped version of '($)'. It was discussed as (&) in http://www.haskell.org/pipermail/libraries/2012-November/018832.html I am not sure, that we need it. It is not exported for now. -} ($%) :: a -> (a -> b) -> b ($%) = flip ($) utility-ht-0.0.17.2/src/Data/Eq/0000755000175000001440000000000014642227107017074 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Eq/HT.hs0000644000175000001440000000023714642227107017745 0ustar00thielemausers00000000000000module Data.Eq.HT where import Data.Function.HT (compose2, ) {-# INLINE equating #-} equating :: Eq b => (a -> b) -> a -> a -> Bool equating = compose2 (==) utility-ht-0.0.17.2/src/Data/Bool/0000755000175000001440000000000014642227107017422 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Bool/HT.hs0000644000175000001440000000021614642227107020270 0ustar00thielemausers00000000000000module Data.Bool.HT ( B.if', B.ifThenElse, B.select, (B.?:), B.implies, ) where import qualified Data.Bool.HT.Private as B utility-ht-0.0.17.2/src/Data/Bool/HT/0000755000175000001440000000000014642227107017735 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Bool/HT/Private.hs0000644000175000001440000000263114642227107021705 0ustar00thielemausers00000000000000module Data.Bool.HT.Private where import Data.List as List (find, ) import Data.Maybe as Maybe (fromMaybe, ) {- | @if-then-else@ as function. Example: > if' (even n) "even" $ > if' (isPrime n) "prime" $ > "boring" -} {-# INLINE if' #-} if' :: Bool -> a -> a -> a if' True x _ = x if' False _ y = y {-| The same as 'if'', but the name is chosen such that it can be used for GHC-7.0's rebindable if-then-else syntax. -} {-# INLINE ifThenElse #-} ifThenElse :: Bool -> a -> a -> a ifThenElse = if' {-| From a list of expressions choose the one, whose condition is true. Example: > select "boring" $ > (even n, "even") : > (isPrime n, "prime") : > [] -} {-# INLINE select #-} select, select0, select1 :: a -> [(Bool, a)] -> a select def = maybe def snd . find fst select0 def = fromMaybe def . lookup True select1 = foldr (uncurry if') zipIf :: [Bool] -> [a] -> [a] -> [a] zipIf = zipWith3 if' infixr 1 ?: {- | Like the @?@ operator of the C progamming language. >>> True ?: ("yes", "no") "yes" >>> False ?: ("yes", "no") "no" -} {-# INLINE (?:) #-} (?:) :: Bool -> (a,a) -> a (?:) = uncurry . if' -- precedence below (||) and (&&) infixr 1 `implies` {- | Logical operator for implication. Funnily because of the ordering of 'Bool' it holds: prop> \a b -> implies a b == (a<=b) -} {-# INLINE implies #-} implies :: Bool -> Bool -> Bool implies prerequisite conclusion = not prerequisite || conclusion utility-ht-0.0.17.2/src/Data/Bits/0000755000175000001440000000000014642227107017430 5ustar00thielemausers00000000000000utility-ht-0.0.17.2/src/Data/Bits/HT.hs0000644000175000001440000000061314642227107020277 0ustar00thielemausers00000000000000module Data.Bits.HT where import Data.Bits (Bits, shiftL, shiftR) infixl 7 .<<., .>>. {- | Infix variant of 'shiftL'. Precedence is chosen like multiplication since @a .<<. k == a * 2^k@. -} (.<<.) :: Bits a => a -> Int -> a (.<<.) = shiftL {- | Infix variant of 'shiftR'. Precedence is chosen like division since @a .>>. k == a / 2^k@. -} (.>>.) :: Bits a => a -> Int -> a (.>>.) = shiftR