diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,19 @@ +# **ToolShed**. + +This is **ToolShed**, a library of unconnected utilities. + +## Installation + +It can be built and installed using [Cabal](https://www.haskell.org/cabal/users-guide/installing-packages.html). + +## License + +For information on copying and distributing this package, see the file **LICENSE** in this directory. + +## Bug-reporting + +Bug-reports should be emailed to . + +## Author + +This library is written and maintained by Dr. Alistair Ward. diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,81 +0,0 @@ -2010-11-18 Dr. Alistair Ward - -0.9.0.0 - * First version of the package. -0.10.0.0 - * Created "src/ToolShed/" sub-directory & then modified module-names accordingly. - * Removed the module "Pair", & relocated its only function to the sole caller in the package "Bridge". - * Added a makefile. - * Qualified identifiers used in error-messages. -0.10.0.1 - * Tested with ghc-7.0.1, & conditionally replaced use of the package 'parallel' with 'deepseq', in the module "TimePure". -0.10.1.0 - * Added 'ToolShed.Arithmetic.nCr', "ToolShed.Options" & "ToolShed.Package". -0.10.2.0 - * Renamed package from 'ToolShed' to 'toolshed', for compatibility with Debian's ".deb"-format. -0.11.0.0 - * Added manually controlled "llvm" flag to "toolshed.cabal". - * Removed the module "ToolShed.Package", for which 'Distribution.Package.PackageIdentifier' is a suitable alternative. - * Added 'NOINLINE' pragma to each function in module "Unsafe". - * Relocated 'mean' & 'nCr' from "ToolShed.Arithmetic", to the package "factory". - * Added function 'ListPlus.groupComparing'. - * Changed identifier for type-parameters, to better reflect its role. - * Relocated the remaining rather pointless functions from the module "ToolShed.Arithmetic" & deleted it. - * Added module "ToolShed.Defaultable", & derived class 'ToolShed.Options.Options' from it. -0.11.1.0 - * Added functions 'merge' & 'mergeBy' to module "ToolShed.ListPlus" & exported a new type-synonym 'ToolShed.ListPlus.ChunkLength'. - * Uploaded to . -0.12.0.0 - * Added modules "ToolShed.TimeAction" to measure the CPU-seconds required for an IO-action, & "Pair". -0.12.0.1 - * Removed unnecessary type-context 'Ord' from 'ToolShed.ListPus.mergeBy' & reimplemented 'ToolShed.ListPus.merge' in terms of 'ToolShed.ListPus.mergeBy'. - * Added 'ToolShed.ListPlus.runLengthEncode' & 'ToolShed.ListPlus.runLengthDecode'. -0.13.0.0 - * Removed module "ToolShed.Unsafe". - * Renamed: - "ToolShed.ListPlus" to "ToolShed.Data.List" - "ToolShed.Pair" to "ToolShed.Data.Pair" - "ToolShed.TimeAction" to "ToolShed.System.TimeAction" - "ToolShed.TimePure" to "ToolShed.System.TimePure" - * Migrated 'ToolShed.Data.List.RunLengthCode' & associated functions, into a new module "ToolShed.Data.List.Runlength". - * Migrated 'ToolShed.Data.List.Splits' & associated functions, into a new module "ToolShed.Data.List.Splits". - * Replaced function 'ToolShed.Data.List.groupComparing' with the more useful 'ToolShed.Data.List.equalityBy', which can be used with either 'Data.List.groupBy' or 'Data.List.nubBy'. - * Added instances of 'ToolShed.SelfValidate.SelfValidator' for 'Data.Maybe.Maybe' '(,)', 'Data.Set.Set', 'Data.Map.Map' & 'Data.Array.IArray.Array'. - * Added instance of 'ToolShed.Defaultable.Defaultable' for '(,)'. - * Added functions 'ToolShed.Data.List.showListWith', 'ToolShed.Data.List.permutations', 'ToolShed.Data.List.gatherBy', 'ToolShed.Data.List.findConvergenceBy', 'ToolShed.Data.List.findConvergence', 'ToolShed.Data.List.gather'. - * Added modules "ToolShed.System.File" & "ToolShed.System.Random". - * Added method 'ToolShed.SelfValidate.getErrors', & supporting functions 'ToolShed.SelfValidate.getFirstErrors' & 'ToolShed.SelfValidate.extractErrors'. - * Create module "ToolShed.Arbitrary.*". - * Added "Main", "ToolShed.Test.QuickChecks" & "ToolShed.Test.Data.List" to facilitate testing. - * Removed 'ToolShed.Data.Pair.both'. - * Replaced "System" with "System.Environment" & "System.Exit". - * Removed dependency on "haskell98". -0.14.0.0 - * Defined package's name using program's name, in "Main.hs". - * Checked package "Base" exports 'Data.Tuple.swap', in "ToolShed.Arbitrary.Array". - * Relocated "ToolShed.Arbitrary" to "ToolShed.Test.QuickCheck.Arbitrary". - * Added "ToolShed.Test.ReversibleBoundedEnum", "ToolShed.Test.ReversibleEnum", "ToolShed.Test.ReversibleIO", & "ToolShed.Test.SelfValidate". - * Amended 'ToolShed.System.File.locate' to deal with absolute file-paths. - * Replaced legacy calls to 'Data.Map.fold' & 'Data.Set.fold', with more expicit calls to 'Data.Map.foldr' & 'Data.Set.foldr' from a more recent version of the "containers" package. - * Added instance of 'ToolShed.SelfValidate.SelfValidator' for '(,,)'. - * Trapped null list in 'ToolShed.System.Random.select'. - * Added functions "ToolShed.Data.List.nub'" & 'ToolShed.Data.List.hasDuplicates'. - * Migrated functions 'gather', 'gatherBy', 'hasDuplicates' which merely operate on 'Data.Foldable.Foldable' types from module "ToolShed.Data.List", into new module "ToolShed.Data.Foldable". -0.15.0.0 - * Refactored 'ToolShed.Test.QuickChecks'. - * Added type 'ToolShed.Data.List.Matches' & function 'ToolShed.Data.List.permutationsBy'. - * Trapped the case of a null list supplied to 'ToolShed.Data.List.permutationsBy'. - * Re-implemented 'ToolShed.System.Random.shuffle', using the Fisher-Yates algorithm; which also improved the efficiency. - * Trapped special cases in 'ToolShed.System.Random.generateSelection'. - * Added modules "ToolShed.Test.System.Random", "ToolShed.Data.Triple", "ToolShed.Data.Quadruple", "ToolShed.Test.Data.Triple", & "ToolShed.Test.Data.Quadruple". - * Explicitly closed standard-input in the executable. - * Replaced calls to 'error' from inside the IO-monad, with 'Control.Monad.fail'. - * Added an instance for '(,,)', to "ToolShed.Defaultable.Defaultable". - * Corrected version-string in "Main" used in '--version' option. - * Corrected the output of 'Main.main.optDescrList.printVersion'. -0.15.0.1 - * Tested with 'haskell-platform-2013.2.0.0'. - * Replaced preprocessor-directives with 'build-depends' constraints in 'toolshed.cabal'. - * In module "ToolShed.System.File", replaced 'Control.Exception.throw' with 'Control.Exception.throwIO'. - * Replaced all instances of '(<$>)' with 'fmap' to avoid ambiguity between "Control.Applicative" & "Prelude" which (from 'base-4.8') also exports this symbol. - diff --git a/changelog.markdown b/changelog.markdown new file mode 100644 --- /dev/null +++ b/changelog.markdown @@ -0,0 +1,91 @@ +# 2010-11-18 Dr. Alistair Ward + +## 0.9.0.0 + * First version of the package. +## 0.10.0.0 + * Created **src/ToolShed/** sub-directory & then modified module-names accordingly. + * Removed the module **Pair**, & relocated its only function to the sole caller in the package **Bridge**. + * Added a makefile. + * Qualified identifiers used in error-messages. +## 0.10.0.1 + * Tested with ghc-7.0.1, & conditionally replaced use of the package **parallel** with **deepseq**, in the module **TimePure**. +## 0.10.1.0 + * Added `ToolShed.Arithmetic.nCr`, **ToolShed.Options** & **ToolShed.Package**. +## 0.10.2.0 + * Renamed package from **ToolShed** to **toolshed**, for compatibility with Debian's *.deb*-format. +## 0.11.0.0 + * Added manually controlled **llvm** flag to the *.cabal*-file. + * Removed the module **ToolShed.Package**, for which **Distribution.Package.PackageIdentifier** is a suitable alternative. + * Added **NOINLINE** pragma to each function in module **Unsafe**. + * Relocated `mean` & `nCr` from **ToolShed.Arithmetic**, to the package **factory**. + * Added function `ListPlus.groupComparing`. + * Changed identifier for type-parameters, to better reflect its role. + * Relocated the remaining rather pointless functions from the module **ToolShed.Arithmetic** & deleted it. + * Added module **ToolShed.Defaultable**, & derived class `ToolShed.Options.Options` from it. +## 0.11.1.0 + * Added functions `merge` & `mergeBy` to module **ToolShed.ListPlus** & exported a new type-synonym `ToolShed.ListPlus.ChunkLength`. + * Uploaded to [Hackage](http://hackage.haskell.org/packages/hackage.html). +## 0.12.0.0 + * Added modules **ToolShed.TimeAction** to measure the CPU-seconds required for an IO-action, & **Pair**. +## 0.12.0.1 + * Removed unnecessary type-context `Ord` from `ToolShed.ListPus.mergeBy` & reimplemented `ToolShed.ListPus.merge` in terms of `ToolShed.ListPus.mergeBy`. + * Added `ToolShed.ListPlus.runLengthEncode` & `ToolShed.ListPlus.runLengthDecode`. +## 0.13.0.0 + * Removed module **ToolShed.Unsafe**. + * Renamed: + **ToolShed.ListPlus** to **ToolShed.Data.List** + **ToolShed.Pair** to **ToolShed.Data.Pair** + **ToolShed.TimeAction** to **ToolShed.System.TimeAction** + **ToolShed.TimePure** to **ToolShed.System.TimePure** + * Migrated **ToolShed.Data.List.RunLengthCode** & associated functions, into a new module **ToolShed.Data.List.Runlength**. + * Migrated **ToolShed.Data.List.Splits** & associated functions, into a new module **ToolShed.Data.List.Splits**. + * Replaced function `ToolShed.Data.List.groupComparing` with the more useful `ToolShed.Data.List.equalityBy`, which can be used with either `Data.List.groupBy` or `Data.List.nubBy`. + * Added instances of `ToolShed.SelfValidate.SelfValidator` for `Data.Maybe.Maybe` `(,)`, `Data.Set.Set`, `Data.Map.Map` & `Data.Array.IArray.Array`. + * Added instance of `ToolShed.Defaultable.Defaultable` for `(,)`. + * Added functions `ToolShed.Data.List.showListWith`, `ToolShed.Data.List.permutations`, `ToolShed.Data.List.gatherBy`, `ToolShed.Data.List.findConvergenceBy`, `ToolShed.Data.List.findConvergence`, `ToolShed.Data.List.gather`. + * Added modules **ToolShed.System.File** & **ToolShed.System.Random**. + * Added method `ToolShed.SelfValidate.getErrors`, & supporting functions `ToolShed.SelfValidate.getFirstErrors` & `ToolShed.SelfValidate.extractErrors`. + * Create module **ToolShed.Arbitrary.* **. + * Added **Main**, **ToolShed.Test.QuickChecks** & **ToolShed.Test.Data.List** to facilitate testing. + * Removed `ToolShed.Data.Pair.both`. + ` Replaced `System` with `System.Environment` & `System.Exit`. + * Removed dependency on **haskell98**. +## 0.14.0.0 + * Defined package's name using program's name, in **Main.hs**. + * Checked package **Base** exports `Data.Tuple.swap`, in **ToolShed.Arbitrary.Array**. + * Relocated **ToolShed.Arbitrary** to **ToolShed.Test.QuickCheck.Arbitrary**. + * Added **ToolShed.Test.ReversibleBoundedEnum**, **ToolShed.Test.ReversibleEnum**, **ToolShed.Test.ReversibleIO**, & **ToolShed.Test.SelfValidate**. + * Amended `ToolShed.System.File.locate` to deal with absolute file-paths. + * Replaced legacy calls to `Data.Map.fold` & `Data.Set.fold`, with more expicit calls to `Data.Map.foldr` & `Data.Set.foldr` from a more recent version of the **containers** package. + * Added instance of `ToolShed.SelfValidate.SelfValidator` for `(,,)`. + * Trapped null list in `ToolShed.System.Random.select`. + * Added functions `ToolShed.Data.List.nub'` & 'ToolShed.Data.List.hasDuplicates'. + * Migrated functions `gather`, `gatherBy`, `hasDuplicates` which merely operate on `Data.Foldable.Foldable` types from module **ToolShed.Data.List**, into new module **ToolShed.Data.Foldable**. +## 0.15.0.0 + * Refactored **ToolShed.Test.QuickChecks**. + * Added type `ToolShed.Data.List.Matches` & function `ToolShed.Data.List.permutationsBy`. + * Trapped the case of a null list supplied to `ToolShed.Data.List.permutationsBy`. + * Re-implemented `ToolShed.System.Random.shuffle`, using the Fisher-Yates algorithm; which also improved the efficiency. + * Trapped special cases in `ToolShed.System.Random.generateSelection`. + * Added modules **ToolShed.Test.System.Random**, **ToolShed.Data.Triple**, **ToolShed.Data.Quadruple**, **ToolShed.Test.Data.Triple**, & **ToolShed.Test.Data.Quadruple**. + * Explicitly closed standard-input in the executable. + * Replaced calls to `error` from inside the IO-monad, with `Control.Monad.fail`. + * Added an instance for `(,,)`, to **ToolShed.Defaultable.Defaultable**. + * Corrected version-string in **Main** used in **--version** option. + * Corrected the output of `Main.main.optDescrList.printVersion`. +## 0.15.0.1 + * Tested with **haskell-platform-2013.2.0.0**. + * Replaced preprocessor-directives with **build-depends** constraints in the *.cabal*-file. + * In module **ToolShed.System.File**, replaced `Control.Exception.throw` with `Control.Exception.throwIO`. + * Replaced all instances of `(<$>)` with `fmap` to avoid ambiguity between **Control.Applicative** & **Prelude** which (from **base-4.8**) also exports this symbol. +## 0.16.0.0 + * Corrected the copyright dates in **Main**. + * Renamed module **ToolShed.Test.QuickCheck.Arbitrary.ArrayElem** to **ToolShed.Test.QuickCheck.Arbitrary.Array**, overwriting the module originally of that name which pointlessly defined an instance of `Test.QuickCheck.Arbitrary` for an array with an unbounded index. + * Added **Default-language**-specification to the *.cabal*-file. + * Added file **README.markdown**. + * Converted this file to markdown-format. + * Replaced `System.Exit.exitWith System.Exit.ExitSuccess` with `System.Exit.exitSuccess`. + * Added module **Test.QuickCheck.Result**. + * Moved the entry-point to the test-suite from **Main.hs** to **Test.hs** to integrate with **cabal**. + * Partitioned the source-files into **src-lib** & **src-test** directories, & referenced them individually from the *.cabal*-file to avoid repeated compilation. + diff --git a/makefile b/makefile deleted file mode 100644 --- a/makefile +++ /dev/null @@ -1,57 +0,0 @@ -# Copyright (C) 2010-2014 Dr. Alistair Ward -# -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -.PHONY: all build check clean configure copy haddock help hlint install prof sdist - -all: install - -install: build haddock - @[ -z "$$CABAL_INSTALL_OPTIONS" ] || echo "INFO: CABAL_INSTALL_OPTIONS='$$CABAL_INSTALL_OPTIONS'" - runhaskell Setup $@ $$CABAL_INSTALL_OPTIONS - -prof: - CABAL_CONFIGURE_OPTIONS="--enable-library-profiling $$CABAL_CONFIGURE_OPTIONS" make install - -copy: build - @[ -z "$$CABAL_COPY_OPTIONS" ] || echo "INFO: CABAL_COPY_OPTIONS='$$CABAL_COPY_OPTIONS'" - runhaskell Setup $@ $$CABAL_COPY_OPTIONS - -build: configure - @[ -z "$$CABAL_BUILD_OPTIONS" ] || echo "INFO: CABAL_BUILD_OPTIONS='$$CABAL_BUILD_OPTIONS'" - runhaskell Setup $@ $$CABAL_BUILD_OPTIONS - -configure: toolshed.cabal Setup.hs - @[ -z "$$CABAL_CONFIGURE_OPTIONS" ] || echo "INFO: CABAL_CONFIGURE_OPTIONS='$$CABAL_CONFIGURE_OPTIONS'" - runhaskell Setup $@ $$CABAL_CONFIGURE_OPTIONS #--user - -haddock: configure - PATH=~/.cabal/bin:$$PATH runhaskell Setup $@ --hyperlink-source #Amend path to find 'HsColour', as required for 'hyperlink-source'. - -hlint: - @$@ -i 'Use &&' src/ +RTS -N - -sdist: - TAR_OPTIONS='--format=ustar' runhaskell Setup $@ - -check: sdist - cabal upload --check --verbose=3 dist/*.tar.gz; - -clean: - runhaskell Setup $@ - find src -type f \( -name '*.hc' -o -name '*.hcr' -o -name '*.hi' -o -name '*.o' \) -delete - -help: - @grep '^[a-zA-Z].*:' makefile | sed -e 's/:.*//' - diff --git a/src-lib/ToolShed/Data/Foldable.hs b/src-lib/ToolShed/Data/Foldable.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/Foldable.hs @@ -0,0 +1,50 @@ +{- + Copyright (C) 2012 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous polymorphic operations on 'Data.Foldable.Foldable' types. +-} + +module ToolShed.Data.Foldable( +-- * Functions + gather, + gatherBy, +-- ** Predicates + hasDuplicates +) where + +import Control.Arrow((&&&)) +import qualified Data.Foldable +import qualified Data.Map + +{- | + * Group equal (though not necessarily adjacent; cf. 'Data.List.groupBy') elements, according to the specified comparator. + + * The groups are returned in ascending order, whilst their elements remain in their original order. +-} +gatherBy :: (Data.Foldable.Foldable f, Ord b) => (a -> b) -> f a -> [[a]] +gatherBy f = Data.Map.elems . Data.Foldable.foldr (uncurry (Data.Map.insertWith (++)) . (f &&& return {-to List-monad-})) Data.Map.empty + +-- | A specific instance of 'gatherBy'. +gather :: (Data.Foldable.Foldable f, Ord a) => f a -> [[a]] +gather = gatherBy id + +-- | Whether the specified collection contains any equal items. +hasDuplicates :: (Data.Foldable.Foldable f, Ord a) => f a -> Bool +hasDuplicates = any ((> 1) . length) . gather + diff --git a/src-lib/ToolShed/Data/List.hs b/src-lib/ToolShed/Data/List.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/List.hs @@ -0,0 +1,203 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous polymorphic list-operations. +-} + +module ToolShed.Data.List( +-- * Types +-- ** Type-synonyms + ChunkLength, + Matches, +-- * Functions + chunk, + excise, + equalityBy, + findConvergence, + findConvergenceBy, + linearise, + merge, + mergeBy, + nub', +-- nubWithInt, + permutations, + permutationsBy, + takeUntil, + showListWith, +-- showListWithChar, +-- showListWithString +) where + +import qualified Control.Arrow +import Control.Arrow((&&&)) +import qualified Data.IntSet +import qualified Data.List +import qualified Data.Set + +-- | The length of the chunks into which a list is split. +type ChunkLength = Int + +{- | + * Splits a list into chunks of the specified length. + + * The last chunk will be shorter, if the chunk-length isn't an aliquot part of the input list-length. + + * If the chunk-length is zero, the resulting list will be an infinite sequence of null lists. + + * CAVEAT: a similar function is available in the module /Data.List.Split/, though this one checks for @(chunkLength < 0)@. +-} +chunk + :: ChunkLength + -> [a] -- ^ The polymorphic input list to be chunked. + -> [[a]] +chunk size list + | size < 0 = error $ "ToolShed.Data.List.chunk:\tnegative chunk-size=" ++ show size + | otherwise = chunk' list + where + chunk' :: [a] -> [[a]] + chunk' [] = [] + chunk' a = uncurry (:) . Control.Arrow.second chunk' $ splitAt size a + +-- | Remove the single indexed element from the list. +excise + :: Int -- ^ The index. + -> [a] -- ^ The polymorphic input list. + -> [a] -- ^ The same list, with the indexed element removed. +excise 0 = tail -- Just for efficiency. +excise i = uncurry (++) . Control.Arrow.second tail . splitAt i + +-- | The type of function required by 'findConvergenceBy', 'permutationsBy'. +type Matches a = a -> a -> Bool + +-- | A convenient way to compose the 'Matches'-function required by 'findConvergenceBy' & 'permutationsBy'. +equalityBy :: Eq b => (a -> b) -> Matches a +equalityBy f x y = f x == f y + +-- | Take the first element from the (potentially infinite) list, which matches the subsequent element, according to the specified function. +findConvergenceBy :: Matches a -> [a] -> a +findConvergenceBy _ [] = error "ToolShed.Data.List.findConvergenceBy:\ta null list is too short for convergence to exist" +findConvergenceBy _ [_] = error "ToolShed.Data.List.findConvergenceBy:\ta singleton list is too short for convergence to exist" +findConvergenceBy matches l + | null l' = error "ToolShed.Data.List.findConvergenceBy:\tno convergence found" + | otherwise = fst $ head l' + where + l' = dropWhile (not . uncurry matches) . uncurry zip $ (init &&& tail) l + +-- | A specific instance of 'findConvergenceBy'. +findConvergence :: Eq a => [a] -> a +findConvergence = findConvergenceBy (==) + +{- | + * The list of all permutations, generated by selecting any one datum from each sub-list in turn, from the specified list of lists. + + * As each item is selected, the remaining lists are filtered according to the specified 'Matches'-function. + + * Thus '/=' could be used to select a different item from each list. +-} +permutationsBy :: Matches a -> [[a]] -> [[a]] +permutationsBy matches lists + | any null lists = [] -- Required for efficiency, to catch the case [bigList1, bigList2 ... null] + | otherwise = slave lists + where + slave (xs : xss) = [x : xs' | x <- xs, xs' <- slave $ map (filter $ matches x) xss] + slave [] = [[]] + +{- | + * The list of all permutations, generated by selecting any one datum from each sub-list in turn, from the specified list of lists. + + * A specific instance of 'permutationsBy', in which no filtering of subsequent lists is performed after each item is selected. + + * NB: differs from 'Data.List.permutations', which selects items from a single input list. +-} +permutations :: [[a]] -> [[a]] +permutations = permutationsBy (\_ _ -> True) + +{-# NOINLINE nub' #-} +{-# RULES "nub'/Int" nub' = nubWithInt #-} + +{- | + * A strict version of 'Data.List.nub' with better time-complexity. + + * CAVEAT: the specified list must be finite, since the entire set is constructed before streaming to a list. + + * CAVEAT: it sorts the output as a side-effect, & consequently it requires a type which implements 'Ord'. +-} +nub' :: Ord a => [a] -> [a] +nub' = Data.Set.toList . Data.Set.fromList + +-- | A specialisation for type 'Int'. +nubWithInt :: [Int] -> [Int] +nubWithInt = Data.IntSet.toList . Data.IntSet.fromList + +-- | Converts a list of /Pairs/, into a narrower list. +linearise :: [(a, a)] -> [a] +linearise [] = [] +linearise ((l, r) : remainder) = l : r : linearise remainder -- Recurse. + +{- | + * Merge two sorted lists, according to the specified order, to product a single sorted list. + + * The merge-process is /stable/, in that where items from each list are equal, they remain in the original order. + + * CAVEAT: duplicates are preserved. +-} +mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +mergeBy cmp = slave where + slave l@(x : xs) r@(y : ys) + | x `cmp` y == GT = y : slave l ys + | otherwise = x : slave xs r + slave [] r = r + slave l [] = l + +-- | A specific instance of 'mergeBy'. +merge :: Ord a => [a] -> [a] -> [a] +merge = mergeBy compare + +{- | + * Take until the specified predicate is satisfied; /including/ the item which satisfied it. + + * NB: @takeWhile (not . test)@ would return one fewer item. +-} +takeUntil + :: (a -> Bool) -- ^ Predicate, used to determine the last item taken. + -> [a] -- ^ The polymorphic input list. + -> [a] +takeUntil predicate = takeUntil' where + takeUntil' (x : xs) = x {-take regardless-} : if predicate x then [] else takeUntil' xs + takeUntil' _ = [] + +-- | Show a list, delimited by the specified tokens. +showListWith :: (Show token, Show element) + => (token, token, token) -- ^ (Start-delimiter, separator, end-delimiter) + -> [element] -- ^ The polymorphic list to show. + -> ShowS +showListWith (startDelimiter, separator, endDelimiter) = foldr (.) (shows endDelimiter) . (shows startDelimiter :) . Data.List.intersperse (shows separator) . map shows + +{-# NOINLINE showListWith #-} +{-# RULES "showListWith/Char" showListWith = showListWithChar #-} +{-# RULES "showListWith/String" showListWith = showListWithString #-} + +-- | A specialisation of 'showListWith'. +showListWithChar :: Show element => (Char, Char, Char) -> [element] -> ShowS +showListWithChar (startDelimiter, separator, endDelimiter) = foldr (.) (showChar endDelimiter) . (showChar startDelimiter :) . Data.List.intersperse (showChar separator) . map shows + +-- | A specialisation of 'showListWith'. +showListWithString :: Show element => (String, String, String) -> [element] -> ShowS +showListWithString (startDelimiter, separator, endDelimiter) = foldr (.) (showString endDelimiter) . (showString startDelimiter :) . Data.List.intersperse (showString separator) . map shows + diff --git a/src-lib/ToolShed/Data/List/Runlength.hs b/src-lib/ToolShed/Data/List/Runlength.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/List/Runlength.hs @@ -0,0 +1,56 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Run-length encoder and decoder. +-} + +module ToolShed.Data.List.Runlength( +-- * Types +-- ** Type-synonyms + Code, +-- * Functions + encode, + decode, +-- ** Accessors + getLength, + getDatum +) where + +import Control.Arrow((&&&)) +import qualified Data.List + +-- | Describes the number of consecutive equal items in a list. +type Code a = (Int, a) + +-- | Accessor. +getLength :: Code a -> Int +getLength = fst + +-- | Accessor. +getDatum :: Code a -> a +getDatum = snd + +-- | /Run-length/ encodes the specified list. +encode :: Eq a => [a] -> [Code a] +encode = map (length &&& head) . Data.List.group + +-- | Performs /run-length/ decoding to retrieve the original unencoded list. +decode :: [Code a] -> [a] +decode = concatMap (uncurry replicate) + diff --git a/src-lib/ToolShed/Data/List/Splits.hs b/src-lib/ToolShed/Data/List/Splits.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/List/Splits.hs @@ -0,0 +1,66 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] +-} + +module ToolShed.Data.List.Splits( +-- * Types +-- ** Type-synonyms +-- Split, +-- * Functions +-- splitsFrom, + splitsLeftFrom, + splitsRightFrom +) where + +-- | The polymorphic pair, resulting from splitting a list of arbitrary type. +type Split a = ([a] {-left list-}, [a] {-right list-}) + +-- | Use the specified transformation, to generate a list of 'Split's, from the initial one. +splitsFrom + :: (Split a -> Split a) -- ^ The function used to transform one /split/ into the next. + -> Int -- ^ Index. + -> [a] -- ^ The polymorphic input list from which the /splits/ are generated. + -> [Split a] -- ^ The list of all required splits of the single input list. +splitsFrom transformation i + | i < 0 = error $ "ToolShed.Data.List.Splits.splitsFrom:\tnegative starting-index; " ++ show i + | otherwise = iterate transformation . splitAt i + +{- | + * Create the set of all 'Split's, migrating left from the specified location. + + * CAVEAT: 'init' fails when 'fst' has been reduced to null. +-} +splitsLeftFrom + :: Int -- ^ Index. + -> [a] -- ^ The polymorphic input list from which the /splits/ are generated, as the index is stepped left + -> [Split a] -- ^ The list of all required splits of the single input list. +splitsLeftFrom = splitsFrom (\(l, r) -> (init l, last l : r)) + +{- | + * Create the set of all 'Split's, migrating right from the specified location. + + * CAVEAT: pattern-match against @ : @ fails, when 'snd' has been reduced to 'null'. +-} +splitsRightFrom + :: Int -- ^ Index. + -> [a] -- ^ The polymorphic input list from which the /splits/ are generated, as the index is stepped right. + -> [Split a] -- ^ The list of all required splits of the single input list. +splitsRightFrom = splitsFrom (\(l, r : rs) -> (l ++ [r], rs)) diff --git a/src-lib/ToolShed/Data/Pair.hs b/src-lib/ToolShed/Data/Pair.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/Pair.hs @@ -0,0 +1,37 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous operations on Pairs. +-} + +module ToolShed.Data.Pair( +-- * Functions + mirror +) where + +import Control.Arrow((***)) + +{- | + * Apply the same transformation to both halves of a /Pair/. + + * CAVEAT: even though the function may be polymorphic, the pair is required to have identical types. +-} +mirror :: (a -> b) -> (a, a) -> (b, b) +mirror f = f *** f + diff --git a/src-lib/ToolShed/Data/Quadruple.hs b/src-lib/ToolShed/Data/Quadruple.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/Quadruple.hs @@ -0,0 +1,59 @@ +{- + Copyright (C) 2013 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous operations on quadruples. + + [@CAVEAT@] Import fully qualified, since some identifiers clash with 'ToolShed.Data.Triple'. +-} + +module ToolShed.Data.Quadruple( +-- * Functions + curry4, + uncurry4, +-- ** Accessors + getFirst, + getSecond, + getThird, + getFourth +) where + +-- | Extends the concept of 'Data.Tuple.curry'. +curry4 :: ((a, b, c, d) -> result) -> a -> b -> c -> d -> result +curry4 f a b c d = f (a, b, c, d) + +-- | Extends the concept of 'Data.Tuple.uncurry'. +uncurry4 :: (a -> b -> c -> d -> result) -> (a, b, c, d) -> result +uncurry4 f (a, b, c, d) = f a b c d + +-- | Access the first datum from the specified quadruple. +getFirst :: (a, b, c, d) -> a +getFirst (a, _, _, _) = a + +-- | Access the second datum from the specified quadruple. +getSecond :: (a, b, c, d) -> b +getSecond (_, b, _, _) = b + +-- | Access the third datum from the specified quadruple. +getThird :: (a, b, c, d) -> c +getThird (_, _, c, _) = c + +-- | Access the fourth datum from the specified quadruple. +getFourth :: (a, b, c, d) -> d +getFourth (_, _, _, d) = d + diff --git a/src-lib/ToolShed/Data/Triple.hs b/src-lib/ToolShed/Data/Triple.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Data/Triple.hs @@ -0,0 +1,54 @@ +{- + Copyright (C) 2013 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous operations on triples. + + [@CAVEAT@] Import fully qualified, since some identifiers clash with 'ToolShed.Data.Quadruple'. +-} + +module ToolShed.Data.Triple( +-- * Functions + curry3, + uncurry3, +-- ** Accessors + getFirst, + getSecond, + getThird +) where + +-- | Extends the concept of 'Data.Tuple.curry'. +curry3 :: ((a, b, c) -> result) -> a -> b -> c -> result +curry3 f a b c = f (a, b, c) + +-- | Extends the concept of 'Data.Tuple.uncurry'. +uncurry3 :: (a -> b -> c -> result) -> (a, b, c) -> result +uncurry3 f (a, b, c) = f a b c + +-- | Access the first datum from the specified triple. +getFirst :: (a, b, c) -> a +getFirst (a, _, _) = a + +-- | Access the second datum from the specified triple. +getSecond :: (a, b, c) -> b +getSecond (_, b, _) = b + +-- | Access the third datum from the specified triple. +getThird :: (a, b, c) -> c +getThird (_, _, c) = c + diff --git a/src-lib/ToolShed/Defaultable.hs b/src-lib/ToolShed/Defaultable.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Defaultable.hs @@ -0,0 +1,36 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] A simple interface which data-types with a default-value can implement. +-} + +module ToolShed.Defaultable( +-- * Type-classes + Defaultable(..) +) where + +-- | An interface to which data which have a default-value can adhere. +class Defaultable a where + defaultValue :: a -- ^ The default value of the data-type. + +instance (Defaultable a, Defaultable b) => Defaultable (a, b) where + defaultValue = (defaultValue, defaultValue) + +instance (Defaultable a, Defaultable b, Defaultable c) => Defaultable (a, b, c) where + defaultValue = (defaultValue, defaultValue, defaultValue) diff --git a/src-lib/ToolShed/Options.hs b/src-lib/ToolShed/Options.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Options.hs @@ -0,0 +1,32 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a standard interface to which various options-related data can conform. +-} + +module ToolShed.Options( +-- * Type-classes + Options(..) +) where + +import qualified ToolShed.Defaultable + +-- | Similar to the class 'Text.Regex.Base.RegexLike.RegexOptions'. +class ToolShed.Defaultable.Defaultable a => Options a where + blankValue :: a -- ^ The /undefined/ state of the data-type, which may be literal, but could alternatively be a logical starting value. diff --git a/src-lib/ToolShed/SelfValidate.hs b/src-lib/ToolShed/SelfValidate.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/SelfValidate.hs @@ -0,0 +1,75 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] A class to define the simple interface, to which data which can self-validation, should conform. +-} + +module ToolShed.SelfValidate( +-- * Type-classes + SelfValidator(..), +-- ** Functions + getFirstError, + extractErrors +) where + +import qualified Data.Array.IArray +import qualified Data.Map +import qualified Data.Set + +-- | The interface to which data which can self-validate should conform. +class SelfValidator v where + getErrors :: v -> [String] -- ^ Return either null, or the reasons why the data is invalid. + + isValid :: v -> Bool -- ^ The data which implements this interface should return 'True' if internally consistent. + isValid = null . getErrors -- Default implementation. + +instance (SelfValidator v) => SelfValidator (Maybe v) where + getErrors (Just v) = getErrors v + getErrors _ = [] + +instance (SelfValidator a, SelfValidator b) => SelfValidator (a, b) where + getErrors (x, y) = getErrors x ++ getErrors y + +instance (SelfValidator a, SelfValidator b, SelfValidator c) => SelfValidator (a, b, c) where + getErrors (x, y, z) = getErrors x ++ getErrors y ++ getErrors z + +instance SelfValidator v => SelfValidator [v] where + getErrors = concatMap getErrors + +instance SelfValidator v => SelfValidator (Data.Set.Set v) where + getErrors = Data.Set.foldr ((++) . getErrors) [] + +instance SelfValidator v => SelfValidator (Data.Map.Map k v) where + getErrors = Data.Map.foldr ((++) . getErrors) [] + +instance (Data.Array.IArray.Ix index, SelfValidator element) => SelfValidator (Data.Array.IArray.Array index element) where + getErrors = concatMap getErrors . Data.Array.IArray.elems + +-- | Returns the first error only (so only call on failure of 'isValid'), since subsequent tests may be based on invalid data. +getFirstError :: SelfValidator v => v -> String +getFirstError selfValidator + | null errors = error "ToolShed.SelfValidate.getFirstError:\tzero errors ?!" + | otherwise = head errors + where + errors = getErrors selfValidator + +-- | Extracts the failed tests from those specified. +extractErrors :: [(Bool, String)] -> [String] +extractErrors = map snd . filter fst + diff --git a/src-lib/ToolShed/System/File.hs b/src-lib/ToolShed/System/File.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/System/File.hs @@ -0,0 +1,106 @@ + +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] File-operations. +-} + +module ToolShed.System.File( +-- * Types +-- ** Type-synonyms + SearchPath, + LocatedData, +-- * Functions + locate, + getFile, + fromFile, +-- ** Accessors + getFilePath, + getData +) where + +import qualified Control.Exception +import qualified Control.Monad +import qualified Data.List +import qualified System.Directory +import qualified System.FilePath +import System.FilePath(()) +import qualified System.IO.Error + +-- | The ordered sequence of directories, searched for a file. +type SearchPath = [System.FilePath.FilePath] + +{- | + * When supplied with an /absolute/ file-path, the /search-path/ is ignored and an exception is thrown if either the file-path is invalid or the file doesn't exist. + + * If the specified file-name is /relative/, all matching instances on the specified /search-path/ are returned. + + * CAVEAT: doesn't perform file-globbing. +-} +locate :: System.FilePath.FilePath -> SearchPath -> IO [System.FilePath.FilePath] +locate fileName searchPath + | System.FilePath.isRelative fileName' = Control.Monad.filterM System.Directory.doesFileExist . filter System.FilePath.isValid . Data.List.nubBy System.FilePath.equalFilePath $ map (System.FilePath.normalise . ( fileName')) searchPath + | not $ System.FilePath.isValid fileName' = Control.Exception.throwIO . System.IO.Error.userError $ "Invalid filename; " ++ fileName' + | otherwise = do + fileExists <- System.Directory.doesFileExist fileName' + + if not fileExists + then Control.Exception.throwIO . System.IO.Error.mkIOError System.IO.Error.doesNotExistErrorType "No such file" Nothing $ Just fileName' + else return {-to IO-monad-} [fileName'] + where + fileName' = System.FilePath.normalise fileName + +-- | A file-path, and the contents read from it. +type LocatedData a = (System.FilePath.FilePath, a) + +-- | Accessor. +getFilePath :: LocatedData a -> System.FilePath.FilePath +getFilePath = fst + +-- | Accessor. +getData :: LocatedData a -> a +getData = snd + +{- | + Traverse the /search-path/, looking for matching instances of the specified file-name, + and either throw an exception, or return a pair composed from the path to the first matching file, together with its contents. +-} +getFile :: System.FilePath.FilePath -> SearchPath -> IO (LocatedData String) +getFile fileName directories = do + filePaths <- locate fileName directories + + if null filePaths + then Control.Exception.throwIO . System.IO.Error.mkIOError System.IO.Error.doesNotExistErrorType ("Can't find in " ++ show directories) Nothing $ Just fileName + else {-located-} let + filePath = head filePaths -- Discard any subsequent paths. + in (,) filePath `fmap` readFile filePath + +{- | + * Returns the polymorphic data, read from the first matching file on the /search-path/, along with the path from which it was read. + + * Returns an error on failure to parse the contents of the first matching file found on the /search-path/. +-} +fromFile :: Read a => System.FilePath.FilePath -> SearchPath -> IO (LocatedData a) +fromFile fileName directories = do + (filePath, fileContents) <- getFile fileName directories + + case reads fileContents of + [(x, _)] -> return {-to IO-monad-} (filePath, x) -- CAVEAT: discards any unconsumed text. + _ -> fail $ "ToolShed.System.File.fromFile:\tfailed to parse file=" ++ show filePath + diff --git a/src-lib/ToolShed/System/Random.hs b/src-lib/ToolShed/System/Random.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/System/Random.hs @@ -0,0 +1,83 @@ + +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Utilities related to random-numbers. +-} + +module ToolShed.System.Random( +-- * Functions + randomGens, + shuffle, + generateSelection, + generateSelectionFromBounded, + select +) where + +import qualified Control.Arrow +import qualified Data.Sequence +import Data.Sequence((><), ViewL((:<))) +import qualified System.Random + +-- | Constructs an infinite list of independent random-generators. +randomGens :: System.Random.RandomGen randomGen => randomGen -> [randomGen] +randomGens = uncurry (:) . Control.Arrow.second randomGens {-recurse-} . System.Random.split + +{- | + * Shuffles the specified finite list, using the /Fisher-Yates/ algorithm; . + + * The resulting list has the same length and constituents as the original; only the order has changed. + + * The input list is traversed, but the items aren't evaluated. +-} +shuffle :: System.Random.RandomGen randomGen => randomGen -> [a] -> [a] +shuffle _ [] = [] -- Not strictly necessary. +shuffle _ singleton@[_] = singleton -- Not strictly necessary. +shuffle randomGen l = slave randomGen s (pred $ Data.Sequence.length s) where + s = Data.Sequence.fromList l + + slave randomGen' s' maxIndex + | maxIndex < 0 = [] + | otherwise = selection : slave randomGen'' (first >< remainder) (pred maxIndex) {-recurse-} + where + (randomIndex, randomGen'') = System.Random.randomR (0, maxIndex) randomGen' + (first, selection :< remainder) = Control.Arrow.second Data.Sequence.viewl $ Data.Sequence.splitAt randomIndex s' + +{- | + * Generate an infinite list of items, each independently randomly selected from the specified finite list. + + * CAVEAT: because the selections are made non-destructively, duplicates may be returned; cf. 'shuffle'. +-} +generateSelection :: System.Random.RandomGen randomGen => randomGen -> [a] -> [a] +generateSelection _ [] = error "ToolShed.System.Random.generateSelection:\tnull list" +generateSelection _ [x] = repeat x -- Not strictly necessary, but more efficient. +generateSelection randomGen l = map (l !!) $ System.Random.randomRs (0, pred $ length l) randomGen + +-- | Return a randomly selected element from the specified list. +select :: System.Random.RandomGen randomGen => randomGen -> [a] -> a +select randomGen = head . generateSelection randomGen + +{- | + * Generate an infinite list of data, each independently selected random instances of the specified /bounded/ type. + + * E.g. @ (generateSelectionFromBounded `fmap` System.Random.getStdGen) :: IO [Bool] @. +-} +generateSelectionFromBounded :: (System.Random.RandomGen randomGen, Bounded a, System.Random.Random a) => randomGen -> [a] +generateSelectionFromBounded = System.Random.randomRs (minBound, maxBound) + diff --git a/src-lib/ToolShed/System/TimeAction.hs b/src-lib/ToolShed/System/TimeAction.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/System/TimeAction.hs @@ -0,0 +1,49 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Determines the CPU-time, required to evaluate the specified IO-action. + +-} + +module ToolShed.System.TimeAction( +-- * Functions + getCPUSeconds, + printCPUSeconds +) where + +import qualified System.CPUTime +import qualified System.IO + +-- | Time the specified IO-action, returning the required number of CPU-seconds and the result, as a 'Pair'. +getCPUSeconds :: Fractional seconds => IO result -> IO (seconds, result) +getCPUSeconds action = do + startTime <- System.CPUTime.getCPUTime + result <- action + endTime <- System.CPUTime.getCPUTime + + return {-to IO-monad-} (fromInteger (endTime - startTime) / 1e12 {-convert from pico-seconds-}, result) + +-- | Print the time required by the specified IO-action. +printCPUSeconds :: IO result -> IO result +printCPUSeconds action = do + (cpuSeconds, result) <- getCPUSeconds action + + System.IO.hPutStrLn System.IO.stderr $ "CPU-seconds:\t" ++ show (cpuSeconds :: Double) + + return {-to IO-monad-} result diff --git a/src-lib/ToolShed/System/TimePure.hs b/src-lib/ToolShed/System/TimePure.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/System/TimePure.hs @@ -0,0 +1,60 @@ +{- + Copyright (C) 2010 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Determines the CPU-time, required to evaluate the specified pure expression. + +-} + +module ToolShed.System.TimePure( +-- * Functions + getCPUSeconds, + printCPUSeconds +) where + +import qualified Control.DeepSeq +import qualified System.CPUTime +import qualified System.IO + +{- | + * Time the specified pure expression, returning the required number of CPU-seconds and the result, as a 'Pair'. + + * CAVEAT: as a side-effect, the expression is /deep/ evaluated. +-} +getCPUSeconds :: (Fractional seconds, Control.DeepSeq.NFData expression) + => expression -- ^ Arbitrary polymorphic expression. + -> IO (seconds, expression) -- ^ The original expression, tagged with the CPU-seconds taken. +getCPUSeconds expression = do + start <- System.CPUTime.getCPUTime + end <- expression `Control.DeepSeq.deepseq` System.CPUTime.getCPUTime + + return {-to IO-monad-} (fromInteger (end - start) / 1e12 {-convert from pico-seconds-}, expression) + +{- | + * Print the time required by the specified pure expression. + + * CAVEAT: as a side-effect, the expression is /deep/ evaluated. +-} +printCPUSeconds :: Control.DeepSeq.NFData expression => expression -> IO expression +printCPUSeconds expression = do + (cpuSeconds, result) <- getCPUSeconds expression + + System.IO.hPutStrLn System.IO.stderr $ "CPU-seconds:\t" ++ show (cpuSeconds :: Double) + + return {-to IO-monad-} result + diff --git a/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Array.hs b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Array.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Array.hs @@ -0,0 +1,37 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + Implements 'Test.QuickCheck.Arbitrary' for 'Data.Array.IArray.Array', + where the array-index is required to be a /bounded enumerable/ type. + + [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Array.IArray.Array Data.Int.Int8 Int))@ +-} + +module ToolShed.Test.QuickCheck.Arbitrary.Array() where + +import qualified Data.Array.IArray +import qualified Test.QuickCheck + +instance (Bounded i, Data.Array.IArray.Ix i, Enum i, Test.QuickCheck.Arbitrary e) => Test.QuickCheck.Arbitrary (Data.Array.IArray.Array i e) where + arbitrary = (Data.Array.IArray.array bounds . zip [minBound .. maxBound]) `fmap` Test.QuickCheck.vector (succ $ fromEnum (snd bounds) - fromEnum (fst bounds)) where + bounds = (minBound, maxBound) + diff --git a/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Map.hs b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Map.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Map.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.Map.Map'. + + [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Map.Map Char Int))@ +-} + +module ToolShed.Test.QuickCheck.Arbitrary.Map() where + +import qualified Data.Map +import qualified Test.QuickCheck + +instance (Ord k, Test.QuickCheck.Arbitrary k, Test.QuickCheck.Arbitrary v) => Test.QuickCheck.Arbitrary (Data.Map.Map k v) where + arbitrary = Data.Map.fromList `fmap` Test.QuickCheck.arbitrary {-[(k, v)]-} + diff --git a/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Set.hs b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Set.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/QuickCheck/Arbitrary/Set.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.Set.Set'. + + [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Set.Set Int))@ +-} + +module ToolShed.Test.QuickCheck.Arbitrary.Set() where + +import qualified Data.Set +import qualified Test.QuickCheck + +instance (Ord k, Test.QuickCheck.Arbitrary k) => Test.QuickCheck.Arbitrary (Data.Set.Set k) where + arbitrary = Data.Set.fromList `fmap` Test.QuickCheck.arbitrary {-[k]-} + diff --git a/src-lib/ToolShed/Test/QuickCheck/Result.hs b/src-lib/ToolShed/Test/QuickCheck/Result.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/QuickCheck/Result.hs @@ -0,0 +1,34 @@ +{- + Copyright (C) 2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Provides a simple predicate. +-} + +module ToolShed.Test.QuickCheck.Result( +-- * Functions +-- ** Predicates + isSuccessful +) where + +import qualified Test.QuickCheck + +-- | Check whether the specified result is successful. +isSuccessful :: Test.QuickCheck.Result -> Bool +isSuccessful Test.QuickCheck.Success {} = True +isSuccessful _ = False diff --git a/src-lib/ToolShed/Test/ReversibleBoundedEnum.hs b/src-lib/ToolShed/Test/ReversibleBoundedEnum.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/ReversibleBoundedEnum.hs @@ -0,0 +1,34 @@ +{- + Copyright (C) 2012 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Facilities testing of custom implementations of 'Enum'. +-} + +module ToolShed.Test.ReversibleBoundedEnum( +-- * Functions +-- ** Predicates + isReversible +) where + +-- | Checks that composing 'pred' & 'succ' is equivalent to the identity. +isReversible :: (Bounded r, Eq r, Enum r) => r -> Bool +isReversible r + | r == minBound = pred (succ r) == r + | otherwise = succ (pred r) == r + diff --git a/src-lib/ToolShed/Test/ReversibleEnum.hs b/src-lib/ToolShed/Test/ReversibleEnum.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/ReversibleEnum.hs @@ -0,0 +1,31 @@ +{- + Copyright (C) 2012 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Facilities testing of custom implementations of 'Enum'. +-} + +module ToolShed.Test.ReversibleEnum( +-- * Functions +-- ** Predicates + isReversible +) where + +-- | Checks that composing 'toEnum' & 'fromEnum' is equivalent to the identity. +isReversible :: (Eq r, Enum r) => r -> Bool +isReversible r = toEnum (fromEnum r) == r diff --git a/src-lib/ToolShed/Test/ReversibleIO.hs b/src-lib/ToolShed/Test/ReversibleIO.hs new file mode 100644 --- /dev/null +++ b/src-lib/ToolShed/Test/ReversibleIO.hs @@ -0,0 +1,35 @@ +{- + Copyright (C) 2012 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Facilities testing of custom implementations of 'Read' & 'Show'. + + * CAVEAT: it doesn't actually do any IO. +-} + +module ToolShed.Test.ReversibleIO( +-- * Functions +-- ** Predicates + isReversible +) where + +-- | Checks that composing 'read' & 'show' is equivalent to the identity. +isReversible :: (Eq r, Read r, Show r) => r -> Bool +isReversible r = read (show r) == r diff --git a/src-test/Main.hs b/src-test/Main.hs new file mode 100644 --- /dev/null +++ b/src-test/Main.hs @@ -0,0 +1,58 @@ +{- + Copyright (C) 2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * The entry-point to the application's test-suite. +-} + +module Main(main) where + +import Control.Arrow((***)) +import qualified Control.Monad +import qualified System.Exit +import qualified ToolShed.Test.Data.Foldable as Test.Data.Foldable +import qualified ToolShed.Test.Data.List as Test.Data.List +import qualified ToolShed.Test.Data.List.Runlength as Test.Data.List.Runlength +import qualified ToolShed.Test.Data.List.Splits as Test.Data.List.Splits +import qualified ToolShed.Test.Data.Quadruple as Test.Data.Quadruple +import qualified ToolShed.Test.Data.Triple as Test.Data.Triple +import qualified ToolShed.Test.QuickCheck.Result as Test.QuickCheck.Result +import qualified ToolShed.Test.SelfValidate as Test.SelfValidate +import qualified ToolShed.Test.System.Random as Test.System.Random + +-- | Entry-point. +main :: IO () +main = mapM_ ( + snd {-exit-status-} . ( + putStrLn . (++ ":") *** ( + >>= (`Control.Monad.unless` System.Exit.exitFailure) . all Test.QuickCheck.Result.isSuccessful + ) + ) + ) [ + ("Data.Foldable", Test.Data.Foldable.results), + ("Data.List", Test.Data.List.results), + ("Data.List.Runlength", Test.Data.List.Runlength.results), + ("Data.List.Splits", Test.Data.List.Splits.results), + ("Data.Quadruple", Test.Data.Quadruple.results), + ("Data.Triple", Test.Data.Triple.results), + ("SelfValidate", Test.SelfValidate.results), + ("System.Random", Test.System.Random.results) + ] + diff --git a/src-test/ToolShed/Test/Data/Foldable.hs b/src-test/ToolShed/Test/Data/Foldable.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/Foldable.hs @@ -0,0 +1,51 @@ +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Foldable". +-} + +module ToolShed.Test.Data.Foldable( +-- * Constants + results +) where + +import qualified Data.List +import qualified Data.Ord +import qualified Data.Set +import qualified ToolShed.Data.Foldable +import qualified ToolShed.Data.List +import qualified Test.QuickCheck + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_gatherSet, + Test.QuickCheck.quickCheckResult prop_gatherBy + ] where + prop_gatherSet :: Int -> Test.QuickCheck.Property + prop_gatherSet n = Test.QuickCheck.label "prop_gatherSet" . (== l) . concat . ToolShed.Data.Foldable.gather $ Data.Set.fromDistinctAscList l where + l = [0 .. n `mod` 1024] + + prop_gatherBy :: [Int] -> Test.QuickCheck.Property + prop_gatherBy l = Test.QuickCheck.label "prop_gatherBy" $ map Data.List.sort ( + ToolShed.Data.Foldable.gatherBy even l + ) == ( + map Data.List.sort . Data.List.groupBy (ToolShed.Data.List.equalityBy even) $ Data.List.sortBy (Data.Ord.comparing even) l + ) + diff --git a/src-test/ToolShed/Test/Data/List.hs b/src-test/ToolShed/Test/Data/List.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/List.hs @@ -0,0 +1,76 @@ +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List". +-} + +module ToolShed.Test.Data.List( +-- * Constants + results +) where + +import qualified Data.List +import qualified ToolShed.Data.List +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_chunk, + Test.QuickCheck.quickCheckResult prop_findConvergence, + Test.QuickCheck.quickCheckResult prop_linearise, + Test.QuickCheck.quickCheckResult prop_merge, + Test.QuickCheck.quickCheckResult prop_nub, + Test.QuickCheck.quickCheckResult prop_permutations, + Test.QuickCheck.quickCheckResult prop_permutations', + Test.QuickCheck.quickCheckResult prop_permutationsBy, + Test.QuickCheck.quickCheckResult prop_permutationsBy' + ] where + prop_chunk :: Int -> [Int] -> Test.QuickCheck.Property + prop_chunk i l = Test.QuickCheck.label "prop_chunk" $ concat (ToolShed.Data.List.chunk (succ $ abs i) l) == l + + prop_findConvergence :: Int -> Test.QuickCheck.Property + prop_findConvergence = Test.QuickCheck.label "prop_findConvergence" . (== 0) . ToolShed.Data.List.findConvergence . iterate (fst . (`quotRem` 2)) + + prop_linearise :: [(Int, Int)] -> Test.QuickCheck.Property + prop_linearise l = Test.QuickCheck.label "prop_linearise" $ map (\[x, y] -> (x, y)) (ToolShed.Data.List.chunk 2 $ ToolShed.Data.List.linearise l) == l + + prop_merge :: [Int] -> [Int] -> Test.QuickCheck.Property + prop_merge x y = Test.QuickCheck.label "prop_merge" $ ToolShed.Data.List.merge (Data.List.sort x) (Data.List.sort y) == Data.List.sort (x ++ y) + + prop_nub :: [Int] -> Test.QuickCheck.Property + prop_nub x = Test.QuickCheck.label "prop_nub" $ ToolShed.Data.List.nub' x == Data.List.sort (Data.List.nub x) + + prop_permutations, prop_permutations', prop_permutationsBy :: [[Int]] -> Test.QuickCheck.Property + prop_permutations l = not (null l') ==> Test.QuickCheck.label "prop_permutations" $ length (ToolShed.Data.List.permutations l') == product (map length l') where + l' = take 6 $ map (take 6) l -- Limit the task. + + prop_permutations' l = not (null l') && all (not . null) l' ==> Test.QuickCheck.label "prop_permutations'" . (== 1) . length . Data.List.nub . map length $ ToolShed.Data.List.permutations l' where + l' = take 7 $ map (take 5) l -- Limit the task. + + prop_permutationsBy l = and [not $ null l', all (not . null) l', not $ null permutations] ==> Test.QuickCheck.label "prop_permutationsBy" . (== 1) . length . Data.List.nub $ map (length . Data.List.nub) permutations where + l' = take 8 $ map (take 4) l -- Limit the task. + permutations = ToolShed.Data.List.permutationsBy (/=) l' + + prop_permutationsBy' :: Int -> Test.QuickCheck.Property + prop_permutationsBy' i = Test.QuickCheck.label "prop_permutationsBy'" . all ((== range) . Data.List.sort) . ToolShed.Data.List.permutationsBy (/=) $ replicate (succ i') range where + i' = succ $ mod i 7 + range = [0 .. i'] + diff --git a/src-test/ToolShed/Test/Data/List/Runlength.hs b/src-test/ToolShed/Test/Data/List/Runlength.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/List/Runlength.hs @@ -0,0 +1,36 @@ +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List.Runlength". +-} + +module ToolShed.Test.Data.List.Runlength( +-- * Constants + results +) where + +import qualified ToolShed.Data.List.Runlength +import qualified Test.QuickCheck + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_runLength] where + prop_runLength :: [Int] -> Test.QuickCheck.Property + prop_runLength l = Test.QuickCheck.label "prop_runLength" $ ToolShed.Data.List.Runlength.decode (ToolShed.Data.List.Runlength.encode l) == l + diff --git a/src-test/ToolShed/Test/Data/List/Splits.hs b/src-test/ToolShed/Test/Data/List/Splits.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/List/Splits.hs @@ -0,0 +1,40 @@ +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List.Splits". +-} + +module ToolShed.Test.Data.List.Splits( +-- * Constants + results +) where + +import Control.Arrow((***)) +import qualified Data.Tuple +import qualified ToolShed.Data.List.Splits +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_splitsFrom] where + prop_splitsFrom :: Int -> [Int] -> Test.QuickCheck.Property + prop_splitsFrom i l = not (null l) ==> Test.QuickCheck.label "prop_splitsFrom" $ take n (ToolShed.Data.List.Splits.splitsLeftFrom index l) == take n (map (Data.Tuple.swap . (reverse *** reverse)) . ToolShed.Data.List.Splits.splitsRightFrom (length l - index) $ reverse l) where + index = i `mod` length l + n = succ index diff --git a/src-test/ToolShed/Test/Data/Quadruple.hs b/src-test/ToolShed/Test/Data/Quadruple.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/Quadruple.hs @@ -0,0 +1,36 @@ +{- + Copyright (C) 2013-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Quadruple". +-} + +module ToolShed.Test.Data.Quadruple( +-- * Constants + results +) where + +import qualified Test.QuickCheck +import qualified ToolShed.Data.Quadruple + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_accessors] where + prop_accessors :: (Int, Char, Bool, Float) -> Test.QuickCheck.Property + prop_accessors quadruple = Test.QuickCheck.label "prop_accessors" $ (f ToolShed.Data.Quadruple.getFirst quadruple, f ToolShed.Data.Quadruple.getSecond quadruple, f ToolShed.Data.Quadruple.getThird quadruple, ToolShed.Data.Quadruple.getFourth quadruple) == quadruple where + f = ToolShed.Data.Quadruple.uncurry4 . ToolShed.Data.Quadruple.curry4 diff --git a/src-test/ToolShed/Test/Data/Triple.hs b/src-test/ToolShed/Test/Data/Triple.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/Data/Triple.hs @@ -0,0 +1,37 @@ +{- + Copyright (C) 2013-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Triple". +-} + +module ToolShed.Test.Data.Triple( +-- * Constants + results +) where + +import qualified Test.QuickCheck +import qualified ToolShed.Data.Triple + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_accessors] where + prop_accessors :: (Int, Char, Bool) -> Test.QuickCheck.Property + prop_accessors triple = Test.QuickCheck.label "prop_accessors" $ (f ToolShed.Data.Triple.getFirst triple, f ToolShed.Data.Triple.getSecond triple, f ToolShed.Data.Triple.getThird triple) == triple where + f = ToolShed.Data.Triple.uncurry3 . ToolShed.Data.Triple.curry3 + diff --git a/src-test/ToolShed/Test/SelfValidate.hs b/src-test/ToolShed/Test/SelfValidate.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/SelfValidate.hs @@ -0,0 +1,77 @@ +{- + Copyright (C) 2012-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.SelfValidate". +-} + +module ToolShed.Test.SelfValidate( +-- * Constants + results, +-- * Types +-- ** Data-types +-- Primes +) where + +import qualified Data.Foldable +import qualified Data.List +import qualified Data.Map +import qualified Data.Set +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) +import qualified ToolShed.SelfValidate as SelfValidate +import ToolShed.Test.QuickCheck.Arbitrary.Map() +import ToolShed.Test.QuickCheck.Arbitrary.Set() + +-- | A test-type. +newtype Primes = MkPrimes Int deriving (Eq, Ord, Show) + +instance SelfValidate.SelfValidator Primes where + getErrors (MkPrimes i) = SelfValidate.extractErrors [ + (any ((== 0) . (i `rem`)) [2,3,5], "Composite; " ++ show i), + (i < 0, "Negative; " ++ show i), + (i `elem` [0, 1], "Excluded; " ++ show i) + ] + +instance Test.QuickCheck.Arbitrary Primes where + arbitrary = MkPrimes `fmap` Test.QuickCheck.elements [negate limit .. limit] where limit = pred $ 7 * 7 + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_list, + Test.QuickCheck.quickCheckResult prop_list', + Test.QuickCheck.quickCheckResult prop_set, + Test.QuickCheck.quickCheckResult prop_map + ] where + prop_list, prop_list' :: [Primes] -> Test.QuickCheck.Property + prop_list l = not (null l) ==> Test.QuickCheck.label "prop_list" $ SelfValidate.getErrors (head l) `Data.List.isPrefixOf` SelfValidate.getErrors l + prop_list' l = Test.QuickCheck.label "prop_list'" $ all ( + (`elem` map SelfValidate.getErrors l) . SelfValidate.getErrors + ) l + + prop_set :: Data.Set.Set Primes -> Test.QuickCheck.Property + prop_set s = Test.QuickCheck.label "prop_set" $ Data.Foldable.all ( + (`Data.Set.isSubsetOf` Data.Set.fromList (SelfValidate.getErrors s)) . Data.Set.fromList . SelfValidate.getErrors + ) s + + prop_map :: Data.Map.Map Int Primes -> Test.QuickCheck.Property + prop_map m = Test.QuickCheck.label "prop_map" $ Data.Foldable.all ( + (`Data.Set.isSubsetOf` Data.Set.fromList (SelfValidate.getErrors m)) . Data.Set.fromList . SelfValidate.getErrors + ) m + diff --git a/src-test/ToolShed/Test/System/Random.hs b/src-test/ToolShed/Test/System/Random.hs new file mode 100644 --- /dev/null +++ b/src-test/ToolShed/Test/System/Random.hs @@ -0,0 +1,83 @@ +{- + Copyright (C) 2013-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.System.Random". +-} + +module ToolShed.Test.System.Random( +-- * Constants + results, +-- * Functions +-- getMean, +-- getStandardDeviation +) where + +import qualified Control.Arrow +import Control.Arrow((&&&),(***)) +import qualified Data.Foldable +import qualified Data.List +import qualified Data.Map +import qualified System.Random +import qualified Test.QuickCheck +import qualified ToolShed.System.Random + +-- | Determines the /mean/ of the specified numbers +getMean :: (Data.Foldable.Foldable f, Real r, Fractional result) => f r -> result +getMean = uncurry (/) . (realToFrac *** fromIntegral) . Data.Foldable.foldr (\i -> (+ i) *** succ) (0, 0 :: Int) + +-- | Find the standard-deviation of the specified list. +getStandardDeviation :: (Data.Foldable.Foldable f, Functor f, Real r) => f r -> Double +getStandardDeviation x = sqrt . getMean $ fmap ((^ (2 :: Int)) . (+ negate (getMean x :: Rational)) . toRational) x + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_shuffle, + Test.QuickCheck.quickCheckResult prop_shuffleDistribution + ] where + prop_shuffle :: Int -> Int -> Test.QuickCheck.Property + prop_shuffle seed l = Test.QuickCheck.label "prop_shuffle" . (== testList) . Data.List.sort $ ToolShed.System.Random.shuffle (System.Random.mkStdGen seed) testList where + testList = [0 .. l `mod` 10000] + + prop_shuffleDistribution :: Int -> Test.QuickCheck.Property + prop_shuffleDistribution = Test.QuickCheck.label "prop_shuffleDistribution" . all ( + uncurry (&&) . ( + ( + < recip 20 {-empirically-} -- The ideal value for a uniform distribution, would be zero. + ) . ( + / getStandardDeviation (populationSize : replicate (pred $ length testList) 0) -- Normalise wrt the worst-case; which occurs when this column contains the same letter, for each test-case in the population. + ) . getStandardDeviation &&& ( + == populationSize -- Confirm the size of the test-data. + ) . Data.Foldable.sum + ) + ) . map ( + foldr ( + uncurry $ Data.Map.insertWith (+) + ) ( + Data.Map.fromList . zip testList $ repeat (0 :: Int) -- Initial value. + ) . (`zip` repeat 1) -- Count the instances of each letter in this column, which for a uniform distribution, should be approximately the same. + ) . Data.List.transpose {-examine the columns-} . take populationSize . map fst {-shuffled digits-} . tail {-drop initial value-} . iterate ( + Control.Arrow.first (`ToolShed.System.Random.shuffle` testList) . System.Random.split . snd + ) . (,) undefined . System.Random.mkStdGen where + testList :: String + testList = ['a' .. 'z'] + + populationSize :: Int + populationSize = 1000 + diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,84 +0,0 @@ -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Contains the entry-point to the program. - - * Facilitates testing. --} - -module Main(main) where - -import qualified Data.List -import qualified Data.Version -import qualified Distribution.Package -import qualified Distribution.Text -import qualified Distribution.Version -import qualified Paths_toolshed as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'. -import qualified System.Console.GetOpt as G -import qualified System.Environment -import qualified System.Exit -import qualified System.IO -import qualified System.IO.Error -import qualified ToolShed.Test.QuickChecks - --- | Used to thread user-defined command-line options, though the list of functions which implement them. -type CommandLineAction = () -> IO () -- Supplied as the type-argument to 'G.OptDescr'. - --- | Parses the command-line arguments, to determine 'Test.CommandOptions.CommandOptions'. -main :: IO () -main = do - System.IO.hClose System.IO.stdin -- Nothing is read from standard input. - - progName <- System.Environment.getProgName - - let - usageMessage :: String - usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList - --- Define the command-line options, and the 'CommandLineAction's used to handle them. - optDescrList :: [G.OptDescr CommandLineAction] - optDescrList = [ --- String [String] (G.ArgDescr CommandLineAction) String - G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help-text & then exit.", - G.Option "" ["version"] (G.NoArg $ const printVersion) "Print version-information & then exit.", - G.Option "q" ["runQuickChecks"] (G.NoArg $ const runQuickChecks) "Run Quick-checks using arbitrary data & then exit." - ] where - printVersion, printUsage, runQuickChecks :: IO () - printVersion = System.IO.hPutStrLn System.IO.stderr (Distribution.Text.display packageIdentifier ++ "\n\nCopyright (C) 2010-2013 " ++ author ++ ".\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by " ++ author ++ ".") >> System.Exit.exitWith System.Exit.ExitSuccess where - packageIdentifier :: Distribution.Package.PackageIdentifier - packageIdentifier = Distribution.Package.PackageIdentifier { - Distribution.Package.pkgName = Distribution.Package.PackageName progName, -- CAVEAT: coincidentally. - Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] - } - - author :: String - author = "Dr. Alistair Ward" - - printUsage = System.IO.hPutStrLn System.IO.stderr usageMessage >> System.Exit.exitWith System.Exit.ExitSuccess - runQuickChecks = ToolShed.Test.QuickChecks.run >> System.Exit.exitWith System.Exit.ExitSuccess - - args <- System.Environment.getArgs - --- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr Action] -> [String] -> ([Action], [String], [String]) - case G.getOpt G.RequireOrder optDescrList args of - (commandLineActions, _, []) -> Data.List.foldl' (>>=) (return {-to IO-monad-} ()) commandLineActions >> System.Exit.exitWith System.Exit.ExitSuccess - (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concat errors ++ usageMessage -- Throw. - diff --git a/src/ToolShed/Data/Foldable.hs b/src/ToolShed/Data/Foldable.hs deleted file mode 100644 --- a/src/ToolShed/Data/Foldable.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous polymorphic operations on 'Data.Foldable.Foldable' types. --} - -module ToolShed.Data.Foldable( --- * Functions - gather, - gatherBy, --- ** Predicates - hasDuplicates -) where - -import Control.Arrow((&&&)) -import qualified Data.Foldable -import qualified Data.Map - -{- | - * Group equal (though not necessarily adjacent; cf. 'Data.List.groupBy') elements, according to the specified comparator. - - * The groups are returned in ascending order, whilst their elements remain in their original order. --} -gatherBy :: (Data.Foldable.Foldable f, Ord b) => (a -> b) -> f a -> [[a]] -gatherBy f = Data.Map.elems . Data.Foldable.foldr (uncurry (Data.Map.insertWith (++)) . (f &&& return {-to List-monad-})) Data.Map.empty - --- | A specific instance of 'gatherBy'. -gather :: (Data.Foldable.Foldable f, Ord a) => f a -> [[a]] -gather = gatherBy id - --- | Whether the specified collection contains any equal items. -hasDuplicates :: (Data.Foldable.Foldable f, Ord a) => f a -> Bool -hasDuplicates = any ((> 1) . length) . gather - diff --git a/src/ToolShed/Data/List.hs b/src/ToolShed/Data/List.hs deleted file mode 100644 --- a/src/ToolShed/Data/List.hs +++ /dev/null @@ -1,203 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous polymorphic list-operations. --} - -module ToolShed.Data.List( --- * Types --- ** Type-synonyms - ChunkLength, - Matches, --- * Functions - chunk, - excise, - equalityBy, - findConvergence, - findConvergenceBy, - linearise, - merge, - mergeBy, - nub', --- nubWithInt, - permutations, - permutationsBy, - takeUntil, - showListWith, --- showListWithChar, --- showListWithString -) where - -import qualified Control.Arrow -import Control.Arrow((&&&)) -import qualified Data.IntSet -import qualified Data.List -import qualified Data.Set - --- | The length of the chunks into which a list is split. -type ChunkLength = Int - -{- | - * Splits a list into chunks of the specified length. - - * The last chunk will be shorter, if the chunk-length isn't an aliquot part of the input list-length. - - * If the chunk-length is zero, the resulting list will be an infinite sequence of null lists. - - * CAVEAT: a similar function is available in the module /Data.List.Split/, though this one checks for @(chunkLength < 0)@. --} -chunk - :: ChunkLength - -> [a] -- ^ The polymorphic input list to be chunked. - -> [[a]] -chunk size list - | size < 0 = error $ "ToolShed.Data.List.chunk:\tnegative chunk-size=" ++ show size - | otherwise = chunk' list - where - chunk' :: [a] -> [[a]] - chunk' [] = [] - chunk' a = uncurry (:) . Control.Arrow.second chunk' $ splitAt size a - --- | Remove the single indexed element from the list. -excise - :: Int -- ^ The index. - -> [a] -- ^ The polymorphic input list. - -> [a] -- ^ The same list, with the indexed element removed. -excise 0 = tail -- Just for efficiency. -excise i = uncurry (++) . Control.Arrow.second tail . splitAt i - --- | The type of function required by 'findConvergenceBy', 'permutationsBy'. -type Matches a = a -> a -> Bool - --- | A convenient way to compose the 'Matches'-function required by 'findConvergenceBy' & 'permutationsBy'. -equalityBy :: Eq b => (a -> b) -> Matches a -equalityBy f x y = f x == f y - --- | Take the first element from the (potentially infinite) list, which matches the subsequent element, according to the specified function. -findConvergenceBy :: Matches a -> [a] -> a -findConvergenceBy _ [] = error "ToolShed.Data.List.findConvergenceBy:\ta null list is too short for convergence to exist" -findConvergenceBy _ [_] = error "ToolShed.Data.List.findConvergenceBy:\ta singleton list is too short for convergence to exist" -findConvergenceBy matches l - | null l' = error "ToolShed.Data.List.findConvergenceBy:\tno convergence found" - | otherwise = fst $ head l' - where - l' = dropWhile (not . uncurry matches) . uncurry zip $ (init &&& tail) l - --- | A specific instance of 'findConvergenceBy'. -findConvergence :: Eq a => [a] -> a -findConvergence = findConvergenceBy (==) - -{- | - * The list of all permutations, generated by selecting any one datum from each sub-list in turn, from the specified list of lists. - - * As each item is selected, the remaining lists are filtered according to the specified 'Matches'-function. - - * Thus '/=' could be used to select a different item from each list. --} -permutationsBy :: Matches a -> [[a]] -> [[a]] -permutationsBy matches lists - | any null lists = [] -- Required for efficiency, to catch the case [bigList1, bigList2 ... null] - | otherwise = slave lists - where - slave (xs : xss) = [x : xs' | x <- xs, xs' <- slave $ map (filter $ matches x) xss] - slave [] = [[]] - -{- | - * The list of all permutations, generated by selecting any one datum from each sub-list in turn, from the specified list of lists. - - * A specific instance of 'permutationsBy', in which no filtering of subsequent lists is performed after each item is selected. - - * NB: differs from 'Data.List.permutations', which selects items from a single input list. --} -permutations :: [[a]] -> [[a]] -permutations = permutationsBy (\_ _ -> True) - -{-# NOINLINE nub' #-} -{-# RULES "nub'/Int" nub' = nubWithInt #-} - -{- | - * A strict version of 'Data.List.nub' with better time-complexity. - - * CAVEAT: the specified list must be finite, since the entire set is constructed before streaming to a list. - - * CAVEAT: it sorts the output as a side-effect, & consequently it requires a type which implements 'Ord'. --} -nub' :: Ord a => [a] -> [a] -nub' = Data.Set.toList . Data.Set.fromList - --- | A specialisation for type 'Int'. -nubWithInt :: [Int] -> [Int] -nubWithInt = Data.IntSet.toList . Data.IntSet.fromList - --- | Converts a list of /Pairs/, into a narrower list. -linearise :: [(a, a)] -> [a] -linearise [] = [] -linearise ((l, r) : remainder) = l : r : linearise remainder -- Recurse. - -{- | - * Merge two sorted lists, according to the specified order, to product a single sorted list. - - * The merge-process is /stable/, in that where items from each list are equal, they remain in the original order. - - * CAVEAT: duplicates are preserved. --} -mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -mergeBy cmp = slave where - slave l@(x : xs) r@(y : ys) - | x `cmp` y == GT = y : slave l ys - | otherwise = x : slave xs r - slave [] r = r - slave l [] = l - --- | A specific instance of 'mergeBy'. -merge :: Ord a => [a] -> [a] -> [a] -merge = mergeBy compare - -{- | - * Take until the specified predicate is satisfied; /including/ the item which satisfied it. - - * NB: @takeWhile (not . test)@ would return one fewer item. --} -takeUntil - :: (a -> Bool) -- ^ Predicate, used to determine the last item taken. - -> [a] -- ^ The polymorphic input list. - -> [a] -takeUntil predicate = takeUntil' where - takeUntil' (x : xs) = x {-take regardless-} : if predicate x then [] else takeUntil' xs - takeUntil' _ = [] - --- | Show a list, delimited by the specified tokens. -showListWith :: (Show token, Show element) - => (token, token, token) -- ^ (Start-delimiter, separator, end-delimiter) - -> [element] -- ^ The polymorphic list to show. - -> ShowS -showListWith (startDelimiter, separator, endDelimiter) = foldr (.) (shows endDelimiter) . (shows startDelimiter :) . Data.List.intersperse (shows separator) . map shows - -{-# NOINLINE showListWith #-} -{-# RULES "showListWith/Char" showListWith = showListWithChar #-} -{-# RULES "showListWith/String" showListWith = showListWithString #-} - --- | A specialisation of 'showListWith'. -showListWithChar :: Show element => (Char, Char, Char) -> [element] -> ShowS -showListWithChar (startDelimiter, separator, endDelimiter) = foldr (.) (showChar endDelimiter) . (showChar startDelimiter :) . Data.List.intersperse (showChar separator) . map shows - --- | A specialisation of 'showListWith'. -showListWithString :: Show element => (String, String, String) -> [element] -> ShowS -showListWithString (startDelimiter, separator, endDelimiter) = foldr (.) (showString endDelimiter) . (showString startDelimiter :) . Data.List.intersperse (showString separator) . map shows - diff --git a/src/ToolShed/Data/List/Runlength.hs b/src/ToolShed/Data/List/Runlength.hs deleted file mode 100644 --- a/src/ToolShed/Data/List/Runlength.hs +++ /dev/null @@ -1,56 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Run-length encoder and decoder. --} - -module ToolShed.Data.List.Runlength( --- * Types --- ** Type-synonyms - Code, --- * Functions - encode, - decode, --- ** Accessors - getLength, - getDatum -) where - -import Control.Arrow((&&&)) -import qualified Data.List - --- | Describes the number of consecutive equal items in a list. -type Code a = (Int, a) - --- | Accessor. -getLength :: Code a -> Int -getLength = fst - --- | Accessor. -getDatum :: Code a -> a -getDatum = snd - --- | /Run-length/ encodes the specified list. -encode :: Eq a => [a] -> [Code a] -encode = map (length &&& head) . Data.List.group - --- | Performs /run-length/ decoding to retrieve the original unencoded list. -decode :: [Code a] -> [a] -decode = concatMap (uncurry replicate) - diff --git a/src/ToolShed/Data/List/Splits.hs b/src/ToolShed/Data/List/Splits.hs deleted file mode 100644 --- a/src/ToolShed/Data/List/Splits.hs +++ /dev/null @@ -1,66 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] --} - -module ToolShed.Data.List.Splits( --- * Types --- ** Type-synonyms --- Split, --- * Functions --- splitsFrom, - splitsLeftFrom, - splitsRightFrom -) where - --- | The polymorphic pair, resulting from splitting a list of arbitrary type. -type Split a = ([a] {-left list-}, [a] {-right list-}) - --- | Use the specified transformation, to generate a list of 'Split's, from the initial one. -splitsFrom - :: (Split a -> Split a) -- ^ The function used to transform one /split/ into the next. - -> Int -- ^ Index. - -> [a] -- ^ The polymorphic input list from which the /splits/ are generated. - -> [Split a] -- ^ The list of all required splits of the single input list. -splitsFrom transformation i - | i < 0 = error $ "ToolShed.Data.List.Splits.splitsFrom:\tnegative starting-index; " ++ show i - | otherwise = iterate transformation . splitAt i - -{- | - * Create the set of all 'Split's, migrating left from the specified location. - - * CAVEAT: 'init' fails when 'fst' has been reduced to null. --} -splitsLeftFrom - :: Int -- ^ Index. - -> [a] -- ^ The polymorphic input list from which the /splits/ are generated, as the index is stepped left - -> [Split a] -- ^ The list of all required splits of the single input list. -splitsLeftFrom = splitsFrom (\(l, r) -> (init l, last l : r)) - -{- | - * Create the set of all 'Split's, migrating right from the specified location. - - * CAVEAT: pattern-match against @ : @ fails, when 'snd' has been reduced to 'null'. --} -splitsRightFrom - :: Int -- ^ Index. - -> [a] -- ^ The polymorphic input list from which the /splits/ are generated, as the index is stepped right. - -> [Split a] -- ^ The list of all required splits of the single input list. -splitsRightFrom = splitsFrom (\(l, r : rs) -> (l ++ [r], rs)) diff --git a/src/ToolShed/Data/Pair.hs b/src/ToolShed/Data/Pair.hs deleted file mode 100644 --- a/src/ToolShed/Data/Pair.hs +++ /dev/null @@ -1,37 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous operations on Pairs. --} - -module ToolShed.Data.Pair( --- * Functions - mirror -) where - -import Control.Arrow((***)) - -{- | - * Apply the same transformation to both halves of a /Pair/. - - * CAVEAT: even though the function may be polymorphic, the pair is required to have identical types. --} -mirror :: (a -> b) -> (a, a) -> (b, b) -mirror f = f *** f - diff --git a/src/ToolShed/Data/Quadruple.hs b/src/ToolShed/Data/Quadruple.hs deleted file mode 100644 --- a/src/ToolShed/Data/Quadruple.hs +++ /dev/null @@ -1,59 +0,0 @@ -{- - Copyright (C) 2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous operations on quadruples. - - [@CAVEAT@] Import fully qualified, since some identifiers clash with 'ToolShed.Data.Triple'. --} - -module ToolShed.Data.Quadruple( --- * Functions - curry4, - uncurry4, --- ** Accessors - getFirst, - getSecond, - getThird, - getFourth -) where - --- | Extends the concept of 'Data.Tuple.curry'. -curry4 :: ((a, b, c, d) -> result) -> a -> b -> c -> d -> result -curry4 f a b c d = f (a, b, c, d) - --- | Extends the concept of 'Data.Tuple.uncurry'. -uncurry4 :: (a -> b -> c -> d -> result) -> (a, b, c, d) -> result -uncurry4 f (a, b, c, d) = f a b c d - --- | Access the first datum from the specified quadruple. -getFirst :: (a, b, c, d) -> a -getFirst (a, _, _, _) = a - --- | Access the second datum from the specified quadruple. -getSecond :: (a, b, c, d) -> b -getSecond (_, b, _, _) = b - --- | Access the third datum from the specified quadruple. -getThird :: (a, b, c, d) -> c -getThird (_, _, c, _) = c - --- | Access the fourth datum from the specified quadruple. -getFourth :: (a, b, c, d) -> d -getFourth (_, _, _, d) = d - diff --git a/src/ToolShed/Data/Triple.hs b/src/ToolShed/Data/Triple.hs deleted file mode 100644 --- a/src/ToolShed/Data/Triple.hs +++ /dev/null @@ -1,54 +0,0 @@ -{- - Copyright (C) 2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous operations on triples. - - [@CAVEAT@] Import fully qualified, since some identifiers clash with 'ToolShed.Data.Quadruple'. --} - -module ToolShed.Data.Triple( --- * Functions - curry3, - uncurry3, --- ** Accessors - getFirst, - getSecond, - getThird -) where - --- | Extends the concept of 'Data.Tuple.curry'. -curry3 :: ((a, b, c) -> result) -> a -> b -> c -> result -curry3 f a b c = f (a, b, c) - --- | Extends the concept of 'Data.Tuple.uncurry'. -uncurry3 :: (a -> b -> c -> result) -> (a, b, c) -> result -uncurry3 f (a, b, c) = f a b c - --- | Access the first datum from the specified triple. -getFirst :: (a, b, c) -> a -getFirst (a, _, _) = a - --- | Access the second datum from the specified triple. -getSecond :: (a, b, c) -> b -getSecond (_, b, _) = b - --- | Access the third datum from the specified triple. -getThird :: (a, b, c) -> c -getThird (_, _, c) = c - diff --git a/src/ToolShed/Defaultable.hs b/src/ToolShed/Defaultable.hs deleted file mode 100644 --- a/src/ToolShed/Defaultable.hs +++ /dev/null @@ -1,36 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] A simple interface which data-types with a default-value can implement. --} - -module ToolShed.Defaultable( --- * Type-classes - Defaultable(..) -) where - --- | An interface to which data which have a default-value can adhere. -class Defaultable a where - defaultValue :: a -- ^ The default value of the data-type. - -instance (Defaultable a, Defaultable b) => Defaultable (a, b) where - defaultValue = (defaultValue, defaultValue) - -instance (Defaultable a, Defaultable b, Defaultable c) => Defaultable (a, b, c) where - defaultValue = (defaultValue, defaultValue, defaultValue) diff --git a/src/ToolShed/Options.hs b/src/ToolShed/Options.hs deleted file mode 100644 --- a/src/ToolShed/Options.hs +++ /dev/null @@ -1,32 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a standard interface to which various options-related data can conform. --} - -module ToolShed.Options( --- * Type-classes - Options(..) -) where - -import qualified ToolShed.Defaultable - --- | Similar to the class 'Text.Regex.Base.RegexLike.RegexOptions'. -class ToolShed.Defaultable.Defaultable a => Options a where - blankValue :: a -- ^ The /undefined/ state of the data-type, which may be literal, but could alternatively be a logical starting value. diff --git a/src/ToolShed/SelfValidate.hs b/src/ToolShed/SelfValidate.hs deleted file mode 100644 --- a/src/ToolShed/SelfValidate.hs +++ /dev/null @@ -1,75 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] A class to define the simple interface, to which data which can self-validation, should conform. --} - -module ToolShed.SelfValidate( --- * Type-classes - SelfValidator(..), --- ** Functions - getFirstError, - extractErrors -) where - -import qualified Data.Array.IArray -import qualified Data.Map -import qualified Data.Set - --- | The interface to which data which can self-validate should conform. -class SelfValidator v where - getErrors :: v -> [String] -- ^ Return either null, or the reasons why the data is invalid. - - isValid :: v -> Bool -- ^ The data which implements this interface should return 'True' if internally consistent. - isValid = null . getErrors -- Default implementation. - -instance (SelfValidator v) => SelfValidator (Maybe v) where - getErrors (Just v) = getErrors v - getErrors _ = [] - -instance (SelfValidator a, SelfValidator b) => SelfValidator (a, b) where - getErrors (x, y) = getErrors x ++ getErrors y - -instance (SelfValidator a, SelfValidator b, SelfValidator c) => SelfValidator (a, b, c) where - getErrors (x, y, z) = getErrors x ++ getErrors y ++ getErrors z - -instance SelfValidator v => SelfValidator [v] where - getErrors = concatMap getErrors - -instance SelfValidator v => SelfValidator (Data.Set.Set v) where - getErrors = Data.Set.foldr ((++) . getErrors) [] - -instance SelfValidator v => SelfValidator (Data.Map.Map k v) where - getErrors = Data.Map.foldr ((++) . getErrors) [] - -instance (Data.Array.IArray.Ix index, SelfValidator element) => SelfValidator (Data.Array.IArray.Array index element) where - getErrors = concatMap getErrors . Data.Array.IArray.elems - --- | Returns the first error only (so only call on failure of 'isValid'), since subsequent tests may be based on invalid data. -getFirstError :: SelfValidator v => v -> String -getFirstError selfValidator - | null errors = error "ToolShed.SelfValidate.getFirstError:\tzero errors ?!" - | otherwise = head errors - where - errors = getErrors selfValidator - --- | Extracts the failed tests from those specified. -extractErrors :: [(Bool, String)] -> [String] -extractErrors = map snd . filter fst - diff --git a/src/ToolShed/System/File.hs b/src/ToolShed/System/File.hs deleted file mode 100644 --- a/src/ToolShed/System/File.hs +++ /dev/null @@ -1,106 +0,0 @@ - -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] File-operations. --} - -module ToolShed.System.File( --- * Types --- ** Type-synonyms - SearchPath, - LocatedData, --- * Functions - locate, - getFile, - fromFile, --- ** Accessors - getFilePath, - getData -) where - -import qualified Control.Exception -import qualified Control.Monad -import qualified Data.List -import qualified System.Directory -import qualified System.FilePath -import System.FilePath(()) -import qualified System.IO.Error - --- | The ordered sequence of directories, searched for a file. -type SearchPath = [System.FilePath.FilePath] - -{- | - * When supplied with an /absolute/ file-path, the /search-path/ is ignored and an exception is thrown if either the file-path is invalid or the file doesn't exist. - - * If the specified file-name is /relative/, all matching instances on the specified /search-path/ are returned. - - * CAVEAT: doesn't perform file-globbing. --} -locate :: System.FilePath.FilePath -> SearchPath -> IO [System.FilePath.FilePath] -locate fileName searchPath - | System.FilePath.isRelative fileName' = Control.Monad.filterM System.Directory.doesFileExist . filter System.FilePath.isValid . Data.List.nubBy System.FilePath.equalFilePath $ map (System.FilePath.normalise . ( fileName')) searchPath - | not $ System.FilePath.isValid fileName' = Control.Exception.throwIO . System.IO.Error.userError $ "Invalid filename; " ++ fileName' - | otherwise = do - fileExists <- System.Directory.doesFileExist fileName' - - if not fileExists - then Control.Exception.throwIO . System.IO.Error.mkIOError System.IO.Error.doesNotExistErrorType "No such file" Nothing $ Just fileName' - else return {-to IO-monad-} [fileName'] - where - fileName' = System.FilePath.normalise fileName - --- | A file-path, and the contents read from it. -type LocatedData a = (System.FilePath.FilePath, a) - --- | Accessor. -getFilePath :: LocatedData a -> System.FilePath.FilePath -getFilePath = fst - --- | Accessor. -getData :: LocatedData a -> a -getData = snd - -{- | - Traverse the /search-path/, looking for matching instances of the specified file-name, - and either throw an exception, or return a pair composed from the path to the first matching file, together with its contents. --} -getFile :: System.FilePath.FilePath -> SearchPath -> IO (LocatedData String) -getFile fileName directories = do - filePaths <- locate fileName directories - - if null filePaths - then Control.Exception.throwIO . System.IO.Error.mkIOError System.IO.Error.doesNotExistErrorType ("Can't find in " ++ show directories) Nothing $ Just fileName - else {-located-} let - filePath = head filePaths -- Discard any subsequent paths. - in (,) filePath `fmap` readFile filePath - -{- | - * Returns the polymorphic data, read from the first matching file on the /search-path/, along with the path from which it was read. - - * Returns an error on failure to parse the contents of the first matching file found on the /search-path/. --} -fromFile :: Read a => System.FilePath.FilePath -> SearchPath -> IO (LocatedData a) -fromFile fileName directories = do - (filePath, fileContents) <- getFile fileName directories - - case reads fileContents of - [(x, _)] -> return {-to IO-monad-} (filePath, x) -- CAVEAT: discards any unconsumed text. - _ -> fail $ "ToolShed.System.File.fromFile:\tfailed to parse file=" ++ show filePath - diff --git a/src/ToolShed/System/Random.hs b/src/ToolShed/System/Random.hs deleted file mode 100644 --- a/src/ToolShed/System/Random.hs +++ /dev/null @@ -1,83 +0,0 @@ - -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Utilities related to random-numbers. --} - -module ToolShed.System.Random( --- * Functions - randomGens, - shuffle, - generateSelection, - generateSelectionFromBounded, - select -) where - -import qualified Control.Arrow -import qualified Data.Sequence -import Data.Sequence((><), ViewL((:<))) -import qualified System.Random - --- | Constructs an infinite list of independent random-generators. -randomGens :: System.Random.RandomGen randomGen => randomGen -> [randomGen] -randomGens = uncurry (:) . Control.Arrow.second randomGens {-recurse-} . System.Random.split - -{- | - * Shuffles the specified finite list, using the /Fisher-Yates/ algorithm; . - - * The resulting list has the same length and constituents as the original; only the order has changed. - - * The input list is traversed, but the items aren't evaluated. --} -shuffle :: System.Random.RandomGen randomGen => randomGen -> [a] -> [a] -shuffle _ [] = [] -- Not strictly necessary. -shuffle _ singleton@[_] = singleton -- Not strictly necessary. -shuffle randomGen l = slave randomGen s (pred $ Data.Sequence.length s) where - s = Data.Sequence.fromList l - - slave randomGen' s' maxIndex - | maxIndex < 0 = [] - | otherwise = selection : slave randomGen'' (first >< remainder) (pred maxIndex) {-recurse-} - where - (randomIndex, randomGen'') = System.Random.randomR (0, maxIndex) randomGen' - (first, selection :< remainder) = Control.Arrow.second Data.Sequence.viewl $ Data.Sequence.splitAt randomIndex s' - -{- | - * Generate an infinite list of items, each independently randomly selected from the specified finite list. - - * CAVEAT: because the selections are made non-destructively, duplicates may be returned; cf. 'shuffle'. --} -generateSelection :: System.Random.RandomGen randomGen => randomGen -> [a] -> [a] -generateSelection _ [] = error "ToolShed.System.Random.generateSelection:\tnull list" -generateSelection _ [x] = repeat x -- Not strictly necessary, but more efficient. -generateSelection randomGen l = map (l !!) $ System.Random.randomRs (0, pred $ length l) randomGen - --- | Return a randomly selected element from the specified list. -select :: System.Random.RandomGen randomGen => randomGen -> [a] -> a -select randomGen = head . generateSelection randomGen - -{- | - * Generate an infinite list of data, each independently selected random instances of the specified /bounded/ type. - - * E.g. @ (generateSelectionFromBounded `fmap` System.Random.getStdGen) :: IO [Bool] @. --} -generateSelectionFromBounded :: (System.Random.RandomGen randomGen, Bounded a, System.Random.Random a) => randomGen -> [a] -generateSelectionFromBounded = System.Random.randomRs (minBound, maxBound) - diff --git a/src/ToolShed/System/TimeAction.hs b/src/ToolShed/System/TimeAction.hs deleted file mode 100644 --- a/src/ToolShed/System/TimeAction.hs +++ /dev/null @@ -1,49 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Determines the CPU-time, required to evaluate the specified IO-action. - --} - -module ToolShed.System.TimeAction( --- * Functions - getCPUSeconds, - printCPUSeconds -) where - -import qualified System.CPUTime -import qualified System.IO - --- | Time the specified IO-action, returning the required number of CPU-seconds and the result, as a 'Pair'. -getCPUSeconds :: Fractional seconds => IO result -> IO (seconds, result) -getCPUSeconds action = do - startTime <- System.CPUTime.getCPUTime - result <- action - endTime <- System.CPUTime.getCPUTime - - return {-to IO-monad-} (fromInteger (endTime - startTime) / 1e12 {-convert from pico-seconds-}, result) - --- | Print the time required by the specified IO-action. -printCPUSeconds :: IO result -> IO result -printCPUSeconds action = do - (cpuSeconds, result) <- getCPUSeconds action - - System.IO.hPutStrLn System.IO.stderr $ "CPU-seconds:\t" ++ show (cpuSeconds :: Double) - - return {-to IO-monad-} result diff --git a/src/ToolShed/System/TimePure.hs b/src/ToolShed/System/TimePure.hs deleted file mode 100644 --- a/src/ToolShed/System/TimePure.hs +++ /dev/null @@ -1,60 +0,0 @@ -{- - Copyright (C) 2010 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Determines the CPU-time, required to evaluate the specified pure expression. - --} - -module ToolShed.System.TimePure( --- * Functions - getCPUSeconds, - printCPUSeconds -) where - -import qualified Control.DeepSeq -import qualified System.CPUTime -import qualified System.IO - -{- | - * Time the specified pure expression, returning the required number of CPU-seconds and the result, as a 'Pair'. - - * CAVEAT: as a side-effect, the expression is /deep/ evaluated. --} -getCPUSeconds :: (Fractional seconds, Control.DeepSeq.NFData expression) - => expression -- ^ Arbitrary polymorphic expression. - -> IO (seconds, expression) -- ^ The original expression, tagged with the CPU-seconds taken. -getCPUSeconds expression = do - start <- System.CPUTime.getCPUTime - end <- expression `Control.DeepSeq.deepseq` System.CPUTime.getCPUTime - - return {-to IO-monad-} (fromInteger (end - start) / 1e12 {-convert from pico-seconds-}, expression) - -{- | - * Print the time required by the specified pure expression. - - * CAVEAT: as a side-effect, the expression is /deep/ evaluated. --} -printCPUSeconds :: Control.DeepSeq.NFData expression => expression -> IO expression -printCPUSeconds expression = do - (cpuSeconds, result) <- getCPUSeconds expression - - System.IO.hPutStrLn System.IO.stderr $ "CPU-seconds:\t" ++ show (cpuSeconds :: Double) - - return {-to IO-monad-} result - diff --git a/src/ToolShed/Test/Data/Foldable.hs b/src/ToolShed/Test/Data/Foldable.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/Foldable.hs +++ /dev/null @@ -1,48 +0,0 @@ -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Foldable". --} - -module ToolShed.Test.Data.Foldable( --- * Functions - quickChecks -) where - -import qualified Data.List -import qualified Data.Ord -import qualified Data.Set -import qualified ToolShed.Data.Foldable -import qualified ToolShed.Data.List -import qualified Test.QuickCheck - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_gatherSet >> Test.QuickCheck.quickCheck prop_gatherBy where - prop_gatherSet :: Int -> Test.QuickCheck.Property - prop_gatherSet n = Test.QuickCheck.label "prop_gatherSet" . (== l) . concat . ToolShed.Data.Foldable.gather $ Data.Set.fromDistinctAscList l where - l = [0 .. n `mod` 1024] - - prop_gatherBy :: [Int] -> Test.QuickCheck.Property - prop_gatherBy l = Test.QuickCheck.label "prop_gatherBy" $ map Data.List.sort ( - ToolShed.Data.Foldable.gatherBy even l - ) == ( - map Data.List.sort . Data.List.groupBy (ToolShed.Data.List.equalityBy even) $ Data.List.sortBy (Data.Ord.comparing even) l - ) - diff --git a/src/ToolShed/Test/Data/List.hs b/src/ToolShed/Test/Data/List.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/List.hs +++ /dev/null @@ -1,73 +0,0 @@ -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List". --} - -module ToolShed.Test.Data.List( --- * Functions - quickChecks -) where - -import qualified Data.List -import qualified ToolShed.Data.List -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = - Test.QuickCheck.quickCheck prop_chunk - >> Test.QuickCheck.quickCheck `mapM` [prop_findConvergence, prop_permutationsBy'] - >> Test.QuickCheck.quickCheck prop_nub - >> Test.QuickCheck.quickCheck `mapM` [prop_permutations, prop_permutations', prop_permutationsBy] - >> Test.QuickCheck.quickCheck prop_linearise - >> Test.QuickCheck.quickCheck prop_merge - where - prop_chunk :: Int -> [Int] -> Test.QuickCheck.Property - prop_chunk i l = Test.QuickCheck.label "prop_chunk" $ concat (ToolShed.Data.List.chunk (succ $ abs i) l) == l - - prop_findConvergence :: Int -> Test.QuickCheck.Property - prop_findConvergence = Test.QuickCheck.label "prop_findConvergence" . (== 0) . ToolShed.Data.List.findConvergence . iterate (fst . (`quotRem` 2)) - - prop_nub :: [Int] -> Test.QuickCheck.Property - prop_nub x = Test.QuickCheck.label "prop_nub" $ ToolShed.Data.List.nub' x == Data.List.sort (Data.List.nub x) - - prop_permutations, prop_permutations', prop_permutationsBy :: [[Int]] -> Test.QuickCheck.Property - prop_permutations l = not (null l') ==> Test.QuickCheck.label "prop_permutations" $ length (ToolShed.Data.List.permutations l') == product (map length l') where - l' = take 6 $ map (take 6) l -- Limit the task. - - prop_permutations' l = not (null l') && all (not . null) l' ==> Test.QuickCheck.label "prop_permutations'" . (== 1) . length . Data.List.nub . map length $ ToolShed.Data.List.permutations l' where - l' = take 7 $ map (take 5) l -- Limit the task. - - prop_permutationsBy l = and [not $ null l', all (not . null) l', not $ null permutations] ==> Test.QuickCheck.label "prop_permutationsBy" . (== 1) . length . Data.List.nub $ map (length . Data.List.nub) permutations where - l' = take 8 $ map (take 4) l -- Limit the task. - permutations = ToolShed.Data.List.permutationsBy (/=) l' - - prop_permutationsBy' :: Int -> Test.QuickCheck.Property - prop_permutationsBy' i = Test.QuickCheck.label "prop_permutationsBy'" . all ((== range) . Data.List.sort) . ToolShed.Data.List.permutationsBy (/=) $ replicate (succ i') range where - i' = succ $ mod i 7 - range = [0 .. i'] - - prop_linearise :: [(Int, Int)] -> Test.QuickCheck.Property - prop_linearise l = Test.QuickCheck.label "prop_linearise" $ map (\[x, y] -> (x, y)) (ToolShed.Data.List.chunk 2 $ ToolShed.Data.List.linearise l) == l - - prop_merge :: [Int] -> [Int] -> Test.QuickCheck.Property - prop_merge x y = Test.QuickCheck.label "prop_merge" $ ToolShed.Data.List.merge (Data.List.sort x) (Data.List.sort y) == Data.List.sort (x ++ y) - diff --git a/src/ToolShed/Test/Data/List/Runlength.hs b/src/ToolShed/Test/Data/List/Runlength.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/List/Runlength.hs +++ /dev/null @@ -1,36 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List.Runlength". --} - -module ToolShed.Test.Data.List.Runlength( --- * Functions - quickChecks -) where - -import qualified ToolShed.Data.List.Runlength -import qualified Test.QuickCheck - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_runLength where - prop_runLength :: [Int] -> Test.QuickCheck.Property - prop_runLength l = Test.QuickCheck.label "prop_runLength" $ ToolShed.Data.List.Runlength.decode (ToolShed.Data.List.Runlength.encode l) == l - diff --git a/src/ToolShed/Test/Data/List/Splits.hs b/src/ToolShed/Test/Data/List/Splits.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/List/Splits.hs +++ /dev/null @@ -1,40 +0,0 @@ -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.List.Splits". --} - -module ToolShed.Test.Data.List.Splits( --- * Functions - quickChecks -) where - -import Control.Arrow((***)) -import qualified Data.Tuple -import qualified ToolShed.Data.List.Splits -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_splitsFrom where - prop_splitsFrom :: Int -> [Int] -> Test.QuickCheck.Property - prop_splitsFrom i l = not (null l) ==> Test.QuickCheck.label "prop_splitsFrom" $ take n (ToolShed.Data.List.Splits.splitsLeftFrom index l) == take n (map (Data.Tuple.swap . (reverse *** reverse)) . ToolShed.Data.List.Splits.splitsRightFrom (length l - index) $ reverse l) where - index = i `mod` length l - n = succ index diff --git a/src/ToolShed/Test/Data/Quadruple.hs b/src/ToolShed/Test/Data/Quadruple.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/Quadruple.hs +++ /dev/null @@ -1,36 +0,0 @@ -{- - Copyright (C) 2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Quadruple". --} - -module ToolShed.Test.Data.Quadruple( --- * Functions - quickChecks -) where - -import qualified Test.QuickCheck -import qualified ToolShed.Data.Quadruple - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_accessors where - prop_accessors :: (Int, Char, Bool, Float) -> Test.QuickCheck.Property - prop_accessors quadruple = Test.QuickCheck.label "prop_accessors" $ (f ToolShed.Data.Quadruple.getFirst quadruple, f ToolShed.Data.Quadruple.getSecond quadruple, f ToolShed.Data.Quadruple.getThird quadruple, ToolShed.Data.Quadruple.getFourth quadruple) == quadruple where - f = ToolShed.Data.Quadruple.uncurry4 . ToolShed.Data.Quadruple.curry4 diff --git a/src/ToolShed/Test/Data/Triple.hs b/src/ToolShed/Test/Data/Triple.hs deleted file mode 100644 --- a/src/ToolShed/Test/Data/Triple.hs +++ /dev/null @@ -1,37 +0,0 @@ -{- - Copyright (C) 2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.Data.Triple". --} - -module ToolShed.Test.Data.Triple( --- * Functions - quickChecks -) where - -import qualified Test.QuickCheck -import qualified ToolShed.Data.Triple - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_accessors where - prop_accessors :: (Int, Char, Bool) -> Test.QuickCheck.Property - prop_accessors triple = Test.QuickCheck.label "prop_accessors" $ (f ToolShed.Data.Triple.getFirst triple, f ToolShed.Data.Triple.getSecond triple, f ToolShed.Data.Triple.getThird triple) == triple where - f = ToolShed.Data.Triple.uncurry3 . ToolShed.Data.Triple.curry3 - diff --git a/src/ToolShed/Test/QuickCheck/Arbitrary/Array.hs b/src/ToolShed/Test/QuickCheck/Arbitrary/Array.hs deleted file mode 100644 --- a/src/ToolShed/Test/QuickCheck/Arbitrary/Array.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.Array.IArray.Array'. - - [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Array.IArray.Array Char Int))@ - - [@CAVEAT@] An array with arbitrary indices isn't very useful. --} - -module ToolShed.Test.QuickCheck.Arbitrary.Array() where - -import qualified Data.Array.IArray -import qualified Data.Tuple -import qualified Test.QuickCheck - -instance (Data.Array.IArray.Ix i, Enum i, Test.QuickCheck.Arbitrary i, Test.QuickCheck.Arbitrary e) => Test.QuickCheck.Arbitrary (Data.Array.IArray.Array i e) where - arbitrary = do - pair <- Test.QuickCheck.arbitrary {-(i, i)-} - - let - bounds@(lower, upper) - | uncurry (>) pair = Data.Tuple.swap pair - | otherwise = pair - - indices = [lower .. upper] - - (Data.Array.IArray.array bounds . zip indices) `fmap` Test.QuickCheck.vector (length indices) - diff --git a/src/ToolShed/Test/QuickCheck/Arbitrary/ArrayElem.hs b/src/ToolShed/Test/QuickCheck/Arbitrary/ArrayElem.hs deleted file mode 100644 --- a/src/ToolShed/Test/QuickCheck/Arbitrary/ArrayElem.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - Implements 'Test.QuickCheck.Arbitrary' for 'Data.Array.IArray.Array', - where the array-index is required to be a /bounded enumerable/ type. - - [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Array.IArray.Array Data.Int.Int8 Int))@ --} - -module ToolShed.Test.QuickCheck.Arbitrary.ArrayElem() where - -import qualified Data.Array.IArray -import qualified Test.QuickCheck - -instance (Bounded i, Data.Array.IArray.Ix i, Enum i, Test.QuickCheck.Arbitrary e) => Test.QuickCheck.Arbitrary (Data.Array.IArray.Array i e) where - arbitrary = (Data.Array.IArray.array bounds . zip [minBound .. maxBound]) `fmap` Test.QuickCheck.vector (succ $ fromEnum (snd bounds) - fromEnum (fst bounds)) where - bounds = (minBound, maxBound) - diff --git a/src/ToolShed/Test/QuickCheck/Arbitrary/Map.hs b/src/ToolShed/Test/QuickCheck/Arbitrary/Map.hs deleted file mode 100644 --- a/src/ToolShed/Test/QuickCheck/Arbitrary/Map.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.Map.Map'. - - [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Map.Map Char Int))@ --} - -module ToolShed.Test.QuickCheck.Arbitrary.Map() where - -import qualified Data.Map -import qualified Test.QuickCheck - -instance (Ord k, Test.QuickCheck.Arbitrary k, Test.QuickCheck.Arbitrary v) => Test.QuickCheck.Arbitrary (Data.Map.Map k v) where - arbitrary = Data.Map.fromList `fmap` Test.QuickCheck.arbitrary {-[(k, v)]-} - diff --git a/src/ToolShed/Test/QuickCheck/Arbitrary/Set.hs b/src/ToolShed/Test/QuickCheck/Arbitrary/Set.hs deleted file mode 100644 --- a/src/ToolShed/Test/QuickCheck/Arbitrary/Set.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.Set.Set'. - - [@EXAMPLE@] @Test.QuickCheck.sample (Test.QuickCheck.arbitrary :: Test.QuickCheck.Gen.Gen (Data.Set.Set Int))@ --} - -module ToolShed.Test.QuickCheck.Arbitrary.Set() where - -import qualified Data.Set -import qualified Test.QuickCheck - -instance (Ord k, Test.QuickCheck.Arbitrary k) => Test.QuickCheck.Arbitrary (Data.Set.Set k) where - arbitrary = Data.Set.fromList `fmap` Test.QuickCheck.arbitrary {-[k]-} - diff --git a/src/ToolShed/Test/QuickChecks.hs b/src/ToolShed/Test/QuickChecks.hs deleted file mode 100644 --- a/src/ToolShed/Test/QuickChecks.hs +++ /dev/null @@ -1,51 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Calls the /quickChecks/-functions for modules supporting this feature. --} - -module ToolShed.Test.QuickChecks( --- * Functions - run -) where - -import qualified Control.Arrow -import qualified ToolShed.Test.Data.Foldable -import qualified ToolShed.Test.Data.List -import qualified ToolShed.Test.Data.List.Runlength -import qualified ToolShed.Test.Data.List.Splits -import qualified ToolShed.Test.Data.Quadruple -import qualified ToolShed.Test.Data.Triple -import qualified ToolShed.Test.SelfValidate -import qualified ToolShed.Test.System.Random - --- | Run the /quickChecks/-functions for modules supporting this feature. -run :: IO () -run = mapM_ ( - uncurry (>>) . Control.Arrow.first putStrLn - ) [ - ("Data.Foldable", ToolShed.Test.Data.Foldable.quickChecks), - ("Data.List", ToolShed.Test.Data.List.quickChecks), - ("Data.List.Runlength", ToolShed.Test.Data.List.Runlength.quickChecks), - ("Data.List.Splits", ToolShed.Test.Data.List.Splits.quickChecks), - ("Data.Quadruple", ToolShed.Test.Data.Quadruple.quickChecks), - ("Data.Triple", ToolShed.Test.Data.Triple.quickChecks), - ("SelfValidate", ToolShed.Test.SelfValidate.quickChecks), - ("System.Random", ToolShed.Test.System.Random.quickChecks) - ] diff --git a/src/ToolShed/Test/ReversibleBoundedEnum.hs b/src/ToolShed/Test/ReversibleBoundedEnum.hs deleted file mode 100644 --- a/src/ToolShed/Test/ReversibleBoundedEnum.hs +++ /dev/null @@ -1,34 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Facilities testing of custom implementations of 'Enum'. --} - -module ToolShed.Test.ReversibleBoundedEnum( --- * Functions --- ** Predicates - isReversible -) where - --- | Checks that composing 'pred' & 'succ' is equivalent to the identity. -isReversible :: (Bounded r, Eq r, Enum r) => r -> Bool -isReversible r - | r == minBound = pred (succ r) == r - | otherwise = succ (pred r) == r - diff --git a/src/ToolShed/Test/ReversibleEnum.hs b/src/ToolShed/Test/ReversibleEnum.hs deleted file mode 100644 --- a/src/ToolShed/Test/ReversibleEnum.hs +++ /dev/null @@ -1,31 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Facilities testing of custom implementations of 'Enum'. --} - -module ToolShed.Test.ReversibleEnum( --- * Functions --- ** Predicates - isReversible -) where - --- | Checks that composing 'toEnum' & 'fromEnum' is equivalent to the identity. -isReversible :: (Eq r, Enum r) => r -> Bool -isReversible r = toEnum (fromEnum r) == r diff --git a/src/ToolShed/Test/ReversibleIO.hs b/src/ToolShed/Test/ReversibleIO.hs deleted file mode 100644 --- a/src/ToolShed/Test/ReversibleIO.hs +++ /dev/null @@ -1,35 +0,0 @@ -{- - Copyright (C) 2012 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Facilities testing of custom implementations of 'Read' & 'Show'. - - * CAVEAT: it doesn't actually do any IO. --} - -module ToolShed.Test.ReversibleIO( --- * Functions --- ** Predicates - isReversible -) where - --- | Checks that composing 'read' & 'show' is equivalent to the identity. -isReversible :: (Eq r, Read r, Show r) => r -> Bool -isReversible r = read (show r) == r diff --git a/src/ToolShed/Test/SelfValidate.hs b/src/ToolShed/Test/SelfValidate.hs deleted file mode 100644 --- a/src/ToolShed/Test/SelfValidate.hs +++ /dev/null @@ -1,76 +0,0 @@ -{- - Copyright (C) 2012-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.SelfValidate". --} - -module ToolShed.Test.SelfValidate( --- * Types --- ** Data-types --- Primes, --- * Functions - quickChecks -) where - -import qualified Data.Foldable -import qualified Data.List -import qualified Data.Map -import qualified Data.Set -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) -import qualified ToolShed.SelfValidate as SelfValidate -import ToolShed.Test.QuickCheck.Arbitrary.Map() -import ToolShed.Test.QuickCheck.Arbitrary.Set() - --- | A test-type. -newtype Primes = MkPrimes Int deriving (Eq, Ord, Show) - -instance SelfValidate.SelfValidator Primes where - getErrors (MkPrimes i) = SelfValidate.extractErrors [ - (any ((== 0) . (i `rem`)) [2,3,5], "Composite; " ++ show i), - (i < 0, "Negative; " ++ show i), - (i `elem` [0, 1], "Excluded; " ++ show i) - ] - -instance Test.QuickCheck.Arbitrary Primes where - arbitrary = MkPrimes `fmap` Test.QuickCheck.elements [negate limit .. limit] where limit = pred $ 7 * 7 - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks - = Test.QuickCheck.quickCheck `mapM_` [prop_list, prop_list'] - >> Test.QuickCheck.quickCheck prop_set - >> Test.QuickCheck.quickCheck prop_map - where - prop_list :: [Primes] -> Test.QuickCheck.Property - prop_list l = not (null l) ==> Test.QuickCheck.label "prop_list" $ SelfValidate.getErrors (head l) `Data.List.isPrefixOf` SelfValidate.getErrors l - prop_list' l = Test.QuickCheck.label "prop_list'" $ all ( - (`elem` map SelfValidate.getErrors l) . SelfValidate.getErrors - ) l - - prop_set :: Data.Set.Set Primes -> Test.QuickCheck.Property - prop_set s = Test.QuickCheck.label "prop_set" $ Data.Foldable.all ( - (`Data.Set.isSubsetOf` Data.Set.fromList (SelfValidate.getErrors s)) . Data.Set.fromList . SelfValidate.getErrors - ) s - - prop_map :: Data.Map.Map Int Primes -> Test.QuickCheck.Property - prop_map m = Test.QuickCheck.label "prop_map" $ Data.Foldable.all ( - (`Data.Set.isSubsetOf` Data.Set.fromList (SelfValidate.getErrors m)) . Data.Set.fromList . SelfValidate.getErrors - ) m - diff --git a/src/ToolShed/Test/System/Random.hs b/src/ToolShed/Test/System/Random.hs deleted file mode 100644 --- a/src/ToolShed/Test/System/Random.hs +++ /dev/null @@ -1,82 +0,0 @@ -{- - Copyright (C) 2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "ToolShed.System.Random". --} - -module ToolShed.Test.System.Random( --- * Functions --- getMean, --- getStandardDeviation - quickChecks -) where - -import qualified Control.Arrow -import Control.Arrow((&&&),(***)) -import qualified Data.Foldable -import qualified Data.List -import qualified Data.Map -import qualified System.Random -import qualified Test.QuickCheck -import qualified ToolShed.System.Random - --- | Determines the /mean/ of the specified numbers -getMean :: (Data.Foldable.Foldable f, Real r, Fractional result) => f r -> result -getMean = uncurry (/) . (realToFrac *** fromIntegral) . Data.Foldable.foldr (\i -> (+ i) *** succ) (0, 0 :: Int) - --- | Find the standard-deviation of the specified list. -getStandardDeviation :: (Data.Foldable.Foldable f, Functor f, Real r) => f r -> Double -getStandardDeviation x = sqrt . getMean $ fmap ((^ (2 :: Int)) . (+ negate (getMean x :: Rational)) . toRational) x - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks - = Test.QuickCheck.quickCheck prop_shuffle - >> Test.QuickCheck.quickCheck prop_shuffleDistribution - where - prop_shuffle :: Int -> Int -> Test.QuickCheck.Property - prop_shuffle seed l = Test.QuickCheck.label "prop_shuffle" . (== testList) . Data.List.sort $ ToolShed.System.Random.shuffle (System.Random.mkStdGen seed) testList where - testList = [0 .. l `mod` 10000] - - prop_shuffleDistribution :: Int -> Test.QuickCheck.Property - prop_shuffleDistribution = Test.QuickCheck.label "prop_shuffleDistribution" . all ( - uncurry (&&) . ( - ( - < recip 20 {-empirically-} -- The ideal value for a uniform distribution, would be zero. - ) . ( - / getStandardDeviation (populationSize : replicate (pred $ length testList) 0) -- Normalise wrt the worst-case; which occurs when this column contains the same letter, for each test-case in the population. - ) . getStandardDeviation &&& ( - == populationSize -- Confirm the size of the test-data. - ) . Data.Foldable.sum - ) - ) . map ( - foldr ( - uncurry $ Data.Map.insertWith (+) - ) ( - Data.Map.fromList . zip testList $ repeat (0 :: Int) -- Initial value. - ) . (`zip` repeat 1) -- Count the instances of each letter in this column, which for a uniform distribution, should be approximately the same. - ) . Data.List.transpose {-examine the columns-} . take populationSize . map fst {-shuffled digits-} . tail {-drop initial value-} . iterate ( - Control.Arrow.first (`ToolShed.System.Random.shuffle` testList) . System.Random.split . snd - ) . (,) undefined . System.Random.mkStdGen where - testList :: String - testList = ['a' .. 'z'] - - populationSize :: Int - populationSize = 1000 - diff --git a/toolshed.cabal b/toolshed.cabal --- a/toolshed.cabal +++ b/toolshed.cabal @@ -1,30 +1,51 @@ --- Package-properties -Name: toolshed -Version: 0.15.0.1 -Cabal-Version: >= 1.6 -Copyright: (C) 2010-2013 Dr. Alistair Ward -License: GPL -License-file: LICENSE -Author: Dr. Alistair Ward -Stability: Stable interface. Ill-defined scope. -Synopsis: Utilities used by other packages. -Build-Type: Simple -Description: An ill-defined collection of simple unrelated utilities used by other packages from -Category: Utils -Tested-With: GHC == 7.4, GHC == 7.6, GHC == 7.10 -Homepage: http://functionalley.eu -Maintainer: toolshed functionalley eu -Bug-reports: toolshed functionalley eu -Extra-Source-Files: changelog, copyright, makefile +-- This file is part of ToolShed. +-- +-- ToolShed is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- ToolShed is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with ToolShed. If not, see . --- Turn on using: 'runhaskell ./Setup.hs configure -f llvm'. +Name: toolshed +Version: 0.16.0.0 +Cabal-version: >= 1.10 +Copyright: (C) 2010-2015 Dr. Alistair Ward +License: GPL +License-file: LICENSE +Author: Dr. Alistair Ward +Stability: stable +Synopsis: Ill-defined library. +Build-type: Simple +Description: Ill-defined unrelated utilities used by other packages from +Category: Utils +Tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10 +Homepage: http://functionalley.eu +Maintainer: mailto toolshed functionalley eu +Bug-reports: mailto toolshed functionalley eu + +-- None of these files are needed at run-time. +Extra-source-files: + changelog.markdown + copyright + README.markdown + +-- Enable using: 'cabal configure -f llvm'. flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. - manual: True - default: False + Manual: True + Default: False Library - hs-source-dirs: src + Default-language: Haskell2010 + GHC-options: -Wall -O2 -fno-warn-tabs + Hs-source-dirs: src-lib Exposed-modules: ToolShed.Data.Foldable @@ -42,9 +63,9 @@ ToolShed.System.TimeAction ToolShed.System.TimePure ToolShed.Test.QuickCheck.Arbitrary.Array - ToolShed.Test.QuickCheck.Arbitrary.ArrayElem ToolShed.Test.QuickCheck.Arbitrary.Map ToolShed.Test.QuickCheck.Arbitrary.Set + ToolShed.Test.QuickCheck.Result ToolShed.Test.ReversibleBoundedEnum ToolShed.Test.ReversibleEnum ToolShed.Test.ReversibleIO @@ -59,8 +80,6 @@ QuickCheck >= 2.2, random - GHC-options: -Wall -O2 -fno-warn-tabs - if impl(ghc >= 7.4.1) GHC-prof-options: -prof -fprof-auto -fprof-cafs else @@ -69,11 +88,14 @@ if impl(ghc >= 7.0) && flag(llvm) GHC-options: -fllvm -Executable toolshed - hs-source-dirs: src - - Main-Is: Main.hs +Test-Suite quickCheck + Default-language: Haskell2010 + GHC-options: -Wall -fno-warn-tabs + Hs-source-dirs: src-test + Main-is: Main.hs + Type: exitcode-stdio-1.0 +-- Required for 'cabal sdist'. Other-modules: ToolShed.Test.Data.Foldable ToolShed.Test.Data.List @@ -81,11 +103,14 @@ ToolShed.Test.Data.List.Splits ToolShed.Test.Data.Quadruple ToolShed.Test.Data.Triple - ToolShed.Test.QuickChecks ToolShed.Test.SelfValidate ToolShed.Test.System.Random Build-depends: - Cabal >= 1.6 && < 2 + base == 4.*, + containers >= 0.4.2.0, + QuickCheck >= 2.2, + random, + toolshed - GHC-options: -Wall -O2 -fno-warn-tabs +