squeeze 1.0.4.7 → 1.0.4.8
raw patch · 33 files changed
+1558/−1447 lines, 33 filesdep +squeezedep ~Cabaldep ~toolshed
Dependencies added: squeeze
Dependency ranges changed: Cabal, toolshed
Files
- README.markdown +27/−0
- changelog +0/−110
- changelog.Debian +1/−1
- changelog.markdown +119/−0
- copyright +1/−1
- debian/DEBIAN/control +3/−4
- man/man1/squeeze.1 +3/−6
- squeeze.cabal +105/−38
- squeeze.spec +21/−20
- src-exe/Main.hs +247/−0
- src-exe/Squeeze/Test/Performance.hs +73/−0
- src-lib/Squeeze/Control/Concurrent/DivideAndConquer.hs +80/−0
- src-lib/Squeeze/Data/CommandOptions.hs +124/−0
- src-lib/Squeeze/Data/File.hs +164/−0
- src-lib/Squeeze/Data/FileCombination.hs +164/−0
- src-lib/Squeeze/Squeeze.hs +176/−0
- src-test/Main.hs +45/−0
- src-test/Squeeze/Test/Data/CommandOptions.hs +54/−0
- src-test/Squeeze/Test/Data/FileCombinations.hs +51/−0
- src-test/Squeeze/Test/Data/Verbosity.hs +30/−0
- src-test/Squeeze/Test/Squeeze.hs +70/−0
- src/Main.hs +0/−249
- src/Squeeze/Control/Concurrent/DivideAndConquer.hs +0/−77
- src/Squeeze/Data/CommandOptions.hs +0/−124
- src/Squeeze/Data/File.hs +0/−164
- src/Squeeze/Data/FileCombination.hs +0/−164
- src/Squeeze/Squeeze.hs +0/−176
- src/Squeeze/Test/Data/CommandOptions.hs +0/−51
- src/Squeeze/Test/Data/FileCombinations.hs +0/−50
- src/Squeeze/Test/Data/Verbosity.hs +0/−30
- src/Squeeze/Test/Performance.hs +0/−73
- src/Squeeze/Test/QuickChecks.hs +0/−39
- src/Squeeze/Test/Squeeze.hs +0/−70
+ README.markdown view
@@ -0,0 +1,27 @@+# **Squeeze**.++This is **Squeeze**, an application which searches for combinations of the specified files to store in a given space,+without wasting an unacceptable proportion.++## Installation++It can be built and installed using [Cabal](https://www.haskell.org/cabal/users-guide/installing-packages.html).++## Documentation++* The directory **man/** contains the documentation.+* More information about this application can be found at [Squeeze](http://functionalley.eu/Squeeze/squeeze.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 <squeeze *at* functionalley *dot* eu>.++## Author++This application is written and maintained by Dr. Alistair Ward.++
− changelog
@@ -1,110 +0,0 @@-2010-11-18 Dr. Alistair Ward <squeeze at functionalley dot eu>--1.0.0.0- * First version of the package.-1.0.0.1- * Created "src/Squeeze/" sub-directory & then modified module-names accordingly.- * Pacified 'hlint'.- * Added a makefile.-1.0.0.2- * Tested with ghc-7.0.1- * Added RPM-spec file.-1.0.1.0- * Improved the basic algorithm, by permitting the file-list to be bisected; each file-combination resulting from the LHS, is then concatenated with each of those resulting from the recursively bisected RHS.- * Used "Control.Parallel.Strategies" to parallelize the concatenation of each combination from the LH-list, with each of those from the RH-list.- * Added default values of command-line flags, to usage-message.- * Used new "ToolShed.Package" module.- (1.0.1.1)- * Replaced 'Data.List.subsequences' with a tailored version which terminates combinations when they've grown too large, providing a better and more predictable performance-gain than recursive list-bisection.- * Reduced recursive list-bisection to a single bisection, for the sole purpose of facilitating parallelisation.- * Added module "Squeeze.QC" to define "Test.QuickCheck" tests and command-line option "--verbose", to govern level of output.- * Partitioned into new modules; "Squeeze.File", "Squeeze.FileSizeBounds" and "Squeeze.FileCombination".-1.0.1.2- * Fixed typo in CPP-statement in "Squeeze.QC".- * Fixed negated reference to unparenthesised CPP-macro 'MIN_VERSION'.- * Protected reference in "Main", to 'Test.QuickCheck.verboseCheck', using CPP-statement.-1.0.1.3- * Amended "squeeze.spec" to define RPM-package, to install under "/usr", rather than "/usr/local".- * Renamed package from 'Squeeze' to 'squeeze', for compatibility with Debian's ".deb"-format.- * Added directory-structure required to build ".deb" package.-1.0.1.4- * Corrected command-line processing of the special file "-", which read standard-input as requested, but disregarded any other command-line options.- * Refined man-page to be an 'extra-source-file' in "squeeze.cabal" and "squeeze.spec" files.- * Ported to compile against alternative integral definitions of 'Squeeze.File.FileSize'.- * Added manually controlled "llvm" flag to "squeeze.cabal".- * Replaced references to the module "ToolShed.Package" with "Distribution.Package".- * Reacted to the creation of module "ToolShed.Defaultable".- * Uploaded to <http://hackage.haskell.org/packages/hackage.html>.-1.0.2.0- * Reimplemented 'Squeeze.File.aggregateSize' using 'foldr' rather than 'foldl'.- * Removed use of "Control.Parallel.Strategies" from "Squeeze.Squeeze", which ruined performance on one core and had no obvious benefit on two.- * Changed the definition of 'Squeeze.FileCombinations.FileCombinations' from a 'Pair' to a record-style data-type with selective strictness-annotation.- * Renamed 'Squeeze.FileCombination.concatenate' to '(Squeeze.FileCombination.<+>)' and 'Squeeze.FileCombination.prepend' to '(Squeeze.FileCombination.+>)'.- * Used new module "ToolShed.TimeAction", to permit measurement of the CPU-time required to find the best fit.- * Added the number, mean file-size and standard-deviation, to the output, when flag '--verbose' is specified; and as a side-effect, created a dependency on the package 'factory'.- * Replaced module "Squeeze.FileSizeBounds" with "Factory.Data.Interval", requiring use of 'toolshed-0.12.0.0'.- * Made the data-type 'CommandOptions.CommandOptions' polymorphic in terms of the /ratio/-type fields.- * Inserted new layers "Data" and "Test" into the module-hierarchy, and relocated existing modules accordingly.- * Added module "Squeeze.Test.Performance" to test with randomly generated virtual files.-1.0.2.1- * Added check for zero file-names when reading from stdin.- * Corrected the syntax required when specifying ratios, in the man-page.-1.0.2.2- * Renamed 'Squeeze.Data.File.order' to 'Squeeze.Data.File.orderBySize'.- * Used 'Paths_squeeze.version' in 'Main', rather than hard-coding it.- * Added 'Squeeze.Data.CommandOptions.getErrors' to permit better error-diagnosis.- * Reacted to new module-hierarchy and addition of method 'ToolShed.SelfValidate.getErrors', in toolshed-0.13.0.0.- * Replaced use of 'Control.Exception.bracket' with 'System.IO.withFile', in 'Squeeze.Data.File.findSize'.- * Replaced "System" with "System.Environment" and "System.Exit".- * Removed dependency on "haskell98".-1.0.2.3- * Added class 'Show' to context for 'Squeeze.Test.Performance.run', for migration to 'ghc-7.4.1'.-1.0.2.4- * Added details to any failure to parse the command-line arguments.- * Defined package's name using program's name & enhanced usage-message, in "Main.hs".- * Re-implemented logging using "Control.Monad.Writer.Writer" & renamed 'Squeeze.Squeeze.findBestFitM' to 'Squeeze.Squeeze.findBestFitWriter'.- * Implemented 'verbose' functionality in "Squeeze.Test.Performance".- * Added command-line flag 'includeEmpty', to allow one to include empty files & directories in any solution.-1.0.3.0- * Changed "Main" to replace calls to 'error' from inside the IO-monad, with 'Control.Monad.fail'.- * Changed "Main"; by adding a command-line option to define the seed for the random-generator used for performance-testing; to permit 'includeEmpty' to take an optional Boolean argument, rather than a mandatory one; to read 'Squeeze.Data.CommandOptions.getMinimumUsageRatio' as a 'Double', rather than a 'Rational'.- * Renamed the accessors in "Squeeze.Data.CommandOptions", & removed 'bisectionRatio' & associated code.- * Added "Squeeze.Control.Concurrent.DivideAndConquer", called from "Main" to utilise multiple CPU-cores where available.- * Trapped command-line arguments to which garbage has been appended.- * Changed "Data.CommandOptions" to use 'Distribution.Verbosity.Verbosity'.-1.0.4.0- * Corrected the Copyright-statement in 'Main.main.optDescrList.printVersion'.- * Renamed "Squeeze.Test.QC" to "Squeeze.Test.QuickChecks"; migrating its tests to a new module "Squeeze.Test.Squeeze", & added new tests 'prop_monotonicFileSize' & 'prop_uniqueFileNames', requiring package 'toolshed-0.14.0.0'; added module "Squeeze.Test.Data.FileCombinations".- * Amended the log-messages printed by "Main".- * Removed the command-line option 'graphPerformance', which printed only CPU-seconds rather than elapsed time, & therefore didn't correctly represent the multi-threaded implementation.- * Removed the printing of CPU-seconds when not testing performance; this is better left to '/usr/bin/time'.- * Compensated for the potential rejection of some virtual files after generation of a test-population.- * Used new class 'Factory.Math.Probability.Distribution' & bumped required version to 'factory-0.2.1.0'.- * Replaced the command-line option '--testPerformance', with '--testPerformanceContinuous' & '--testPerformanceDiscrete'.-1.0.4.1- * Removed 'ToolShed.SelfValidate.isValid commandOptions' from 'Main.runQuickChecks'; since the command-options aren't used.- * Added 'changelog.Debian' to 'squeeze.cabal'.- * Relocated 'Main.distribute' to 'Squeeze.Squeeze.distributeAndFindBestFit' & added check on whether maximum size has been exceeded.- * Added 'Squeeze.Squeeze.partitionEmptyFilesAndDistributeAndFindBestFit', to efficiently account for empty files, & relocated calculation of file-statistics to this function.- * Amended 'Test.Performance.run', replacing call to 'Squeeze.Squeeze.findBestFit' with 'Squeeze.Squeeze.distributeAndFindBestFit', to permit multi-threaded performance-tests.- * Added function 'Squeeze.Data.CommandOptions.mkCommandOptions' & modules "Squeeze.Test.Data.Verbosity" & "Squeeze.Test.Data.CommandOptions" for future QuickChecks.- * Extracted 'Squeeze.Data.File.expandDirectory' from 'Squeeze.Data.File.findSize' to clarify the logic. Symlinks are also now permissible input files.- * Added 'Squeeze.Data.File.findDuplicates', & trapped duplicate files implicit within those directories specified.-1.0.4.2- * Improved the syntax of 'verbosity' in the usage-message.- * Tested with 'haskell-platform-2013.2.0.0'.- * Added a function 'Data.CommandOptions.subtractFile' to adjust 'Data.CommandOptions.CommandOptions' after removing a file from the problem; previously done incorrectly, causing an error when running with '+RTS -N2'.-1.0.4.3- * Changed the value of '0/0' to '0' rather than '1' in 'Data.CommandOptions.subtractFile'.-1.0.4.4- * Either replaced instances of '(<$>)' with 'fmap' to avoid ambiguity between "Control.Applicative" & "Prelude" which (from 'base-4.8') also exports this symbol, or hid the symbol when importing the "Prelude"..- * In module "Main", redirected version-message to stderr.-1.0.4.5- * Added the compiler to the output returned for the command-line option "version".- * Specified compiler-option 'context-stack' in 'Main.hs', to account for call to printf.-1.0.4.6- * Minimised the explicit size of compiler's 'context-stack' in module "Main.hs".- * In module "Squeeze.Data.File.hs", replaced the use of the package "unix" with the package "directory", for compatibility with Windows.-1.0.4.7- * Increased the specified value of compiler-option 'context-stack' in module "Main.hs", to account for call to printf.-
changelog.Debian view
@@ -16,4 +16,4 @@ -- Alistair Ward <squeeze at functionalley dot eu> Wed, 24 Jul 2013 12:00:00 +0000 -squeeze (1.0.4.7-1) experimental; urgency=low+squeeze (1.0.4.8-1) experimental; urgency=low
+ changelog.markdown view
@@ -0,0 +1,119 @@+# 2010-11-18 Dr. Alistair Ward <squeeze at functionalley dot eu>++## 1.0.0.0+ * First version of the package.+## 1.0.0.1+ * Created **src/Squeeze/** sub-directory & then modified module-names accordingly.+ * Pacified **hlint**.+ * Added a makefile.+## 1.0.0.2+ * Tested with ghc-7.0.1+ * Added *.spec*-file.+## 1.0.1.0+ * Improved the basic algorithm, by permitting the file-list to be bisected; each file-combination resulting from the LHS, is then concatenated with each of those resulting from the recursively bisected RHS.+ * Used **Control.Parallel.Strategies** to parallelize the concatenation of each combination from the LH-list, with each of those from the RH-list.+ * Added default values of command-line flags, to usage-message.+ * Used new **ToolShed.Package**-module.+ (1.0.1.1)+ * Replaced `Data.List.subsequences` with a tailored version which terminates combinations when they've grown too large, providing a better and more predictable performance-gain than recursive list-bisection.+ * Reduced recursive list-bisection to a single bisection, for the sole purpose of facilitating parallelisation.+ * Added module **Squeeze.QC** to define **Test.QuickCheck** tests and command-line option **--verbose**, to govern level of output.+ * Partitioned into new modules; **Squeeze.File**, **Squeeze.FileSizeBounds** and **Squeeze.FileCombination**.+## 1.0.1.2+ * Fixed typo in CPP-statement in **Squeeze.QC**.+ * Fixed negated reference to unparenthesised CPP-macro **MIN_VERSION**.+ * Protected reference in **Main**, to `Test.QuickCheck.verboseCheck`, using CPP-statement.+## 1.0.1.3+ * Amended *.spec*-file to define RPM-package, to install under **/usr**, rather than **/usr/local**.+ * Renamed package from **Squeeze** to **squeeze**, for compatibility with Debian's *.deb*-format.+ * Added directory-structure required to build *.deb*-package.+## 1.0.1.4+ * Corrected command-line processing of the special file **-**, which reads standard-input as requested, but disregarded any other command-line options.+ * Refined man-page to be an **extra-source-file** in the *.cabal*-file and the *.spec*-file.+ * Ported to compile against alternative integral definitions of `Squeeze.File.FileSize`.+ * Added manually controlled **llvm** flag to the *.cabal*-file.+ * Replaced references to the module **ToolShed.Package** with **Distribution.Package**.+ * Reacted to the creation of module **ToolShed.Defaultable**.+ * Uploaded to [Hackage](http://hackage.haskell.org/packages/hackage.html).+## 1.0.2.0+ * Reimplemented `Squeeze.File.aggregateSize` using `foldr` rather than `foldl`.+ * Removed use of `Control.Parallel.Strategies` from **Squeeze.Squeeze**, which ruined performance on one core and had no obvious benefit on two.+ * Changed the definition of `Squeeze.FileCombinations.FileCombinations` from a `Pair` to a record-style data-type with selective strictness-annotation.+ * Renamed `Squeeze.FileCombination.concatenate` to `(Squeeze.FileCombination.<+>)` and `Squeeze.FileCombination.prepend` to `(Squeeze.FileCombination.+>)`.+ * Used new module **ToolShed.TimeAction**, to permit measurement of the CPU-time required to find the best fit.+ * Added the number, mean file-size and standard-deviation, to the output, when flag **--verbose** is specified; and as a side-effect, created a dependency on the package **factory**.+ * Replaced module **Squeeze.FileSizeBounds** with **Factory.Data.Interval**, requiring use of **toolshed-0.12.0.0**.+ * Made the data-type `CommandOptions.CommandOptions` polymorphic in terms of the *ratio*-type fields.+ * Inserted new layers **Data** and **Test** into the module-hierarchy, and relocated existing modules accordingly.+ * Added module **Squeeze.Test.Performance** to test with randomly generated virtual files.+## 1.0.2.1+ * Added check for zero file-names when reading from stdin.+ * Corrected the syntax required when specifying ratios, in the man-page.+## 1.0.2.2+ * Renamed `Squeeze.Data.File.order` to `Squeeze.Data.File.orderBySize`.+ * Used **Paths_squeeze.version** in **Main**, rather than hard-coding it.+ * Added `Squeeze.Data.CommandOptions.getErrors` to permit better error-diagnosis.+ * Reacted to new module-hierarchy and addition of method `ToolShed.SelfValidate.getErrors`, in toolshed-0.13.0.0.+ * Replaced use of `Control.Exception.bracket` with `System.IO.withFile`, in `Squeeze.Data.File.findSize`.+ * Replaced `System` with `System.Environment` and `System.Exit`.+ * Removed dependency on **haskell98**.+## 1.0.2.3+ * Added class `Show` to context for `Squeeze.Test.Performance.run`, for migration to **ghc-7.4.1**.+## 1.0.2.4+ * Added details to any failure to parse the command-line arguments.+ * Defined package's name using program's name & enhanced usage-message, in **Main.hs**.+ * Re-implemented logging using `Control.Monad.Writer.Writer` & renamed `Squeeze.Squeeze.findBestFitM` to `Squeeze.Squeeze.findBestFitWriter`.+ * Implemented **verbose** functionality in **Squeeze.Test.Performance**.+ * Added command-line flag **includeEmpty**, to allow one to include empty files & directories in any solution.+## 1.0.3.0+ * Changed **Main** to replace calls to `error` from inside the IO-monad, with `Control.Monad.fail`.+ * Changed **Main**; by adding a command-line option to define the seed for the random-generator used for performance-testing; to permit **includeEmpty** to take an optional Boolean argument, rather than a mandatory one; to read `Squeeze.Data.CommandOptions.getMinimumUsageRatio` as a `Double`, rather than a `Rational`.+ * Renamed the accessors in **Squeeze.Data.CommandOptions**, & removed `bisectionRatio` & associated code.+ * Added **Squeeze.Control.Concurrent.DivideAndConquer**, called from **Main** to utilise multiple CPU-cores where available.+ * Trapped command-line arguments to which garbage has been appended.+ * Changed **Data.CommandOptions** to use `Distribution.Verbosity.Verbosity`.+## 1.0.4.0+ * Corrected the Copyright-statement in `Main.main.optDescrList.printVersion`.+ * Renamed **Squeeze.Test.QC** to **Squeeze.Test.QuickChecks**; migrating its tests to a new module **Squeeze.Test.Squeeze**, & added new tests `prop_monotonicFileSize` & `prop_uniqueFileNames`, requiring package **toolshed-0.14.0.0**; added module **Squeeze.Test.Data.FileCombinations**.+ * Amended the log-messages printed by **Main**.+ * Removed the command-line option **graphPerformance**, which printed only CPU-seconds rather than elapsed time, & therefore didn't correctly represent the multi-threaded implementation.+ * Removed the printing of CPU-seconds when not testing performance; this is better left to **/usr/bin/time**.+ * Compensated for the potential rejection of some virtual files after generation of a test-population.+ * Used new class `Factory.Math.Probability.Distribution` & bumped required version to **factory-0.2.1.0**.+ * Replaced the command-line option **--testPerformance**, with **--testPerformanceContinuous** & **--testPerformanceDiscrete**.+## 1.0.4.1+ * Removed `ToolShed.SelfValidate.isValid commandOptions` from `Main.runQuickChecks`; since the command-options aren't used.+ * Added **changelog.Debian** to the *.cabal*-file.+ * Relocated `Main.distribute` to `Squeeze.Squeeze.distributeAndFindBestFit` & added check on whether maximum size has been exceeded.+ * Added `Squeeze.Squeeze.partitionEmptyFilesAndDistributeAndFindBestFit`, to efficiently account for empty files, & relocated calculation of file-statistics to this function.+ * Amended `Test.Performance.run`, replacing call to `Squeeze.Squeeze.findBestFit` with `Squeeze.Squeeze.distributeAndFindBestFit`, to permit multi-threaded performance-tests.+ * Added function `Squeeze.Data.CommandOptions.mkCommandOptions` & modules **Squeeze.Test.Data.Verbosity** & **Squeeze.Test.Data.CommandOptions** for future QuickChecks.+ * Extracted `Squeeze.Data.File.expandDirectory` from `Squeeze.Data.File.findSize` to clarify the logic. Symlinks are also now permissible input files.+ * Added `Squeeze.Data.File.findDuplicates`, & trapped duplicate files implicit within those directories specified.+## 1.0.4.2+ * Improved the syntax of **verbosity** in the usage-message.+ * Tested with **haskell-platform-2013.2.0.0**.+ * Added a function `Data.CommandOptions.subtractFile` to adjust `Data.CommandOptions.CommandOptions` after removing a file from the problem; previously done incorrectly, causing an error when running with **+RTS -N2**.+## 1.0.4.3+ * Changed the value of `0/0` to **0** rather than **1** in `Data.CommandOptions.subtractFile`.+## 1.0.4.4+ * Either replaced instances of `(<$>)` with `fmap` to avoid ambiguity between **Control.Applicative** & **Prelude** which (from **base-4.8**) also exports this symbol, or hid the symbol when importing the **Prelude**.+ * In module **Main**, redirected version-message to stderr.+## 1.0.4.5+ * Added the compiler to the output returned for the command-line option **version**.+ * Specified compiler-option **context-stack** in **Main.hs**, to account for call to `printf`.+## 1.0.4.6+ * Minimised the explicit size of compiler's 'context-stack' in module **Main.hs**.+ * In module **Squeeze.Data.File.hs**, replaced the use of the package **unix** with the package **directory**, for compatibility with Windows.+## 1.0.4.7+ * Increased the specified value of compiler-option **context-stack** in module **Main.hs**, to account for call to `printf`.+## 1.0.4.8+ * Changed flag **threaded** in the *.cabal*-file to **manual**.+ * 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`.+ * Moved the entry-point to the test-suite from **Main.hs** to **Test.hs**, both to integrate with **cabal** & to minimise the dependencies of the executable.+ * Partitioned the source-files into **src-lib**, **src-exe**, & **src-test** directories, & referenced them individually from the *.cabal*-file to avoid repeated compilation.+ * Used **CPP** to control the import of symbols from **Control.Applicative**.+ * Changed default **minimumUsageRatio** in module **Squeeze.Data.CommandOptions** from 99% to 90%.
copyright view
@@ -5,7 +5,7 @@ Copyright (C) 2010-2013 Dr. Alistair Ward. All Rights Reserved. Home-page:- http://functionalley.eu+ http://functionalley.eu/Squeeze/squeeze.html License: GNU GENERAL PUBLIC LICENSE Version 3; see '/usr/share/common-licenses/GPL-3' or '/usr/share/doc/licenses/gpl-3.0.txt' where available, or the local packaged file 'LICENSE'.
debian/DEBIAN/control view
@@ -1,14 +1,13 @@ Package: squeeze-Version: 1.0.4.7-1+Version: 1.0.4.8-1 Section: utils Priority: optional-#Architecture: i386 Architecture: amd64 Depends: libc6-Installed-size: 2448+Installed-size: 2576 Maintainer: Dr. Alistair Ward <squeeze at functionalley dot eu> Provides:-Homepage: http://functionalley.eu+Homepage: http://functionalley.eu/Squeeze/squeeze.html Description: Finds the optimal subset of the specified files, to fit into a limited space. Returns progressively better subsets of the specified files, to fit into a limited space, without wasting more than the specific ratio.
man/man1/squeeze.1 view
@@ -42,9 +42,6 @@ CAVEAT: for \fIn\fR such files or directories, a factor of \fI2^n\fR times more viable solutions exist, obscuring the minimal solutions on which they're based. .SS Test .TP-\fB-q\fR, \fB--runQuickChecks\fR-Tests the implementation, by validating some invariant properties using arbitrary data; & then exits.-.TP \fB-r\fR[\fIInt\fR], \fB--randomSeed\fR[\fB=\fR\fIInt\fR] This option takes an optional integral argument with which to seed the unique random-number generator used for all random operations. .br@@ -103,7 +100,7 @@ NB: "\fBdu\fR" will return a slightly larger size, since it includes the space required for directory-structures. .SS Example 2 We can improve on that result if we're prepared to split some of the artist-specific directories into individual albums.-With the expection of more solutions from which to select, we'll also raise the bar for what is acceptable.+With the expectation of more solutions from which to select, we'll also raise the bar for what is acceptable. .br NB: from version \fB1.0.3.0\fR, the runtime can be passed a "\fB-N\fR" flag to request parallel execution on multiple cores, which as a side-effect, alters the selection of sub-optimal solutions to return.@@ -133,7 +130,7 @@ Written by Dr. Alistair Ward. .SH BUGS .SS "REPORTING BUGS"-Report bugs to \fBsqueeze\fR \fIat\fR \fBfunctionalley\fR \fIdot\fR \fBeu\fR+Report bugs to <\fBsqueeze\fR \fIat\fR \fBfunctionalley\fR \fIdot\fR \fBeu\fR>. .SH COPYRIGHT Copyright \(co 2010-2015 Dr. Alistair Ward .PP@@ -144,7 +141,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see \fB<http://www.gnu.org/licenses/>\fR. .SH "SEE ALSO" .IP \(bu-Home-page: \fBhttp://functionalley.eu\fR+Home-page: \fBhttp://functionalley.eu/Squeeze/squeeze\fR .IP \(bu Source-documentation is generated by "\fBHaddock\fR", & is available in the distribution. .IP \(bu
squeeze.cabal view
@@ -1,62 +1,108 @@--- Package-properties-Name: squeeze-Version: 1.0.4.7-Cabal-Version: >= 1.6-Copyright: (C) 2010-2015 Dr. Alistair Ward-License: GPL-License-file: LICENSE-Author: Dr. Alistair Ward-Stability: Stable interface, incomplete features.-Synopsis: A file-packing application.-Build-Type: Simple-Description: Returns progressively better subsets of the specified files, selected to fit into a limited space, without wasting more than the specific ratio.-Category: Application, Utils-Tested-With: GHC == 7.4, GHC == 7.6, GHC == 7.10-Homepage: http://functionalley.eu-Maintainer: squeeze <at> functionalley <dot> eu-Bug-reports: squeeze <at> functionalley <dot> eu-Data-files:-Extra-Source-Files: changelog changelog.Debian copyright debian/DEBIAN/control man/man1/squeeze.1 squeeze.spec+-- This file is part of Squeeze.+--+-- Squeeze 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.+--+-- Squeeze 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 Squeeze. If not, see <http://www.gnu.org/licenses/>. --- Turn on using: 'runhaskell ./Setup.hs configure -f llvm'.+Name: squeeze+Version: 1.0.4.8+Cabal-version: >= 1.10+Copyright: (C) 2010-2015 Dr. Alistair Ward+License: GPL+License-file: LICENSE+Author: Dr. Alistair Ward+Stability: stable+Synopsis: A file-packing application.+Build-type: Simple+Description: Returns progressively better subsets of the specified files, selected to fit into a limited space, without wasting more than the specific ratio.+Category: Application, Utils+Tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10+Homepage: http://functionalley.eu/Squeeze/squeeze.html+Maintainer: mailto <colon> squeeze <at> functionalley <dot> eu+Bug-reports: mailto <colon> squeeze <at> functionalley <dot> eu++-- None of these files are needed at run-time.+Extra-source-files:+ changelog.markdown+ changelog.Debian+ copyright+ debian/DEBIAN/control+ man/man1/squeeze.1+ README.markdown+ squeeze.spec++-- 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 flag threaded Description: Build for parallel runtime.- default: True+ Manual: True+ Default: True -Executable squeeze- hs-source-dirs: src- Main-Is: Main.hs- Other-modules:- Squeeze.Control.Concurrent.DivideAndConquer+Library+ Default-language: Haskell2010+ GHC-options: -Wall -O2 -fno-warn-tabs+ Hs-source-dirs: src-lib++ Exposed-modules: Squeeze.Data.CommandOptions Squeeze.Data.File Squeeze.Data.FileCombination Squeeze.Squeeze- Squeeze.Test.Data.CommandOptions- Squeeze.Test.Data.FileCombinations- Squeeze.Test.Data.Verbosity- Squeeze.Test.Performance- Squeeze.Test.QuickChecks- Squeeze.Test.Squeeze +-- Required for 'cabal sdist'.+ Exposed-modules:+ Squeeze.Control.Concurrent.DivideAndConquer+ Build-depends: base == 4.*,- Cabal >= 1.6 && < 2,+ Cabal >= 1.10, directory, factory >= 0.2.1.0, filepath, mtl,- QuickCheck >= 2.4,- random,- toolshed >= 0.14+ toolshed >= 0.16 + if impl(ghc >= 7.4.1)+ GHC-prof-options: -prof -fprof-auto -fprof-cafs+ else+ GHC-prof-options: -prof -auto-all -caf-all++ if impl(ghc >= 7.0) && flag(llvm)+ GHC-options: -fllvm++Executable squeeze+ Default-language: Haskell2010 GHC-options: -Wall -O2 -fno-warn-tabs+ Hs-source-dirs: src-exe+ Main-is: Main.hs +-- Required for 'cabal sdist'.+ Other-modules:+ Squeeze.Test.Performance++ Build-depends:+ base == 4.*,+ Cabal >= 1.10,+ factory >= 0.2.1.0,+ filepath,+ mtl,+ random,+ squeeze,+ toolshed >= 0.16+ if impl(ghc >= 7.4.1) GHC-prof-options: -prof -fprof-auto -fprof-cafs else@@ -70,4 +116,25 @@ if flag(llvm) GHC-options: -fllvm++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:+ Squeeze.Test.Data.CommandOptions+ Squeeze.Test.Data.FileCombinations+ Squeeze.Test.Data.Verbosity+ Squeeze.Test.Squeeze++ Build-depends:+ base == 4.*,+ factory >= 0.2.1.0,+ QuickCheck >= 2.4,+ squeeze,+ toolshed >= 0.16
squeeze.spec view
@@ -1,4 +1,4 @@-# Copyright (C) 2012-2014 Dr. Alistair Ward+# 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@@ -15,52 +15,53 @@ %define package %name-%version %define tarBall %package.tar.gz-%define _bindir %prefix/bin %define _sharedir %prefix/share-%define _docdir %_sharedir/doc/%package+%define _docdir %_sharedir/doc/%name %define _mandir %_sharedir/man Summary: Finds the optimal subset of the specified files, to fit into a limited space, with minimal wastage Name: squeeze-Version: 1.0.4.7+Version: 1.0.4.8 Release: 1 License: GPLv3-#From '/usr/share/doc/packages/rpm/GROUPS'.+# From '/usr/share/doc/packages/rpm/GROUPS'. Group: Applications/File Source0: http://functionalley.eu/Downloads/sdist/%tarBall-URL: http://functionalley.eu+URL: http://functionalley.eu/Squeeze/%name.html Prefix: /usr-BuildRequires: ghc+BuildRequires: haskell-platform %description Returns progressively better subsets of the specified files, to fit into a limited space, without wasting more than the specific ratio. %prep-#NB: we've changed directory to %_builddir-(cd $OLDPWD && runhaskell Setup sdist) && tar -zxf $OLDPWD/dist/%tarBall #Make a source-distribution & unpack it into the build-directory.-cd '%package/' && runhaskell Setup configure --user --prefix=%prefix #Configure to use the user's personal package-database & to generate an appropriate "Paths" module.+# NB: CWD has changed to %_builddir+echo 'package="%package", prefix="%prefix", _builddir="%_builddir", buildroot="%buildroot"'+(cd $OLDPWD && cabal sdist) && tar -zxf $OLDPWD/dist/%tarBall # Make a source-distribution & unpack it into the build-directory.+cd '%package/' && cabal configure --user --prefix='%prefix' --docdir='%_docdir' # Tell cabal to use the user's personal package-database, to generate an appropriate "Paths" module, & where to place the documentation. %build-cd '%package/' && runhaskell Setup build #Descend into the source-distribution and build according to the previously established configuration.+cd '%package/' && cabal build # Descend into the unpacked source-distribution and build according to the previously established configuration. %install-cd '%package/' #Descend into the build-directory.-runhaskell Setup copy --destdir=%buildroot #Install the package in the target-directory.-mkdir -p -- '%buildroot%_docdir' && mv changelog copyright LICENSE '%buildroot%_docdir/'+cd '%package/' # Descend into the build-directory.+cabal copy --destdir='%buildroot' # Install the built package in the target-directory.+mkdir -p -- '%buildroot%_docdir' && mv 'changelog.markdown' 'copyright' 'README.markdown' '%buildroot%_docdir/' # 'LICENSE' has already been copied by cabal. mkdir -p -- '%buildroot%_mandir' && mv 'man/man1' '%buildroot%_mandir/'+rm -rf -- '%buildroot%prefix/lib/' # The library isn't a deliverable. %clean-make --directory='%package' clobber-rm -rf -- '%_builddir/%package/' '%buildroot'+rm -rf -- '%_builddir/%package/' '%buildroot/' # Only the '.rpm' is required. %files-%attr(0755, root, root) %_bindir/%name-%attr(0644, root, root) %doc %_docdir/changelog+%attr(0755, root, root) %prefix/bin/%name+%attr(0644, root, root) %doc %_docdir/changelog.markdown %attr(0644, root, root) %doc %_docdir/copyright %attr(0644, root, root) %doc %_docdir/LICENSE+%attr(0644, root, root) %doc %_docdir/README.markdown %attr(0644, root, root) %doc %_mandir/man1/%name.1.gz %changelog * Wed May 09 2012 Alistair Ward <squeeze at functionalley dot eu> 1.0.2.4-1-Removed "rm -rf -- '%buildroot'" from build, for security.-Corrected "Paths" module, even though it's unused.+First cut.+
+ src-exe/Main.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fcontext-stack=24 #-}+{-+ Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@]++ * Contains the entry-point of the application.++ * Processes the command-line arguments.++ * Delegates the task to 'Squeeze.findBestFit', potentially on multiple threads.+-}++module Main(main) where++import qualified Control.Monad+import qualified Control.Monad.Writer+import qualified Data.List+import qualified Data.Maybe+import qualified Data.Version+import qualified Distribution.Package+import qualified Distribution.Text+import qualified Distribution.Verbosity+import qualified Distribution.Version+import qualified Factory.Math.Probability+import qualified Paths_squeeze as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'.+import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import qualified Squeeze.Data.File as Data.File+import qualified Squeeze.Squeeze as Squeeze+import qualified Squeeze.Test.Performance as Test.Performance+import qualified System.Console.GetOpt as G+import qualified System.Environment+import qualified System.Exit+import qualified System.FilePath+import qualified System.Info+import qualified System.IO+import qualified System.IO.Error+import qualified Text.Printf+import qualified ToolShed.Data.List+import qualified ToolShed.Defaultable+import qualified ToolShed.SelfValidate+import qualified ToolShed.System.TimeAction++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative((<$>), (<*>))+#endif++-- | Coerce the polymorphic data-type to concrete instance, in order that it's fields may be read from the command-line.+type CommandOptions' = Data.CommandOptions.CommandOptions Rational -- 'Double' would also be a suitable type-parameter.++-- | Used to thread user-defined command-line options, though the list of functions which implement them.+type CommandLineAction = CommandOptions' -> IO CommandOptions' -- Supplied as the type-argument to 'G.OptDescr'.++-- | On failure to parse the specified string, returns an explanatory error.+read' :: Read a => String -> String -> a+read' errorMessage s = case reads s of+ [(x, "")] -> x+ _ -> error $ errorMessage ++ show s++-- | On failure to parse a command-line argument, returns an explanatory error.+readCommandArg :: Read a => String -> a+readCommandArg = read' "failed to parse command-line argument "++-- | Reads a bounded integral from the command-line, guarding against overflow.+readBoundedIntegral :: Integral i => String -> i+readBoundedIntegral s+ | fromIntegral bounded /= unbounded = error $ "integral value exceeds permissible bounds; " ++ show unbounded ++ "."+ | otherwise = bounded+ where+ unbounded = readCommandArg s+ bounded = fromInteger unbounded++{- |+ * Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', which over-ride the default value.++ * Any arguments which follow known 'Data.CommandOptions.CommandOptions',+ are interpreted as file-names to consider when attempting to find a suitable fit for the specified space-constraints.++ * If the specified file-name is /-/, then the actual file-names are read from /standard input/, to augment any other non-options specified.++ * Delegates the donkey-work to 'partitionEmptyFilesAndDistributeAndFindBestFit'.+ Because this may take a long time, it prints the results in real time, rather than batching until the optimum has been determined.+-}+main :: IO ()+main = do+ progName <- System.Environment.getProgName++ let+ defaultCommandOptions :: CommandOptions'+ defaultCommandOptions = ToolShed.Defaultable.defaultValue++ defaultRandomSeed :: Int+ defaultRandomSeed = 0++ optDescrList :: [G.OptDescr CommandLineAction]+ optDescrList = [+-- String [String] (G.ArgDescr CommandLineAction) String+ G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help, & then exit.",+ G.Option "" ["verbosity"] (+ setVerbosity `G.ReqArg` ToolShed.Data.List.showListWith listDelimiters [minBound :: Distribution.Verbosity.Verbosity .. maxBound] ""+ ) ("Define the log-level; default '" ++ show (Data.CommandOptions.getVerbosity defaultCommandOptions) ++ "'. CAVEAT: to be effective, it must precede other options."+ ),+ G.Option "v" ["version"] (G.NoArg $ const printVersion) "Print version-information, & then exit.",+ G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.OptArg` "<Bool>") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."),+ G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "<Int>") ("The maximum bytes of available space; default '" ++ show defaultMaximumBytes ++ "'."),+ G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "<Float>") ("The minimum acceptable space usage-ratio; default '" ++ show (realToFrac $ Data.CommandOptions.getMinimumUsageRatio defaultCommandOptions :: Double) ++ "'."),+ G.Option "r" ["randomSeed"] (G.OptArg setRandomSeed "<Int>") ("Seed the random number-generator with the specified integer, to produce a repeatable pseudo-random sequence as required for performance-testing. If this option is unspecified then the seed is unpredictable, but if only its argument is unspecified then the seed defaults to '" ++ show defaultRandomSeed ++ "'. CAVEAT: to be effective, it must precede either 'testPerformanceContinuous' or 'testPerformanceDiscrete'."),+ G.Option "" ["testPerformanceContinuous"] (+ testPerformanceContinuous `G.ReqArg` "(<Int>, <ContinuousDistribution>)"+ ) "Measure the CPU-seconds required to find the best fit, for the specified number of randomly generated virtual files, the size of which conform to the specified continuous probability-distribution; & then exit.",+ G.Option "" ["testPerformanceDiscrete"] (+ testPerformanceDiscrete `G.ReqArg` "(<Int>, <DiscreteDistribution>)"+ ) "Measure the CPU-seconds required to find the best fit, for the specified number of randomly generated virtual files, the size of which conform to the specified discrete probability-distribution; & then exit."+ ] where+ listDelimiters = ('(', '|', ')')++ defaultMaximumBytes = Data.CommandOptions.getMaximumBytes defaultCommandOptions++ setMaximumBytes, setMinimumUsageRatio, setVerbosity, testPerformanceContinuous, testPerformanceDiscrete :: String -> CommandLineAction+ setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaximumBytes = readCommandArg arg }+ setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMinimumUsageRatio = realToFrac (readCommandArg arg :: Double) }+ setVerbosity arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getVerbosity = readCommandArg arg }++ testPerformanceContinuous arg commandOptions+ | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions+ | otherwise = do+ ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print {-force evaluation-}++ System.Exit.exitSuccess+ where+ fileCount :: Int+ probabilityDistribution :: Factory.Math.Probability.ContinuousDistribution Double+ (fileCount, probabilityDistribution) = readCommandArg arg++ testPerformanceDiscrete arg commandOptions+ | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions+ | otherwise = do+ ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print {-force evaluation-}++ System.Exit.exitSuccess+ where+ fileCount :: Int+ probabilityDistribution :: Factory.Math.Probability.DiscreteDistribution Double+ (fileCount, probabilityDistribution) = readCommandArg arg++ setIncludeEmpty, setRandomSeed :: Maybe String -> CommandLineAction+ setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getIncludeEmpty = Data.Maybe.maybe True readCommandArg arg }+ setRandomSeed arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaybeRandomSeed = Just $ Data.Maybe.maybe defaultRandomSeed readBoundedIntegral arg }++ printVersion, printUsage :: IO (Data.CommandOptions.CommandOptions f)+ printVersion = System.IO.hPutStrLn System.IO.stderr (+ Distribution.Text.display packageIdentifier ++ "\n\nCompiled by " ++ show compiler ++ ".\n\nCopyright (C) 2010-2015 " ++ 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.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, compiler :: String+ author = "Dr. Alistair Ward"+ compiler = System.Info.compilerName ++ "-" ++ Data.List.intercalate "." (map show $ Data.Version.versionBranch System.Info.compilerVersion)++ printUsage = Text.Printf.hPrintf System.IO.stderr (+ "Usage:\t%s %s\n\nEBNF argument-format:" ++ concat (+ replicate 9 "\n\t%-22s = %s;" -- Argument-types & their EBNF-definition.+ ) ++ "\n\nE.g.\n\t%s\n\t%s\n\t%s\n"+ ) (+ G.usageInfo progName optDescrList+ ) "[<File-path> ...]" "Bool" "\"True\" | \"False\"\t(* case-sensitive *)" "ContinuousDistribution" "LogNormalDistribution location scale^2" "DiscreteDistribution" "PoissonDistribution lambda" "File-path" (+ "File-name ('" ++ [System.FilePath.pathSeparator] ++ "' File-name)*"+ ) "Float" "Int ('.' Int)?" "Int" "[0-9]+" "lambda" "Float\t(* the mean & variance of the distribution *)" "location" "Float\t(* the mean of the log of the distribution *)" "scale^2" "Float\t(* the variance of the log of the distribution *)" (+ progName ++ " --verbosity=Verbose -M 700000000 *.ogg +RTS -N\t#Find the best-fit for the globbed file-names, into the space available on a CD, using multiple CPU-cores where available."+ ) (+ progName ++ " -r --testPerformanceContinuous='(100, LogNormalDistribution " ++ show (log ((fromIntegral defaultMaximumBytes / 12) / sqrt 2) :: Float) {-location-} ++ " " ++ show (log 2 :: Float) {-scale^2-} ++ ")'\t#Test performance."+ ) (+ progName ++ " -r --testPerformanceDiscrete='(100, PoissonDistribution " ++ show (defaultMaximumBytes `div` 12) {-lambda-} ++ ")'\t#Test performance."+ ) >> System.Exit.exitSuccess -- CAVEAT: requires increase to default context-stack.++ args <- System.Environment.getArgs++-- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr CommandLineAction] -> [String] -> ([CommandLineAction], [String], [String])+ case G.getOpt G.RequireOrder optDescrList args of+ (commandLineActions, nonOptions, [{-errors-}]) -> do+ commandOptions <- Data.List.foldl' (>>=) (+ return {-to IO-monad-} ToolShed.Defaultable.defaultValue+ ) {-transform using CommandLineAction-mutators-} commandLineActions -- ie: do o1 <- CommandLineAction[0] commandOptions[0]; o2 <- CommandLineAction[1] o1; ...++ if not $ ToolShed.SelfValidate.isValid commandOptions+ then fail $ ToolShed.SelfValidate.getFirstError commandOptions+ else if null nonOptions+ then fail "zero file-paths specified"+ else let+ standardInputProxy = "-"+ in do+ filePaths <- Data.List.nub {-remove explicit duplicates-} <$> if standardInputProxy `elem` nonOptions+ then let+ getFilePaths :: IO Data.File.FilePathList+ getFilePaths = do+ eof <- System.IO.isEOF++ if eof+ then return {-to IO-monad-} []+ else {-more to read-} (:) <$> getLine <*> getFilePaths {-recurse-}+ in do+ filePaths <- (filter (/= standardInputProxy) nonOptions ++) <$> getFilePaths++ if null filePaths+ then fail "zero file-paths"+ else return filePaths+ else {-real fileNames-} return {-to IO-monad-} nonOptions++ implicitDuplicateFilePaths <- Data.File.findDuplicates filePaths++ Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null implicitDuplicateFilePaths) . System.IO.hPutStrLn System.IO.stderr $ "WARNING: there are duplicate files implicit within those directories specified; " ++ show implicitDuplicateFilePaths ++ "."++ (acceptedFileSizeAndPathList, logFile) <- Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (<= Data.CommandOptions.getMaximumBytes commandOptions) <$> Data.File.findSizes filePaths++ Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null logFile) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile++ if null acceptedFileSizeAndPathList+ then fail "there are zero suitable files"+ else let+ aggregateSize = Data.File.aggregateSize acceptedFileSizeAndPathList+ minimumBytes = Data.CommandOptions.deriveMinimumBytes commandOptions+ in if aggregateSize < minimumBytes+ then fail $ "the aggregate size of all suitable files (" ++ show aggregateSize ++ " bytes), is insufficient to satisfy the minimum " ++ show minimumBytes ++ " bytes required"+ else Squeeze.partitionEmptyFilesAndDistributeAndFindBestFit commandOptions acceptedFileSizeAndPathList >>= mapM_ print {-lazy evaluation-}+ (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors+
+ src-exe/Squeeze/Test/Performance.hs view
@@ -0,0 +1,73 @@+{-+ Copyright (C) 2011-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Defines a performance-test, based on randomly generated /virtual/ files.+-}++module Squeeze.Test.Performance(+-- * Functions+ run+) where++import qualified Control.Monad+import qualified Control.Monad.Writer+import qualified Data.List+import qualified Data.Maybe+import qualified Factory.Math.Probability+import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import qualified Squeeze.Data.File as Data.File+import qualified Squeeze.Data.FileCombination as Data.FileCombination+import qualified Squeeze.Squeeze as Squeeze+import qualified System.IO+import qualified System.Random++{- |+ * Find the best-fit, into the available space, using a set composed from the specified number of virtual files.++ * The files have a random size, conforming to the specified distribution.++ * The generated file-name, is merely a counter.++ * CAVEAT: fewer files than requested may be used, because depending on the requested distribution, some may overflow the maximum permissible size.+-}+run :: (Factory.Math.Probability.Distribution distribution, RealFrac ratio)+ => Data.CommandOptions.CommandOptions ratio+ -> Int -- ^ The number of virtual files to randomly generate.+ -> distribution+ -> IO [Data.FileCombination.FileCombination]+run commandOptions fileCount probabilityDistribution = do+ randomGen <- Data.Maybe.maybe System.Random.getStdGen {-use the global random-number generator-} (+ return {-to IO-monad-} . System.Random.mkStdGen -- Seed the random-number generator as specified.+ ) $ Data.CommandOptions.getMaybeRandomSeed commandOptions -- Select a random-number generator.++ let+ (acceptedFileSizeAndPathList, logFile) = Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (+ <= Data.CommandOptions.getMaximumBytes commandOptions -- This may reduce the requested number of files, but compensating distorts the requested distribution.+ ) . (+ `zip` map show [0 :: Int ..] -- Construct a Data.File.FileSizeAndPath, by using a counter as the file-name.+ ) . take fileCount . filter (+ >= 0 -- A suitable distribution shouldn't generate negative file-sizes.+ ) . map (+ ceiling :: Double -> Integer -- File-sizes are integral.+ ) $ Factory.Math.Probability.generatePopulation probabilityDistribution randomGen++ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > minBound) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile++ Squeeze.distributeAndFindBestFit commandOptions acceptedFileSizeAndPathList+
+ src-lib/Squeeze/Control/Concurrent/DivideAndConquer.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@]++ Provides the capability to write two unevaluated lists to separate concurrent channels,+ read them both & merge the results into a single list, evaluating in parallel, lazily on demand.+-}++module Squeeze.Control.Concurrent.DivideAndConquer(+-- * Types+-- * Type-synonyms+-- TerminatedChannel,+-- * Functions+-- writeListToChan,+-- readListFromChan,+ divideAndConquer+) where++import qualified Control.Concurrent+import qualified Control.Concurrent.Chan+import qualified System.IO.Unsafe+import qualified Control.Monad+import qualified Data.Maybe++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative((<$>), (<*>))+#endif++-- | A channel terminated by a sentinel.+type TerminatedChannel a = Control.Concurrent.Chan.Chan (Maybe a)++-- | Write the specified list to the specified channel, terminating it with a sentinel.+writeListToChan :: TerminatedChannel a -> [a] -> IO ()+writeListToChan chan l = mapM_ (Control.Concurrent.Chan.writeChan chan . Just) l >> Control.Concurrent.Chan.writeChan chan Nothing {-sentinel-}++{- |+ * Read the contents of the specified channel, up to the sentinel.++ * Any attempt to read beyond the sentinel, will block forever since the writer is out of data.+-}+readListFromChan :: TerminatedChannel a -> IO [a]+readListFromChan chan = System.IO.Unsafe.unsafeInterleaveIO {-read lazily, on demand-} $ Control.Concurrent.Chan.readChan chan >>= Data.Maybe.maybe (+ return {-to IO-monad-} []+ ) (+ \x -> (x :) <$> readListFromChan chan {-recurse-}+ )++-- | Writes the two unevaluated lists to separate concurrent channels, lazily reads them both (resulting in parallel evaluation) & merges them into a single results-list.+divideAndConquer+ :: ([a] -> [a] -> [a]) -- ^ Merge-function, which reads from two channels, to produce a third.+ -> [a] -- ^ Data for first channel.+ -> [a] -- ^ Data for second channel.+ -> IO [a]+divideAndConquer merge l r = do+ chan0 <- Control.Concurrent.Chan.newChan+ chan1 <- Control.Concurrent.Chan.newChan++ Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan0 l+ Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan1 r++ merge <$> readListFromChan chan0 <*> readListFromChan chan1+
+ src-lib/Squeeze/Data/CommandOptions.hs view
@@ -0,0 +1,124 @@+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@]++ * Defines options for program-operation.++ * Defines an appropriate default value, which is expected to be over-ridden on the command-line.++ * Self-validates.+-}++module Squeeze.Data.CommandOptions(+-- * Types+-- ** Data-types+ CommandOptions(+-- MkCommandOptions,+ getIncludeEmpty,+ getMaybeRandomSeed,+ getMaximumBytes,+ getMinimumUsageRatio,+ getVerbosity+ ),+-- * Functions+ solutionSizeBounds,+ deriveMinimumBytes,+ subtractFile,+-- ** Constructors+ mkCommandOptions+) where++import Control.Arrow((&&&))+import qualified Distribution.Verbosity+import qualified Factory.Data.Interval+import qualified Squeeze.Data.File as Data.File+import qualified ToolShed.Defaultable+import qualified ToolShed.SelfValidate++-- | Declares a record to contain command-line options.+data CommandOptions ratio = MkCommandOptions {+ getIncludeEmpty :: Bool, -- ^ Whether empty directories or files should be included in any solution.+ getMaximumBytes :: Data.File.FileSize, -- ^ The maximum space (in bytes) available in which to store a subset of the specified files.+ getMaybeRandomSeed :: Maybe Int, -- ^ Optionally seed the random-number generator to produce a repeatable pseudo-random sequence.+ getMinimumUsageRatio :: ratio, -- ^ The minimum acceptable usage-ratio of 'getMaximumBytes'.+ getVerbosity :: Distribution.Verbosity.Verbosity -- ^ Set the threshold for ancillary information-output.+} deriving (Eq, Show)++instance Fractional f => ToolShed.Defaultable.Defaultable (CommandOptions f) where+ defaultValue = MkCommandOptions {+ getIncludeEmpty = False,+ getMaximumBytes = 4700000000, -- DVD-size; just under 4.4GiB.+ getMaybeRandomSeed = Nothing,+ getMinimumUsageRatio = 9 / 10, -- 90% full.+ getVerbosity = Distribution.Verbosity.normal+ }++instance (Ord ratio, Real ratio) => ToolShed.SelfValidate.SelfValidator (CommandOptions ratio) where+ getErrors commandOptions = map snd $ filter (($ commandOptions) . fst) [+ ((< 0) . getMaximumBytes, "invalid maximumBytes; " ++ show (getMaximumBytes commandOptions)),+ ((< 0) . getMinimumUsageRatio, "invalid minimumUsageRatio; " ++ show (realToFrac $ getMinimumUsageRatio commandOptions :: Double)),+ ((> 1) . getMinimumUsageRatio, "invalid minimumUsageRatio; " ++ show (realToFrac $ getMinimumUsageRatio commandOptions :: Double))+ ]++-- | Smart constructor.+mkCommandOptions+ :: (+ Ord ratio,+ Real ratio+ )+ => Bool+ -> Data.File.FileSize+ -> Maybe Int+ -> ratio+ -> Distribution.Verbosity.Verbosity+ -> CommandOptions ratio+mkCommandOptions includeEmpty maximumBytes maybeRandomSeed minimumUsageRatio verbosity+ | ToolShed.SelfValidate.isValid commandOptions = commandOptions+ | otherwise = error $ "Squeeze.Data.CommandOptions.mkCommandOptions:\t" ++ ToolShed.SelfValidate.getFirstError commandOptions+ where+ commandOptions = MkCommandOptions includeEmpty maximumBytes maybeRandomSeed minimumUsageRatio verbosity++-- | Derives the minimum number of bytes, from other options.+deriveMinimumBytes :: RealFrac ratio => CommandOptions ratio -> Data.File.FileSize+deriveMinimumBytes = floor . uncurry (*) . (getMinimumUsageRatio &&& realToFrac . getMaximumBytes)++-- | Reduce the requirements by the specified file-size.+subtractFile+ :: RealFrac ratio+ => Data.File.FileSize+ -> CommandOptions ratio+ -> CommandOptions ratio+subtractFile fileSize commandOptions+ | fileSize < 0 = error $ "Squeeze.Data.CommandOptions.subtractFile:\tnegative file-size=" ++ show fileSize+ | maximumBytes' < 0 = error $ "Squeeze.Data.CommandOptions.subtractFile:\tfile-size=" ++ show fileSize ++ " > maximum=" ++ show maximumBytes+ | otherwise = commandOptions {+ getMaximumBytes = maximumBytes',+ getMinimumUsageRatio = if maximumBytes' == 0+ then 0 -- CAVEAT: the calculation below would otherwise attempt to evaluate 0 / 0.+ else fromIntegral (max 0 $ deriveMinimumBytes commandOptions - fileSize) / fromIntegral maximumBytes'+ } where+ maximumBytes, maximumBytes' :: Data.File.FileSize+ maximumBytes = getMaximumBytes commandOptions+ maximumBytes' = maximumBytes - fileSize++-- | The bounds on the aggregate size of the set of files.+solutionSizeBounds :: RealFrac f => CommandOptions f -> Factory.Data.Interval.Interval Data.File.FileSize+solutionSizeBounds = deriveMinimumBytes &&& getMaximumBytes+
+ src-lib/Squeeze/Data/File.hs view
@@ -0,0 +1,164 @@+{-+ Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Defines file-related type-synonyms, and associated operations.+-}++module Squeeze.Data.File(+-- * Types+-- ** Type-synonyms+ FilePathList,+ FileSize,+ FileSizeAndPath,+-- * Functions+ accumulateSize,+ aggregateSize,+-- expandDirectory,+ findDuplicates,+-- findSize,+ findSizes,+ orderByIncreasingSize,+ orderByDecreasingSize,+ getFileSizeStatistics,+ selectSuitableFileSizes,+-- ** Accessors+ getSize,+ getPath,+-- ** Predicates+ hasSizeBy+) where++import Control.Arrow((&&&))+import qualified Control.Monad+import qualified Control.Monad.Writer+import qualified Data.List+import qualified Data.Ord+import qualified Factory.Math.Statistics+import qualified System.Directory+import System.FilePath((</>))+import qualified System.IO+import qualified ToolShed.Data.Foldable++-- | A type suitable for containing an arbitrary set of file-paths.+type FilePathList = [System.IO.FilePath]++-- | A type-synonym specifically to hold file-sizes (in bytes).+type FileSize = Integer -- Matches the return-type of 'IO.hFileSize'.++-- | A type suitable for containing a file-path, qualified by the corresponding 'FileSize'.+type FileSizeAndPath = (FileSize, System.IO.FilePath)++-- | Accessor.+getSize :: FileSizeAndPath -> FileSize+getSize = fst++-- | Accessor.+getPath :: FileSizeAndPath -> System.IO.FilePath+getPath = snd++-- | Sum the 'FileSize's in the specified list.+aggregateSize :: [FileSizeAndPath] -> FileSize+aggregateSize = foldr ((+) . getSize) 0++{- |+ * Returns the cumulative sequence of sizes, as each file is prepended to the specified list.++ * CAVEAT: the list-length is one greater than that supplied, since the last element represents the size with zero files.+-}+accumulateSize :: [FileSizeAndPath] -> [FileSize]+accumulateSize = scanr ((+) . getSize) 0++{- |+ * Recursively descend the specified path, accumulating a list of files.++ * CAVEAT: all non-directory files are returned; devices, pipes, sockets, symlinks ...+-}+expandDirectory :: System.IO.FilePath -> IO FilePathList+expandDirectory filePath = do+ directoryExists <- System.Directory.doesDirectoryExist filePath++ if directoryExists+ then System.Directory.getDirectoryContents filePath >>= fmap concat . mapM (+ expandDirectory {-recurse-} . (filePath </>) {-qualify the path-}+ ) . filter (+ `notElem` [".", ".."] -- Prevent infinite recursion.+ )+ else {-non-directory-} return {-to IO-monad-} [filePath] -- CAVEAT: this could include non-existent paths, devices, pipes, sockets, symlinks ...++{- |+ * Finds any file-paths which have been specified more than once.++ * This includes files which have been implicitly specified via a directory.+-}+findDuplicates :: FilePathList -> IO FilePathList+findDuplicates = fmap (map head . filter ((> 1) . length) . ToolShed.Data.Foldable.gather . concat) . mapM expandDirectory++{- |+ * Get the size of a file, treating a directory as an atomic unit.++ * CAVEAT: the size of a symlink, is that of the file to which it refers.+-}+findSize :: System.IO.FilePath -> IO FileSize+findSize filePath = expandDirectory filePath >>= fmap aggregateSize . mapM (\f -> flip (,) f `fmap` System.IO.withFile f System.IO.ReadMode System.IO.hFileSize)++-- | Finds file-sizes.+findSizes :: FilePathList -> IO [FileSizeAndPath]+findSizes = uncurry fmap . (flip zip &&& mapM findSize)++-- | Sorts a list of 'FileSizeAndPath' by increasing size; ie. smallest first.+orderByIncreasingSize :: [FileSizeAndPath] -> [FileSizeAndPath]+orderByIncreasingSize = Data.List.sortBy $ Data.Ord.comparing getSize++-- | Sorts a list of 'FileSizeAndPath' by decreasing size; ie. smallest first.+orderByDecreasingSize :: [FileSizeAndPath] -> [FileSizeAndPath]+orderByDecreasingSize = reverse . orderByIncreasingSize++-- | True if the specified file has the required size according to the specified predicate.+hasSizeBy+ :: (FileSize -> Bool) -- ^ The predicate.+ -> FileSizeAndPath -- ^ The file-parameters to be tested.+ -> Bool+hasSizeBy predicate = predicate . getSize++-- | Acquire statistics related to a list of files.+getFileSizeStatistics+ :: (Fractional mean, Floating standardDeviation)+ => [FileSizeAndPath]+ -> (Int, FileSize, mean, standardDeviation) -- ^ (Number of components, Aggregate size, Mean size, Standard-deviation).+getFileSizeStatistics l = (+ length l,+ sum sizes,+ Factory.Math.Statistics.getMean sizes,+ Factory.Math.Statistics.getStandardDeviation sizes+ ) where+ sizes = map getSize l++{- |+ * Partitions the specified list of file-sizes & paths, into those whose size is suitable according to the specified predicate & those which are unsuitable.++ * Logs the results.+-}+selectSuitableFileSizes :: (FileSize -> Bool) -> [FileSizeAndPath] -> Control.Monad.Writer.Writer [String] [FileSizeAndPath]+selectSuitableFileSizes predicate fileSizeAndPathList = let+ (accepted, rejected) = Data.List.partition (hasSizeBy predicate) fileSizeAndPathList+ in do+ Control.Monad.unless (null rejected) $ Control.Monad.Writer.tell ["WARNING: rejecting files of unsuitable size; " ++ show rejected ++ "."]++ return {-to Writer-monad-} accepted+
+ src-lib/Squeeze/Data/FileCombination.hs view
@@ -0,0 +1,164 @@+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] A data-type which references a set of files by their paths, and qualifies them with their aggregate size.+-}++module Squeeze.Data.FileCombination(+-- * Types+-- ** Data-types+ FileCombination(+-- MkFileCombination,+ getAggregateFileSize,+ getFilePathList+ ),+-- * Constants+ nullFileCombination,+-- * Functions+ comparingAggregateFileSize,+ prepend,+ risingFilter,+-- risingMerge,+ risingMergeByAggregateFileSize,+-- ** Constructors+ mkFileCombination,+ singleton,+-- ** Predicates+ hasSizeBy+) where++import qualified Data.List+import qualified Data.Ord+import qualified Squeeze.Data.File as Data.File+import qualified ToolShed.Data.Foldable+import qualified ToolShed.SelfValidate++-- | Declare a list of files qualified by its aggregate size.+data FileCombination = MkFileCombination {+ getAggregateFileSize :: !Data.File.FileSize, -- ^ The aggregate size of the files referenced by 'getFilePathList'.+ getFilePathList :: Data.File.FilePathList -- ^ A list of paths, defining a set of files.+} deriving Eq++instance Show FileCombination where+ showsPrec _ fileCombination = shows (getAggregateFileSize fileCombination) . showChar '\t' . shows (Data.List.sort $ getFilePathList fileCombination)++instance ToolShed.SelfValidate.SelfValidator FileCombination where+ getErrors fileCombination = ToolShed.SelfValidate.extractErrors [+ (+ getAggregateFileSize fileCombination < 0,+ "aggregate size must be positive; " ++ show fileCombination+ ), (+ getAggregateFileSize fileCombination /= 0 && null (getFilePathList fileCombination),+ "when zero files are specified, the aggregate size must also be zero; " ++ show fileCombination+ ), let+ duplicateFilePaths = map head . filter ((> 1) . length) . ToolShed.Data.Foldable.gather $ getFilePathList fileCombination+ in (+ not $ null duplicateFilePaths,+ "duplicate file-paths have been specified; " ++ show duplicateFilePaths+ )+ ]++-- | A constant empty instance.+nullFileCombination :: FileCombination+nullFileCombination = MkFileCombination 0 []++-- | Smart constructor.+mkFileCombination :: Data.File.FileSize -> Data.File.FilePathList -> FileCombination+mkFileCombination fileSize filePathList+ | ToolShed.SelfValidate.isValid fileCombination = fileCombination+ | otherwise = error $ "Squeeze.Data.FileCombination.mkFileCombination:\t" ++ ToolShed.SelfValidate.getFirstError fileCombination+ where+ fileCombination = MkFileCombination fileSize filePathList++-- | Construct a 'FileCombination' from a single 'Data.File.FileSizeAndPath'.+singleton :: Data.File.FileSizeAndPath -> FileCombination+singleton (fileSize, filePath) = mkFileCombination fileSize [filePath]++{- |+ * Prepend a 'Data.File.FileSizeAndPath' to an existing 'FileCombination'.++ * CAVEAT: performance hot-spot, so it by-passes the checks made by 'mkFileCombination'.+-}+{-# INLINE prepend #-}+prepend+ :: Data.File.FileSizeAndPath -- ^ The new path to prepend to the incumbent file-combination.+ -> FileCombination -- ^ The incumbent combination of files.+ -> FileCombination+prepend (fileSize, filePath) fileCombination = MkFileCombination {+ getAggregateFileSize = fileSize + getAggregateFileSize fileCombination,+ getFilePathList = filePath : getFilePathList fileCombination+}++-- | Predicate used to determine whether a specific file-combination matches a size-related requirement.+{-# INLINE hasSizeBy #-}+hasSizeBy+ :: (Data.File.FileSize -> Bool) -- ^ The predicate.+ -> FileCombination -- ^ The input datum to be tested.+ -> Bool+hasSizeBy predicate = predicate . getAggregateFileSize++-- | Progressively raises the selection-criterion as each match is found, to produce monotonically increasing file-combinations.+risingFilter+ :: Data.File.FileSize -- ^ The initial minimum byte-size of file to accept.+ -> [FileCombination] -- ^ The input list of files to filter.+ -> [FileCombination] -- ^ The resulting list of files, which have met rising criterion.+risingFilter _ [] = []+risingFilter minimumSize (x : xs)+ | aggregateFileSize >= minimumSize = x : risingFilter aggregateFileSize xs+ | otherwise = risingFilter minimumSize xs+ where+ aggregateFileSize = getAggregateFileSize x++{- |+ * Merges two lists of monotonically increasing values, into a single monotonically increasing list, by dropping values which compare less than results already found.++ * CAVEAT: both lists must produce an element, in order to determine which is selected.+ As a result, though one list produces a value, it can't be returned until the other does (which make take a long time), even if ultimately the first is then selected.+-}+risingMerge+ :: (FileCombination -> FileCombination -> Ordering) -- ^ Comparator used to select the best file-combination from the heads of the two list supplied.+ -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination]+risingMerge cmp = slave nullFileCombination where+ lessThan bar = (== LT) . (`cmp` bar)++ slave bar [] r = dropWhile (lessThan bar) r+ slave bar l [] = dropWhile (lessThan bar) l+ slave _ (x : xs) (y : ys)+ | o == GT = x : slave x xs ys+ | o == LT = y : slave y xs ys+ | otherwise = x : y : slave x xs ys+ where+ o = x `cmp` y++-- Compares two /file-combination/s by their aggregate file-size.+comparingAggregateFileSize :: FileCombination -> FileCombination -> Ordering+comparingAggregateFileSize = Data.Ord.comparing getAggregateFileSize++{- |+ Merges two lists of monotonically increasing lists of file-combinations,+ into a single monotonically increasing list,+ by dropping values which have a smaller aggregate size than results already found.+-}+risingMergeByAggregateFileSize+ :: [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination]+risingMergeByAggregateFileSize = risingMerge comparingAggregateFileSize
+ src-lib/Squeeze/Squeeze.hs view
@@ -0,0 +1,176 @@+{-+ Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@]++ * Returns combinations of the specified files, which fit into the available space, without wasting more than the specified ratio.++ * Any directory-names are treated as atomic units, rather than individual files.++ * Because of the exponential growth of possible combinations,+ an /exact/ match for the available space is frequently found with a surprisingly small set of files.+-}++module Squeeze.Squeeze(+-- * Functions+ findCombinations,+ findBestFit,+ distributeAndFindBestFit,+ partitionEmptyFilesAndDistributeAndFindBestFit+) where++import qualified Control.Arrow+import Control.Arrow((&&&))+import qualified Control.Concurrent+import qualified Control.Monad+import qualified Data.List+import qualified Factory.Data.Interval+import qualified Squeeze.Control.Concurrent.DivideAndConquer as Control.Concurrent.DivideAndConquer+import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import qualified Squeeze.Data.File as Data.File+import qualified Squeeze.Data.FileCombination as Data.FileCombination+import qualified System.IO++{- |+ * Checks that the total aggregate 'Data.File.FileSize', meets or exceeds 'minimumBytes'.++ * Drops excessively large files, assuming that the file-list has been sorted by size, largest first.++ * Generates up to @2^n@ combinations of the @n@ specified files; the algorithm is similar to 'Data.List.subsequences', except that unproductive lines are immediately terminated.+ This is the performance bottle-neck, and though there may be simpler and faster algorithms, the key attribute is that it operates in constant space.++ * CAVEAT: assumes files have been sorted by decreasing size.++ * The algorithm is stable, in that it maintains the specified file-order within each combination;+ though the order in which the combinations are concatenated is rather arbitrary.+-}+findCombinations+ :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible aggregate size, for file-combinations.+ -> [Data.File.FileSizeAndPath] -- ^ The list of file-names & sizes, ordered by decreasing size.+ -> [Data.FileCombination.FileCombination] -- ^ The resulting unordered list of suitable file-combinations.+findCombinations (minimumCombinationSize, maximumCombinationSize) = filter (+ Data.FileCombination.hasSizeBy (>= minimumCombinationSize)+ ) . (+ Data.FileCombination.nullFileCombination :+ ) . nonEmptyCombinations minimumCombinationSize . uncurry zip . (+ id &&& Data.File.accumulateSize -- Associate the list of possible files with its accumulating size.+ ) . dropWhile (+ Data.File.hasSizeBy (> maximumCombinationSize) -- Remove files which individually exceed the maximum permissible; assuming they've been sorted by decreasing size.+ ) where+ nonEmptyCombinations :: Data.File.FileSize -> [(Data.File.FileSizeAndPath, Data.File.FileSize)] -> [Data.FileCombination.FileCombination]+ nonEmptyCombinations _ [] = []+ nonEmptyCombinations minimumBytes ((fileSizeAndPath, aggregateSize) : remainder)+ | aggregateSize < minimumBytes = [] -- Even if all the files are selected, the minimum-size criterion won't be satisfied.+ | otherwise = Data.FileCombination.singleton fileSizeAndPath : foldr binaryChoice [] (+ nonEmptyCombinations (minimumBytes - Data.File.getSize fileSizeAndPath) remainder -- Recurse.+ )+ where+ binaryChoice :: Data.FileCombination.FileCombination -> [Data.FileCombination.FileCombination] -> [Data.FileCombination.FileCombination]+ binaryChoice combinationExcluding+ | Data.FileCombination.hasSizeBy (<= maximumCombinationSize) combinationIncluding = (combinationExcluding :) . (combinationIncluding :)+ | otherwise = (combinationExcluding :)+ where+ combinationIncluding :: Data.FileCombination.FileCombination+ combinationIncluding = Data.FileCombination.prepend fileSizeAndPath combinationExcluding++-- | Orders the files by decreasing size, calls 'findCombinations', calls 'Data.FileCombination.risingFilter' to select progressively better solutions.+findBestFit+ :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible sizes for file-combinations.+ -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names & sizes.+ -> [Data.FileCombination.FileCombination] -- ^ A reduced list of increasingly suitable file-combinations.+findBestFit solutionSizeBounds = Data.FileCombination.risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . findCombinations solutionSizeBounds . Data.File.orderByDecreasingSize {-which makes findCombinations faster-}++{- |+ * Recursively bisects the task, distributing the sub-tasks to 'findBestFit', to utilise the available CPU-cores.++ * The task is bisected by removing the smallest file, then solving the remaining problem for two independent cases; that the selected file is excluded or the selected file is included, in the final solution.+ Selecting the smallest file rather than the largest, seems to balance the load of the sub-tasks more evenly.+ CAVEAT: no account has been taken of the possibility that the smallest file has size zero, which makes the sub-tasks identical.++ * Recombines the part solutions to finds the single monotonically increasing list of file-combinations matching the original criteria.++ * CAVEAT: whilst the ultimate solution is similar, regardless of the specified number of CPU-cores available, the path leading to it typically differs.+-}+distributeAndFindBestFit+ :: RealFrac ratio+ => Data.CommandOptions.CommandOptions ratio+ -> [Data.File.FileSizeAndPath] -- ^ The unordered list of files & sizes.+ -> IO [Data.FileCombination.FileCombination]+distributeAndFindBestFit commandOptions fileSizeAndPathList = let+ slave _ _ [] = return {-to IO-monad-} [Data.FileCombination.nullFileCombination]+ slave 1 commandOptions' increasingFileSizeAndPathList = let+ solutionSizeBounds = Data.CommandOptions.solutionSizeBounds commandOptions'+ in do+ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions' == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "INFO: acceptable file-size interval " ++ show solutionSizeBounds ++ " bytes."++ return {-to IO-monad-} $ findBestFit solutionSizeBounds increasingFileSizeAndPathList -- Delegate the task to the single-threaded algorithm.+ slave numCapabilities' commandOptions' (selectedFileSizeAndPath {-the smallest-} : remainingFileSizeAndPaths) = let+ recurse = slave $ numCapabilities' `div` 2 -- Partially apply.+ in do+ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions' == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "INFO: " ++ show numCapabilities' ++ " CPU-cores => bisecting task into those, with & without " ++ show selectedFileSizeAndPath ++ "."++ fileCombinationsExcludingSelected <- recurse commandOptions' {-i.e the original space-} remainingFileSizeAndPaths -- This is about half the total task.++ let+ commandOptions'' = Data.CommandOptions.subtractFile (Data.File.getSize selectedFileSizeAndPath) commandOptions' -- Reduce the requirements by the size of the selected file.++ if Data.CommandOptions.getMaximumBytes commandOptions'' < 0+ then return {-to IO-monad-} fileCombinationsExcludingSelected -- The selected file won't fit.+ else map (+ Data.FileCombination.prepend selectedFileSizeAndPath -- Prepend the selected file to all file-combinations.+ ) `fmap` recurse commandOptions'' remainingFileSizeAndPaths >>= Control.Concurrent.DivideAndConquer.divideAndConquer Data.FileCombination.risingMergeByAggregateFileSize fileCombinationsExcludingSelected -- Merge the part-solutions.+ in Control.Concurrent.getNumCapabilities >>= (\numCapabilities -> slave numCapabilities commandOptions $ Data.File.orderByIncreasingSize fileSizeAndPathList)++{- |+ * Neither 'distributeAndFindBestFit' nor 'findBestFit' distinguish between empty & non-empty files,+ but empty files cause significant inefficiency in the former (where the same calculation is performed multiple times)+ & could be treated much more efficiently in the latter (since they're potentially a member of any other solution).++ * This function side-lines empty files, delegates the remaining problem to 'distributeAndFindBestFit' (& consequently 'findBestFit'),+ then prepends combinations of empty files to the resulting combinations of non-empty files.+-}+partitionEmptyFilesAndDistributeAndFindBestFit+ :: RealFrac ratio+ => Data.CommandOptions.CommandOptions ratio+ -> [Data.File.FileSizeAndPath] -- ^ The unordered list of files & sizes.+ -> IO [Data.FileCombination.FileCombination]+partitionEmptyFilesAndDistributeAndFindBestFit commandOptions fileSizeAndPathList+ | Data.CommandOptions.getIncludeEmpty commandOptions = do+ printStatistics fileSizeAndPathList++ concatMap (+ \fileCombination -> map (+ \emptyFilePathCombination -> fileCombination {+ Data.FileCombination.getFilePathList = emptyFilePathCombination ++ Data.FileCombination.getFilePathList fileCombination+ }+ ) $ Data.List.subsequences {-find all combinations-} emptyFiles+ ) `fmap` nonEmptyFileCombinations+ | otherwise {-exclude empty files-} = do+ Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null emptyFiles) . System.IO.hPutStrLn System.IO.stderr $ "WARNING: rejecting empty files; " ++ show emptyFiles ++ "."++ Control.Monad.when (null nonEmptyFilePathAndSizeList) $ fail "there are zero non-empty files"++ printStatistics nonEmptyFilePathAndSizeList++ nonEmptyFileCombinations+ where+ printStatistics l = Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null l) . System.IO.hPutStrLn System.IO.stderr $ "INFO: file-(count, aggregate size, mean, standard-deviation); " ++ show (Data.File.getFileSizeStatistics l :: (Int, Data.File.FileSize, Float, Float)) ++ "."+ (emptyFiles, nonEmptyFilePathAndSizeList) = Control.Arrow.first (map Data.File.getPath) $ Data.List.partition (Data.File.hasSizeBy (== 0)) fileSizeAndPathList+ nonEmptyFileCombinations = distributeAndFindBestFit commandOptions nonEmptyFilePathAndSizeList -- Delegate.+
+ src-test/Main.hs view
@@ -0,0 +1,45 @@+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@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 Squeeze.Test.Data.FileCombinations as Test.Data.FileCombinations+import qualified Squeeze.Test.Squeeze as Test.Squeeze+import qualified System.Exit+import qualified ToolShed.Test.QuickCheck.Result++-- | Entry-point.+main :: IO ()+main = mapM_ (+ snd {-exit-status-} . (+ putStrLn . (++ ":") *** (+ >>= (`Control.Monad.unless` System.Exit.exitFailure) . all ToolShed.Test.QuickCheck.Result.isSuccessful+ )+ )+ ) [+ ("Data.FileCombinations", Test.Data.FileCombinations.results),+ ("Squeeze", Test.Squeeze.results)+ ]
+ src-test/Squeeze/Test/Data/CommandOptions.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.CommandOptions.CommandOptions'.+-}++module Squeeze.Test.Data.CommandOptions(+-- * Types+-- ** Type-synonyms+ CommandOptions+) where++import qualified Test.QuickCheck+import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import Squeeze.Test.Data.Verbosity()++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative((<$>), (<*>))+#endif++instance (+ Enum ratio,+ Fractional ratio,+ Ord ratio,+ Real ratio,+ Test.QuickCheck.Arbitrary ratio+ ) => Test.QuickCheck.Arbitrary (Data.CommandOptions.CommandOptions ratio) where+ arbitrary = Data.CommandOptions.mkCommandOptions <$> Test.QuickCheck.arbitrary {-includeEmpty-} <*> (+ abs <$> Test.QuickCheck.arbitrary -- maximumBytes.+ ) <*> Test.QuickCheck.arbitrary {-maybeRandomSeed-} <*> (+ recip . succ . abs <$> Test.QuickCheck.arbitrary -- minimumUsageRatio.+ ) <*> Test.QuickCheck.arbitrary {-verbosity-}++-- | Defines a concrete type for testing.+type CommandOptions = Data.CommandOptions.CommandOptions Double+
+ src-test/Squeeze/Test/Data/FileCombinations.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-+ Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Defines tests to dynamically verify the module "Squeeze.Data.FileCombinations" against arbitrary data.+-}++module Squeeze.Test.Data.FileCombinations(+-- * Constants+ results+) where++import Control.Arrow((&&&))+import qualified Data.List+import qualified Squeeze.Data.FileCombination as Data.FileCombination+import qualified Test.QuickCheck++instance Test.QuickCheck.Arbitrary Data.FileCombination.FileCombination where+ arbitrary = do+ filePathList <- Data.List.nub `fmap` (Test.QuickCheck.elements [0 .. 99] >>= Test.QuickCheck.vector)+ aggregateFileSize <- Test.QuickCheck.elements [0 .. Data.List.genericLength filePathList] -- Assume files of size either zero or one byte.++ return $ Data.FileCombination.mkFileCombination aggregateFileSize filePathList++-- | The constant test-results for this data-type.+results :: IO [Test.QuickCheck.Result]+results = mapM Test.QuickCheck.quickCheckResult [prop_risingFilter, prop_risingFilter', prop_risingMergeByAggregateFileSize] where+ prop_risingFilter, prop_risingFilter', prop_risingMergeByAggregateFileSize :: [Data.FileCombination.FileCombination] -> Test.QuickCheck.Property+ prop_risingFilter = Test.QuickCheck.label "prop_risingFilter" . uncurry (==) . (id &&& Data.List.sort) . map Data.FileCombination.getAggregateFileSize . Data.FileCombination.risingFilter 0+ prop_risingFilter' = Test.QuickCheck.label "prop_risingFilter'" . uncurry (==) . (id &&& Data.FileCombination.risingFilter 0) . Data.List.sortBy Data.FileCombination.comparingAggregateFileSize++ prop_risingMergeByAggregateFileSize = Test.QuickCheck.label "prop_risingMergeByAggregateFileSize" . uncurry (==) . (+ id &&& map head . Data.List.group . uncurry Data.FileCombination.risingMergeByAggregateFileSize . (id &&& id)+ ) . Data.FileCombination.risingFilter 0+
+ src-test/Squeeze/Test/Data/Verbosity.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-+ 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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Distribution.Verbosity.Verbosity'.+-}++module Squeeze.Test.Data.Verbosity() where++import qualified Distribution.Verbosity+import qualified Test.QuickCheck++instance Test.QuickCheck.Arbitrary Distribution.Verbosity.Verbosity where+ arbitrary = Test.QuickCheck.elements [minBound .. maxBound]
+ src-test/Squeeze/Test/Squeeze.hs view
@@ -0,0 +1,70 @@+{-+ Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@] Defines tests to dynamically verify the module "Squeeze.Squeeze" against arbitrary data.+-}++module Squeeze.Test.Squeeze(+-- * Constants+ results+) where++import Control.Arrow((&&&))+import qualified Data.List+import qualified Factory.Data.Interval+import qualified Squeeze.Data.File as Data.File+import qualified Squeeze.Data.FileCombination as Data.FileCombination+import qualified Squeeze.Squeeze as Squeeze+import qualified Test.QuickCheck+import qualified ToolShed.Data.Foldable+import qualified ToolShed.Data.List++-- | The constant test-results for this data-type.+results :: IO [Test.QuickCheck.Result]+results = mapM Test.QuickCheck.quickCheckResult [prop_totalCombinations, prop_fileSizeBounds, prop_allFiles, prop_monotonicFileSize, prop_uniqueFileNames] where+ mkFileSizeAndPathList :: (Integral i, Show i) => [i] -> [Data.File.FileSizeAndPath]+ mkFileSizeAndPathList = take 12 . Data.List.nubBy (ToolShed.Data.List.equalityBy snd) . map (toInteger . abs &&& show) -- CAVEAT: may be shorter than requested.++ prop_totalCombinations, prop_fileSizeBounds, prop_allFiles, prop_monotonicFileSize, prop_uniqueFileNames :: [Integer] -> Test.QuickCheck.Property+ prop_totalCombinations integers = Test.QuickCheck.label "prop_totalCombinations" $ (length . Data.List.nub . Squeeze.findCombinations (0, fromIntegral (maxBound :: Int)) $ Data.File.orderByDecreasingSize fileSizeAndPathList) == 2 ^ length fileSizeAndPathList where+ fileSizeAndPathList = mkFileSizeAndPathList integers++ prop_fileSizeBounds integers = Test.QuickCheck.label "prop_fileSizeBounds" . all ((`Factory.Data.Interval.elem'` fileSizeBounds) . Data.FileCombination.getAggregateFileSize) . Squeeze.findCombinations fileSizeBounds $ Data.File.orderByDecreasingSize fileSizeAndPathList where+ fileSizeAndPathList = mkFileSizeAndPathList integers++ fileSizeBounds :: Factory.Data.Interval.Interval Data.File.FileSize+ fileSizeBounds = (minimumBytes, maximumBytes) where+ maximumBytes, minimumBytes :: Data.File.FileSize+ maximumBytes = round $ fromIntegral (Data.File.aggregateSize fileSizeAndPathList) / (4.0 :: Double) -- Arbitrarily.+ minimumBytes = maximumBytes `div` 2 -- Arbitrarily.++ prop_allFiles integers = Test.QuickCheck.label "prop_allFiles" . (== aggregateSize) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (Factory.Data.Interval.precisely aggregateSize) fileSizeAndPathList where+ fileSizeAndPathList = mkFileSizeAndPathList integers++ aggregateSize :: Data.File.FileSize+ aggregateSize = Data.File.aggregateSize fileSizeAndPathList++ prop_monotonicFileSize integers = Test.QuickCheck.label "prop_monotonicFileSize" . uncurry (==) . (id &&& Data.List.sort {-stable-}) . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (0, fromIntegral (maxBound :: Int)) fileSizeAndPathList where+ fileSizeAndPathList = mkFileSizeAndPathList integers++ prop_uniqueFileNames integers = Test.QuickCheck.label "prop_uniqueFileNames" . all (+ all ((== 1) . length) . ToolShed.Data.Foldable.gather . Data.FileCombination.getFilePathList+ ) $ Squeeze.findBestFit (0, fromIntegral (maxBound :: Int)) fileSizeAndPathList where+ fileSizeAndPathList = mkFileSizeAndPathList integers+
− src/Main.hs
@@ -1,249 +0,0 @@-{-# OPTIONS_GHC -fcontext-stack=24 #-}-{-- Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@]-- * Contains the entry-point of the application.-- * Processes the command-line arguments.-- * Delegates the task to 'Squeeze.findBestFit', potentially on multiple threads.--}--module Main(main) where--import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol.-import Control.Applicative((<*>), (<$>))-import qualified Control.Monad-import qualified Control.Monad.Writer-import qualified Data.List-import qualified Data.Maybe-import qualified Data.Version-import qualified Distribution.Package-import qualified Distribution.Text-import qualified Distribution.Verbosity-import qualified Distribution.Version-import qualified Factory.Math.Probability-import qualified Paths_squeeze as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'.-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions-import qualified Squeeze.Data.File as Data.File-import qualified Squeeze.Squeeze as Squeeze-import qualified Squeeze.Test.Performance as Test.Performance-import qualified Squeeze.Test.QuickChecks as Test.QuickChecks-import qualified System.Console.GetOpt as G-import qualified System.Environment-import qualified System.Exit-import qualified System.FilePath-import qualified System.Info-import qualified System.IO-import qualified System.IO.Error-import qualified Text.Printf-import qualified ToolShed.Data.List-import qualified ToolShed.Defaultable-import qualified ToolShed.SelfValidate-import qualified ToolShed.System.TimeAction---- | Coerce the polymorphic data-type to concrete instance, in order that it's fields may be read from the command-line.-type CommandOptions' = Data.CommandOptions.CommandOptions Rational -- 'Double' would also be a suitable type-parameter.---- | Used to thread user-defined command-line options, though the list of functions which implement them.-type CommandLineAction = CommandOptions' -> IO CommandOptions' -- Supplied as the type-argument to 'G.OptDescr'.---- | On failure to parse the specified string, returns an explanatory error.-read' :: Read a => String -> String -> a-read' errorMessage s = case reads s of- [(x, "")] -> x- _ -> error $ errorMessage ++ show s---- | On failure to parse a command-line argument, returns an explanatory error.-readCommandArg :: Read a => String -> a-readCommandArg = read' "failed to parse command-line argument "---- | Reads a bounded integral from the command-line, guarding against overflow.-readBoundedIntegral :: Integral i => String -> i-readBoundedIntegral s- | fromIntegral bounded /= unbounded = error $ "integral value exceeds permissible bounds; " ++ show unbounded ++ "."- | otherwise = bounded- where- unbounded = readCommandArg s- bounded = fromInteger unbounded--{- |- * Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', which over-ride the default value.-- * Any arguments which follow known 'Data.CommandOptions.CommandOptions',- are interpreted as file-names to consider when attempting to find a suitable fit for the specified space-constraints.-- * If the specified file-name is /-/, then the actual file-names are read from /standard input/, to augment any other non-options specified.-- * Delegates the donkey-work to 'partitionEmptyFilesAndDistributeAndFindBestFit'.- Because this may take a long time, it prints the results in real time, rather than batching until the optimum has been determined.--}-main :: IO ()-main = do- progName <- System.Environment.getProgName-- let- defaultCommandOptions :: CommandOptions'- defaultCommandOptions = ToolShed.Defaultable.defaultValue-- defaultRandomSeed :: Int- defaultRandomSeed = 0-- optDescrList :: [G.OptDescr CommandLineAction]- optDescrList = [--- String [String] (G.ArgDescr CommandLineAction) String- G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help, & then exit.",- G.Option "" ["verbosity"] (- setVerbosity `G.ReqArg` ToolShed.Data.List.showListWith listDelimiters [minBound :: Distribution.Verbosity.Verbosity .. maxBound] ""- ) ("Define the log-level; default '" ++ show (Data.CommandOptions.getVerbosity defaultCommandOptions) ++ "'. CAVEAT: to be effective, it must precede other options."- ),- G.Option "v" ["version"] (G.NoArg $ const printVersion) "Print version-information, & then exit.",- G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.OptArg` "<Bool>") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."),- G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "<Int>") ("The maximum bytes of available space; default '" ++ show defaultMaximumBytes ++ "'."),- G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "<Float>") ("The minimum acceptable space usage-ratio; default '" ++ show (realToFrac $ Data.CommandOptions.getMinimumUsageRatio defaultCommandOptions :: Double) ++ "'."),- G.Option "q" ["runQuickChecks"] (G.NoArg runQuickChecks) "Test the implementation, by validating some invariant properties using arbitrary data; & then exit.",- G.Option "r" ["randomSeed"] (G.OptArg setRandomSeed "<Int>") ("Seed the random number-generator with the specified integer, to produce a repeatable pseudo-random sequence as required for performance-testing. If this option is unspecified then the seed is unpredictable, but if only its argument is unspecified then the seed defaults to '" ++ show defaultRandomSeed ++ "'. CAVEAT: to be effective, it must precede either 'testPerformanceContinuous' or 'testPerformanceDiscrete'."),- G.Option "" ["testPerformanceContinuous"] (- testPerformanceContinuous `G.ReqArg` "(<Int>, <ContinuousDistribution>)"- ) "Measure the CPU-seconds required to find the best fit, for the specified number of randomly generated virtual files, the size of which conform to the specified continuous probability-distribution; & then exit.",- G.Option "" ["testPerformanceDiscrete"] (- testPerformanceDiscrete `G.ReqArg` "(<Int>, <DiscreteDistribution>)"- ) "Measure the CPU-seconds required to find the best fit, for the specified number of randomly generated virtual files, the size of which conform to the specified discrete probability-distribution; & then exit."- ] where- listDelimiters = ('(', '|', ')')-- defaultMaximumBytes = Data.CommandOptions.getMaximumBytes defaultCommandOptions-- setMaximumBytes, setMinimumUsageRatio, setVerbosity, testPerformanceContinuous, testPerformanceDiscrete :: String -> CommandLineAction- setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaximumBytes = readCommandArg arg }- setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMinimumUsageRatio = realToFrac (readCommandArg arg :: Double) }- setVerbosity arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getVerbosity = readCommandArg arg }-- testPerformanceContinuous arg commandOptions- | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions- | otherwise = do- ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print {-force evaluation-}-- System.Exit.exitWith System.Exit.ExitSuccess- where- fileCount :: Int- probabilityDistribution :: Factory.Math.Probability.ContinuousDistribution Double- (fileCount, probabilityDistribution) = readCommandArg arg-- testPerformanceDiscrete arg commandOptions- | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions- | otherwise = do- ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print {-force evaluation-}-- System.Exit.exitWith System.Exit.ExitSuccess- where- fileCount :: Int- probabilityDistribution :: Factory.Math.Probability.DiscreteDistribution Double- (fileCount, probabilityDistribution) = readCommandArg arg-- setIncludeEmpty, setRandomSeed :: Maybe String -> CommandLineAction- setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getIncludeEmpty = Data.Maybe.maybe True readCommandArg arg }- setRandomSeed arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaybeRandomSeed = Just $ Data.Maybe.maybe defaultRandomSeed readBoundedIntegral arg }-- runQuickChecks :: (Num f, Ord f, Show f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f)- runQuickChecks _ = Test.QuickChecks.run >> System.Exit.exitWith System.Exit.ExitSuccess-- printVersion, printUsage :: IO (Data.CommandOptions.CommandOptions f)- printVersion = System.IO.hPutStrLn System.IO.stderr (- Distribution.Text.display packageIdentifier ++ "\n\nCompiled by " ++ show compiler ++ ".\n\nCopyright (C) 2010-2015 " ++ 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, compiler :: String- author = "Dr. Alistair Ward"- compiler = System.Info.compilerName ++ "-" ++ Data.List.intercalate "." (map show $ Data.Version.versionBranch System.Info.compilerVersion)-- printUsage = Text.Printf.hPrintf System.IO.stderr (- "Usage:\t%s %s\n\nEBNF argument-format:" ++ concat (- replicate 9 "\n\t%-22s = %s;" -- Argument-types & their EBNF-definition.- ) ++ "\n\nE.g.\n\t%s\n\t%s\n\t%s\n"- ) (- G.usageInfo progName optDescrList- ) "[<File-path> ...]" "Bool" "\"True\" | \"False\"\t(* case-sensitive *)" "ContinuousDistribution" "LogNormalDistribution location scale^2" "DiscreteDistribution" "PoissonDistribution lambda" "File-path" (- "File-name ('" ++ [System.FilePath.pathSeparator] ++ "' File-name)*"- ) "Float" "Int ('.' Int)?" "Int" "[0-9]+" "lambda" "Float\t(* the mean & variance of the distribution *)" "location" "Float\t(* the mean of the log of the distribution *)" "scale^2" "Float\t(* the variance of the log of the distribution *)" (- progName ++ " --verbosity=Verbose -M 700000000 *.ogg +RTS -N\t#Find the best-fit for the globbed file-names, into the space available on a CD, using multiple CPU-cores where available."- ) (- progName ++ " -r --testPerformanceContinuous='(100, LogNormalDistribution " ++ show (log ((fromIntegral defaultMaximumBytes / 12) / sqrt 2) :: Float) {-location-} ++ " " ++ show (log 2 :: Float) {-scale^2-} ++ ")'\t#Test performance."- ) (- progName ++ " -r --testPerformanceDiscrete='(100, PoissonDistribution " ++ show (defaultMaximumBytes `div` 12) {-lambda-} ++ ")'\t#Test performance."- ) >> System.Exit.exitWith System.Exit.ExitSuccess -- CAVEAT: requires increase to default context-stack.-- args <- System.Environment.getArgs---- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr CommandLineAction] -> [String] -> ([CommandLineAction], [String], [String])- case G.getOpt G.RequireOrder optDescrList args of- (commandLineActions, nonOptions, [{-errors-}]) -> do- commandOptions <- Data.List.foldl' (>>=) (- return {-to IO-monad-} ToolShed.Defaultable.defaultValue- ) {-transform using CommandLineAction-mutators-} commandLineActions -- ie: do o1 <- CommandLineAction[0] commandOptions[0]; o2 <- CommandLineAction[1] o1; ...-- if not $ ToolShed.SelfValidate.isValid commandOptions- then fail $ ToolShed.SelfValidate.getFirstError commandOptions- else if null nonOptions- then fail "zero file-paths specified"- else let- standardInputProxy = "-"- in do- filePaths <- Data.List.nub {-remove explicit duplicates-} <$> if standardInputProxy `elem` nonOptions- then let- getFilePaths :: IO Data.File.FilePathList- getFilePaths = do- eof <- System.IO.isEOF-- if eof- then return {-to IO-monad-} []- else {-more to read-} (:) <$> getLine <*> getFilePaths {-recurse-}- in do- filePaths <- (filter (/= standardInputProxy) nonOptions ++) <$> getFilePaths-- if null filePaths- then fail "zero file-paths"- else return filePaths- else {-real fileNames-} return {-to IO-monad-} nonOptions-- implicitDuplicateFilePaths <- Data.File.findDuplicates filePaths-- Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null implicitDuplicateFilePaths) . System.IO.hPutStrLn System.IO.stderr $ "WARNING: there are duplicate files implicit within those directories specified; " ++ show implicitDuplicateFilePaths ++ "."-- (acceptedFileSizeAndPathList, logFile) <- Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (<= Data.CommandOptions.getMaximumBytes commandOptions) <$> Data.File.findSizes filePaths-- Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null logFile) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile-- if null acceptedFileSizeAndPathList- then fail "there are zero suitable files"- else let- aggregateSize = Data.File.aggregateSize acceptedFileSizeAndPathList- minimumBytes = Data.CommandOptions.deriveMinimumBytes commandOptions- in if aggregateSize < minimumBytes- then fail $ "the aggregate size of all suitable files (" ++ show aggregateSize ++ " bytes), is insufficient to satisfy the minimum " ++ show minimumBytes ++ " bytes required"- else Squeeze.partitionEmptyFilesAndDistributeAndFindBestFit commandOptions acceptedFileSizeAndPathList >>= mapM_ print {-lazy evaluation-}- (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors-
− src/Squeeze/Control/Concurrent/DivideAndConquer.hs
@@ -1,77 +0,0 @@-{-- 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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@]-- Provides the capability to write two unevaluated lists to separate concurrent channels,- read them both & merge the results into a single list, evaluating in parallel, lazily on demand.--}--module Squeeze.Control.Concurrent.DivideAndConquer(--- * Types--- * Type-synonyms--- TerminatedChannel,--- * Functions--- writeListToChan,--- readListFromChan,- divideAndConquer-) where--import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol.-import Control.Applicative((<*>), (<$>))-import qualified Control.Concurrent-import qualified Control.Concurrent.Chan-import qualified System.IO.Unsafe-import qualified Control.Monad-import qualified Data.Maybe---- | A channel terminated by a sentinel.-type TerminatedChannel a = Control.Concurrent.Chan.Chan (Maybe a)---- | Write the specified list to the specified channel, terminating it with a sentinel.-writeListToChan :: TerminatedChannel a -> [a] -> IO ()-writeListToChan chan l = mapM_ (Control.Concurrent.Chan.writeChan chan . Just) l >> Control.Concurrent.Chan.writeChan chan Nothing {-sentinel-}--{- |- * Read the contents of the specified channel, up to the sentinel.-- * Any attempt to read beyond the sentinel, will block forever since the writer is out of data.--}-readListFromChan :: TerminatedChannel a -> IO [a]-readListFromChan chan = System.IO.Unsafe.unsafeInterleaveIO {-read lazily, on demand-} $ Control.Concurrent.Chan.readChan chan >>= Data.Maybe.maybe (- return {-to IO-monad-} []- ) (- \x -> (x :) <$> readListFromChan chan {-recurse-}- )---- | Writes the two unevaluated lists to separate concurrent channels, lazily reads them both (resulting in parallel evaluation) & merges them into a single results-list.-divideAndConquer- :: ([a] -> [a] -> [a]) -- ^ Merge-function, which reads from two channels, to produce a third.- -> [a] -- ^ Data for first channel.- -> [a] -- ^ Data for second channel.- -> IO [a]-divideAndConquer merge l r = do- chan0 <- Control.Concurrent.Chan.newChan- chan1 <- Control.Concurrent.Chan.newChan-- Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan0 l- Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan1 r-- merge <$> readListFromChan chan0 <*> readListFromChan chan1-
− src/Squeeze/Data/CommandOptions.hs
@@ -1,124 +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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@]-- * Defines options for program-operation.-- * Defines an appropriate default value, which is expected to be over-ridden on the command-line.-- * Self-validates.--}--module Squeeze.Data.CommandOptions(--- * Types--- ** Data-types- CommandOptions(--- MkCommandOptions,- getIncludeEmpty,- getMaybeRandomSeed,- getMaximumBytes,- getMinimumUsageRatio,- getVerbosity- ),--- * Functions- solutionSizeBounds,- deriveMinimumBytes,- subtractFile,--- ** Constructors- mkCommandOptions-) where--import Control.Arrow((&&&))-import qualified Distribution.Verbosity-import qualified Factory.Data.Interval-import qualified Squeeze.Data.File as Data.File-import qualified ToolShed.Defaultable-import qualified ToolShed.SelfValidate---- | Declares a record to contain command-line options.-data CommandOptions ratio = MkCommandOptions {- getIncludeEmpty :: Bool, -- ^ Whether empty directories or files should be included in any solution.- getMaximumBytes :: Data.File.FileSize, -- ^ The maximum space (in bytes) available in which to store a subset of the specified files.- getMaybeRandomSeed :: Maybe Int, -- ^ Optionally seed the random-number generator to produce a repeatable pseudo-random sequence.- getMinimumUsageRatio :: ratio, -- ^ The minimum acceptable usage-ratio of 'getMaximumBytes'.- getVerbosity :: Distribution.Verbosity.Verbosity -- ^ Set the threshold for ancillary information-output.-} deriving (Eq, Show)--instance Fractional f => ToolShed.Defaultable.Defaultable (CommandOptions f) where- defaultValue = MkCommandOptions {- getIncludeEmpty = False,- getMaximumBytes = 4700000000, -- DVD-size; just under 4.4GiB.- getMaybeRandomSeed = Nothing,- getMinimumUsageRatio = 99 / 100, -- 99% full.- getVerbosity = Distribution.Verbosity.normal- }--instance (Ord ratio, Real ratio) => ToolShed.SelfValidate.SelfValidator (CommandOptions ratio) where- getErrors commandOptions = map snd $ filter (($ commandOptions) . fst) [- ((< 0) . getMaximumBytes, "invalid maximumBytes; " ++ show (getMaximumBytes commandOptions)),- ((< 0) . getMinimumUsageRatio, "invalid minimumUsageRatio; " ++ show (realToFrac $ getMinimumUsageRatio commandOptions :: Double)),- ((> 1) . getMinimumUsageRatio, "invalid minimumUsageRatio; " ++ show (realToFrac $ getMinimumUsageRatio commandOptions :: Double))- ]---- | Smart constructor.-mkCommandOptions- :: (- Ord ratio,- Real ratio- )- => Bool- -> Data.File.FileSize- -> Maybe Int- -> ratio- -> Distribution.Verbosity.Verbosity- -> CommandOptions ratio-mkCommandOptions includeEmpty maximumBytes maybeRandomSeed minimumUsageRatio verbosity- | ToolShed.SelfValidate.isValid commandOptions = commandOptions- | otherwise = error $ "Squeeze.Data.CommandOptions.mkCommandOptions:\t" ++ ToolShed.SelfValidate.getFirstError commandOptions- where- commandOptions = MkCommandOptions includeEmpty maximumBytes maybeRandomSeed minimumUsageRatio verbosity---- | Derives the minimum number of bytes, from other options.-deriveMinimumBytes :: RealFrac ratio => CommandOptions ratio -> Data.File.FileSize-deriveMinimumBytes = floor . uncurry (*) . (getMinimumUsageRatio &&& realToFrac . getMaximumBytes)---- | Reduce the requirements by the specified file-size.-subtractFile- :: RealFrac ratio- => Data.File.FileSize- -> CommandOptions ratio- -> CommandOptions ratio-subtractFile fileSize commandOptions- | fileSize < 0 = error $ "Squeeze.Data.CommandOptions.subtractFile:\tnegative file-size=" ++ show fileSize- | maximumBytes' < 0 = error $ "Squeeze.Data.CommandOptions.subtractFile:\tfile-size=" ++ show fileSize ++ " > maximum=" ++ show maximumBytes- | otherwise = commandOptions {- getMaximumBytes = maximumBytes',- getMinimumUsageRatio = if maximumBytes' == 0- then 0 -- CAVEAT: the calculation below would otherwise attempt to evaluate 0 / 0.- else fromIntegral (max 0 $ deriveMinimumBytes commandOptions - fileSize) / fromIntegral maximumBytes'- } where- maximumBytes, maximumBytes' :: Data.File.FileSize- maximumBytes = getMaximumBytes commandOptions- maximumBytes' = maximumBytes - fileSize---- | The bounds on the aggregate size of the set of files.-solutionSizeBounds :: RealFrac f => CommandOptions f -> Factory.Data.Interval.Interval Data.File.FileSize-solutionSizeBounds = deriveMinimumBytes &&& getMaximumBytes-
− src/Squeeze/Data/File.hs
@@ -1,164 +0,0 @@-{-- Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Defines file-related type-synonyms, and associated operations.--}--module Squeeze.Data.File(--- * Types--- ** Type-synonyms- FilePathList,- FileSize,- FileSizeAndPath,--- * Functions- accumulateSize,- aggregateSize,--- expandDirectory,- findDuplicates,--- findSize,- findSizes,- orderByIncreasingSize,- orderByDecreasingSize,- getFileSizeStatistics,- selectSuitableFileSizes,--- ** Accessors- getSize,- getPath,--- ** Predicates- hasSizeBy-) where--import Control.Arrow((&&&))-import qualified Control.Monad-import qualified Control.Monad.Writer-import qualified Data.List-import qualified Data.Ord-import qualified Factory.Math.Statistics-import qualified System.Directory-import System.FilePath((</>))-import qualified System.IO-import qualified ToolShed.Data.Foldable---- | A type suitable for containing an arbitrary set of file-paths.-type FilePathList = [System.IO.FilePath]---- | A type-synonym specifically to hold file-sizes (in bytes).-type FileSize = Integer -- Matches the return-type of 'IO.hFileSize'.---- | A type suitable for containing a file-path, qualified by the corresponding 'FileSize'.-type FileSizeAndPath = (FileSize, System.IO.FilePath)---- | Accessor.-getSize :: FileSizeAndPath -> FileSize-getSize = fst---- | Accessor.-getPath :: FileSizeAndPath -> System.IO.FilePath-getPath = snd---- | Sum the 'FileSize's in the specified list.-aggregateSize :: [FileSizeAndPath] -> FileSize-aggregateSize = foldr ((+) . getSize) 0--{- |- * Returns the cumulative sequence of sizes, as each file is prepended to the specified list.-- * CAVEAT: the list-length is one greater than that supplied, since the last element represents the size with zero files.--}-accumulateSize :: [FileSizeAndPath] -> [FileSize]-accumulateSize = scanr ((+) . getSize) 0--{- |- * Recursively descend the specified path, accumulating a list of files.-- * CAVEAT: all non-directory files are returned; devices, pipes, sockets, symlinks ...--}-expandDirectory :: System.IO.FilePath -> IO FilePathList-expandDirectory filePath = do- directoryExists <- System.Directory.doesDirectoryExist filePath-- if directoryExists- then System.Directory.getDirectoryContents filePath >>= fmap concat . mapM (- expandDirectory {-recurse-} . (filePath </>) {-qualify the path-}- ) . filter (- `notElem` [".", ".."] -- Prevent infinite recursion.- )- else {-non-directory-} return {-to IO-monad-} [filePath] -- CAVEAT: this could include non-existent paths, devices, pipes, sockets, symlinks ...--{- |- * Finds any file-paths which have been specified more than once.-- * This includes files which have been implicitly specified via a directory.--}-findDuplicates :: FilePathList -> IO FilePathList-findDuplicates = fmap (map head . filter ((> 1) . length) . ToolShed.Data.Foldable.gather . concat) . mapM expandDirectory--{- |- * Get the size of a file, treating a directory as an atomic unit.-- * CAVEAT: the size of a symlink, is that of the file to which it refers.--}-findSize :: System.IO.FilePath -> IO FileSize-findSize filePath = expandDirectory filePath >>= fmap aggregateSize . mapM (\f -> flip (,) f `fmap` System.IO.withFile f System.IO.ReadMode System.IO.hFileSize)---- | Finds file-sizes.-findSizes :: FilePathList -> IO [FileSizeAndPath]-findSizes = uncurry fmap . (flip zip &&& mapM findSize)---- | Sorts a list of 'FileSizeAndPath' by increasing size; ie. smallest first.-orderByIncreasingSize :: [FileSizeAndPath] -> [FileSizeAndPath]-orderByIncreasingSize = Data.List.sortBy $ Data.Ord.comparing getSize---- | Sorts a list of 'FileSizeAndPath' by decreasing size; ie. smallest first.-orderByDecreasingSize :: [FileSizeAndPath] -> [FileSizeAndPath]-orderByDecreasingSize = reverse . orderByIncreasingSize---- | True if the specified file has the required size according to the specified predicate.-hasSizeBy- :: (FileSize -> Bool) -- ^ The predicate.- -> FileSizeAndPath -- ^ The file-parameters to be tested.- -> Bool-hasSizeBy predicate = predicate . getSize---- | Acquire statistics related to a list of files.-getFileSizeStatistics- :: (Fractional mean, Floating standardDeviation)- => [FileSizeAndPath]- -> (Int, FileSize, mean, standardDeviation) -- ^ (Number of components, Aggregate size, Mean size, Standard-deviation).-getFileSizeStatistics l = (- length l,- sum sizes,- Factory.Math.Statistics.getMean sizes,- Factory.Math.Statistics.getStandardDeviation sizes- ) where- sizes = map getSize l--{- |- * Partitions the specified list of file-sizes & paths, into those whose size is suitable according to the specified predicate & those which are unsuitable.-- * Logs the results.--}-selectSuitableFileSizes :: (FileSize -> Bool) -> [FileSizeAndPath] -> Control.Monad.Writer.Writer [String] [FileSizeAndPath]-selectSuitableFileSizes predicate fileSizeAndPathList = let- (accepted, rejected) = Data.List.partition (hasSizeBy predicate) fileSizeAndPathList- in do- Control.Monad.unless (null rejected) $ Control.Monad.Writer.tell ["WARNING: rejecting files of unsuitable size; " ++ show rejected ++ "."]-- return {-to Writer-monad-} accepted-
− src/Squeeze/Data/FileCombination.hs
@@ -1,164 +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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] A data-type which references a set of files by their paths, and qualifies them with their aggregate size.--}--module Squeeze.Data.FileCombination(--- * Types--- ** Data-types- FileCombination(--- MkFileCombination,- getAggregateFileSize,- getFilePathList- ),--- * Constants- nullFileCombination,--- * Functions- comparingAggregateFileSize,- prepend,- risingFilter,--- risingMerge,- risingMergeByAggregateFileSize,--- ** Constructors- mkFileCombination,- singleton,--- ** Predicates- hasSizeBy-) where--import qualified Data.List-import qualified Data.Ord-import qualified Squeeze.Data.File as Data.File-import qualified ToolShed.Data.Foldable-import qualified ToolShed.SelfValidate---- | Declare a list of files qualified by its aggregate size.-data FileCombination = MkFileCombination {- getAggregateFileSize :: !Data.File.FileSize, -- ^ The aggregate size of the files referenced by 'getFilePathList'.- getFilePathList :: Data.File.FilePathList -- ^ A list of paths, defining a set of files.-} deriving Eq--instance Show FileCombination where- showsPrec _ fileCombination = shows (getAggregateFileSize fileCombination) . showChar '\t' . shows (Data.List.sort $ getFilePathList fileCombination)--instance ToolShed.SelfValidate.SelfValidator FileCombination where- getErrors fileCombination = ToolShed.SelfValidate.extractErrors [- (- getAggregateFileSize fileCombination < 0,- "aggregate size must be positive; " ++ show fileCombination- ), (- getAggregateFileSize fileCombination /= 0 && null (getFilePathList fileCombination),- "when zero files are specified, the aggregate size must also be zero; " ++ show fileCombination- ), let- duplicateFilePaths = map head . filter ((> 1) . length) . ToolShed.Data.Foldable.gather $ getFilePathList fileCombination- in (- not $ null duplicateFilePaths,- "duplicate file-paths have been specified; " ++ show duplicateFilePaths- )- ]---- | A constant empty instance.-nullFileCombination :: FileCombination-nullFileCombination = MkFileCombination 0 []---- | Smart constructor.-mkFileCombination :: Data.File.FileSize -> Data.File.FilePathList -> FileCombination-mkFileCombination fileSize filePathList- | ToolShed.SelfValidate.isValid fileCombination = fileCombination- | otherwise = error $ "Squeeze.Data.FileCombination.mkFileCombination:\t" ++ ToolShed.SelfValidate.getFirstError fileCombination- where- fileCombination = MkFileCombination fileSize filePathList---- | Construct a 'FileCombination' from a single 'Data.File.FileSizeAndPath'.-singleton :: Data.File.FileSizeAndPath -> FileCombination-singleton (fileSize, filePath) = mkFileCombination fileSize [filePath]--{- |- * Prepend a 'Data.File.FileSizeAndPath' to an existing 'FileCombination'.-- * CAVEAT: performance hot-spot, so it by-passes the checks made by 'mkFileCombination'.--}-{-# INLINE prepend #-}-prepend- :: Data.File.FileSizeAndPath -- ^ The new path to prepend to the incumbent file-combination.- -> FileCombination -- ^ The incumbent combination of files.- -> FileCombination-prepend (fileSize, filePath) fileCombination = MkFileCombination {- getAggregateFileSize = fileSize + getAggregateFileSize fileCombination,- getFilePathList = filePath : getFilePathList fileCombination-}---- | Predicate used to determine whether a specific file-combination matches a size-related requirement.-{-# INLINE hasSizeBy #-}-hasSizeBy- :: (Data.File.FileSize -> Bool) -- ^ The predicate.- -> FileCombination -- ^ The input datum to be tested.- -> Bool-hasSizeBy predicate = predicate . getAggregateFileSize---- | Progressively raises the selection-criterion as each match is found, to produce monotonically increasing file-combinations.-risingFilter- :: Data.File.FileSize -- ^ The initial minimum byte-size of file to accept.- -> [FileCombination] -- ^ The input list of files to filter.- -> [FileCombination] -- ^ The resulting list of files, which have met rising criterion.-risingFilter _ [] = []-risingFilter minimumSize (x : xs)- | aggregateFileSize >= minimumSize = x : risingFilter aggregateFileSize xs- | otherwise = risingFilter minimumSize xs- where- aggregateFileSize = getAggregateFileSize x--{- |- * Merges two lists of monotonically increasing values, into a single monotonically increasing list, by dropping values which compare less than results already found.-- * CAVEAT: both lists must produce an element, in order to determine which is selected.- As a result, though one list produces a value, it can't be returned until the other does (which make take a long time), even if ultimately the first is then selected.--}-risingMerge- :: (FileCombination -> FileCombination -> Ordering) -- ^ Comparator used to select the best file-combination from the heads of the two list supplied.- -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.- -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.- -> [FileCombination]-risingMerge cmp = slave nullFileCombination where- lessThan bar = (== LT) . (`cmp` bar)-- slave bar [] r = dropWhile (lessThan bar) r- slave bar l [] = dropWhile (lessThan bar) l- slave _ (x : xs) (y : ys)- | o == GT = x : slave x xs ys- | o == LT = y : slave y xs ys- | otherwise = x : y : slave x xs ys- where- o = x `cmp` y---- Compares two /file-combination/s by their aggregate file-size.-comparingAggregateFileSize :: FileCombination -> FileCombination -> Ordering-comparingAggregateFileSize = Data.Ord.comparing getAggregateFileSize--{- |- Merges two lists of monotonically increasing lists of file-combinations,- into a single monotonically increasing list,- by dropping values which have a smaller aggregate size than results already found.--}-risingMergeByAggregateFileSize- :: [FileCombination] -- ^ A list of monotonically increasing file-combinations.- -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.- -> [FileCombination]-risingMergeByAggregateFileSize = risingMerge comparingAggregateFileSize
− src/Squeeze/Squeeze.hs
@@ -1,176 +0,0 @@-{-- Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@]-- * Returns combinations of the specified files, which fit into the available space, without wasting more than the specified ratio.-- * Any directory-names are treated as atomic units, rather than individual files.-- * Because of the exponential growth of possible combinations,- an /exact/ match for the available space is frequently found with a surprisingly small set of files.--}--module Squeeze.Squeeze(--- * Functions- findCombinations,- findBestFit,- distributeAndFindBestFit,- partitionEmptyFilesAndDistributeAndFindBestFit-) where--import qualified Control.Arrow-import Control.Arrow((&&&))-import qualified Control.Concurrent-import qualified Control.Monad-import qualified Data.List-import qualified Factory.Data.Interval-import qualified Squeeze.Control.Concurrent.DivideAndConquer as Control.Concurrent.DivideAndConquer-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions-import qualified Squeeze.Data.File as Data.File-import qualified Squeeze.Data.FileCombination as Data.FileCombination-import qualified System.IO--{- |- * Checks that the total aggregate 'Data.File.FileSize', meets or exceeds 'minimumBytes'.-- * Drops excessively large files, assuming that the file-list has been sorted by size, largest first.-- * Generates up to @2^n@ combinations of the @n@ specified files; the algorithm is similar to 'Data.List.subsequences', except that unproductive lines are immediately terminated.- This is the performance bottle-neck, and though there may be simpler and faster algorithms, the key attribute is that it operates in constant space.-- * CAVEAT: assumes files have been sorted by decreasing size.-- * The algorithm is stable, in that it maintains the specified file-order within each combination;- though the order in which the combinations are concatenated is rather arbitrary.--}-findCombinations- :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible aggregate size, for file-combinations.- -> [Data.File.FileSizeAndPath] -- ^ The list of file-names & sizes, ordered by decreasing size.- -> [Data.FileCombination.FileCombination] -- ^ The resulting unordered list of suitable file-combinations.-findCombinations (minimumCombinationSize, maximumCombinationSize) = filter (- Data.FileCombination.hasSizeBy (>= minimumCombinationSize)- ) . (- Data.FileCombination.nullFileCombination :- ) . nonEmptyCombinations minimumCombinationSize . uncurry zip . (- id &&& Data.File.accumulateSize -- Associate the list of possible files with its accumulating size.- ) . dropWhile (- Data.File.hasSizeBy (> maximumCombinationSize) -- Remove files which individually exceed the maximum permissible; assuming they've been sorted by decreasing size.- ) where- nonEmptyCombinations :: Data.File.FileSize -> [(Data.File.FileSizeAndPath, Data.File.FileSize)] -> [Data.FileCombination.FileCombination]- nonEmptyCombinations _ [] = []- nonEmptyCombinations minimumBytes ((fileSizeAndPath, aggregateSize) : remainder)- | aggregateSize < minimumBytes = [] -- Even if all the files are selected, the minimum-size criterion won't be satisfied.- | otherwise = Data.FileCombination.singleton fileSizeAndPath : foldr binaryChoice [] (- nonEmptyCombinations (minimumBytes - Data.File.getSize fileSizeAndPath) remainder -- Recurse.- )- where- binaryChoice :: Data.FileCombination.FileCombination -> [Data.FileCombination.FileCombination] -> [Data.FileCombination.FileCombination]- binaryChoice combinationExcluding- | Data.FileCombination.hasSizeBy (<= maximumCombinationSize) combinationIncluding = (combinationExcluding :) . (combinationIncluding :)- | otherwise = (combinationExcluding :)- where- combinationIncluding :: Data.FileCombination.FileCombination- combinationIncluding = Data.FileCombination.prepend fileSizeAndPath combinationExcluding---- | Orders the files by decreasing size, calls 'findCombinations', calls 'Data.FileCombination.risingFilter' to select progressively better solutions.-findBestFit- :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible sizes for file-combinations.- -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names & sizes.- -> [Data.FileCombination.FileCombination] -- ^ A reduced list of increasingly suitable file-combinations.-findBestFit solutionSizeBounds = Data.FileCombination.risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . findCombinations solutionSizeBounds . Data.File.orderByDecreasingSize {-which makes findCombinations faster-}--{- |- * Recursively bisects the task, distributing the sub-tasks to 'findBestFit', to utilise the available CPU-cores.-- * The task is bisected by removing the smallest file, then solving the remaining problem for two independent cases; that the selected file is excluded or the selected file is included, in the final solution.- Selecting the smallest file rather than the largest, seems to balance the load of the sub-tasks more evenly.- CAVEAT: no account has been taken of the possibility that the smallest file has size zero, which makes the sub-tasks identical.-- * Recombines the part solutions to finds the single monotonically increasing list of file-combinations matching the original criteria.-- * CAVEAT: whilst the ultimate solution is similar, regardless of the specified number of CPU-cores available, the path leading to it typically differs.--}-distributeAndFindBestFit- :: RealFrac ratio- => Data.CommandOptions.CommandOptions ratio- -> [Data.File.FileSizeAndPath] -- ^ The unordered list of files & sizes.- -> IO [Data.FileCombination.FileCombination]-distributeAndFindBestFit commandOptions fileSizeAndPathList = let- slave _ _ [] = return {-to IO-monad-} [Data.FileCombination.nullFileCombination]- slave 1 commandOptions' increasingFileSizeAndPathList = let- solutionSizeBounds = Data.CommandOptions.solutionSizeBounds commandOptions'- in do- Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions' == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "INFO: acceptable file-size interval " ++ show solutionSizeBounds ++ " bytes."-- return {-to IO-monad-} $ findBestFit solutionSizeBounds increasingFileSizeAndPathList -- Delegate the task to the single-threaded algorithm.- slave numCapabilities' commandOptions' (selectedFileSizeAndPath {-the smallest-} : remainingFileSizeAndPaths) = let- recurse = slave $ numCapabilities' `div` 2 -- Partially apply.- in do- Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions' == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "INFO: " ++ show numCapabilities' ++ " CPU-cores => bisecting task into those, with & without " ++ show selectedFileSizeAndPath ++ "."-- fileCombinationsExcludingSelected <- recurse commandOptions' {-i.e the original space-} remainingFileSizeAndPaths -- This is about half the total task.-- let- commandOptions'' = Data.CommandOptions.subtractFile (Data.File.getSize selectedFileSizeAndPath) commandOptions' -- Reduce the requirements by the size of the selected file.-- if Data.CommandOptions.getMaximumBytes commandOptions'' < 0- then return {-to IO-monad-} fileCombinationsExcludingSelected -- The selected file won't fit.- else map (- Data.FileCombination.prepend selectedFileSizeAndPath -- Prepend the selected file to all file-combinations.- ) `fmap` recurse commandOptions'' remainingFileSizeAndPaths >>= Control.Concurrent.DivideAndConquer.divideAndConquer Data.FileCombination.risingMergeByAggregateFileSize fileCombinationsExcludingSelected -- Merge the part-solutions.- in Control.Concurrent.getNumCapabilities >>= (\numCapabilities -> slave numCapabilities commandOptions $ Data.File.orderByIncreasingSize fileSizeAndPathList)--{- |- * Neither 'distributeAndFindBestFit' nor 'findBestFit' distinguish between empty & non-empty files,- but empty files cause significant inefficiency in the former (where the same calculation is performed multiple times)- & could be treated much more efficiently in the latter (since they're potentially a member of any other solution).-- * This function side-lines empty files, delegates the remaining problem to 'distributeAndFindBestFit' (& consequently 'findBestFit'),- then prepends combinations of empty files to the resulting combinations of non-empty files.--}-partitionEmptyFilesAndDistributeAndFindBestFit- :: RealFrac ratio- => Data.CommandOptions.CommandOptions ratio- -> [Data.File.FileSizeAndPath] -- ^ The unordered list of files & sizes.- -> IO [Data.FileCombination.FileCombination]-partitionEmptyFilesAndDistributeAndFindBestFit commandOptions fileSizeAndPathList- | Data.CommandOptions.getIncludeEmpty commandOptions = do- printStatistics fileSizeAndPathList-- concatMap (- \fileCombination -> map (- \emptyFilePathCombination -> fileCombination {- Data.FileCombination.getFilePathList = emptyFilePathCombination ++ Data.FileCombination.getFilePathList fileCombination- }- ) $ Data.List.subsequences {-find all combinations-} emptyFiles- ) `fmap` nonEmptyFileCombinations- | otherwise {-exclude empty files-} = do- Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null emptyFiles) . System.IO.hPutStrLn System.IO.stderr $ "WARNING: rejecting empty files; " ++ show emptyFiles ++ "."-- Control.Monad.when (null nonEmptyFilePathAndSizeList) $ fail "there are zero non-empty files"-- printStatistics nonEmptyFilePathAndSizeList-- nonEmptyFileCombinations- where- printStatistics l = Control.Monad.unless (Data.CommandOptions.getVerbosity commandOptions == minBound || null l) . System.IO.hPutStrLn System.IO.stderr $ "INFO: file-(count, aggregate size, mean, standard-deviation); " ++ show (Data.File.getFileSizeStatistics l :: (Int, Data.File.FileSize, Float, Float)) ++ "."- (emptyFiles, nonEmptyFilePathAndSizeList) = Control.Arrow.first (map Data.File.getPath) $ Data.List.partition (Data.File.hasSizeBy (== 0)) fileSizeAndPathList- nonEmptyFileCombinations = distributeAndFindBestFit commandOptions nonEmptyFilePathAndSizeList -- Delegate.-
− src/Squeeze/Test/Data/CommandOptions.hs
@@ -1,51 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-- 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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Data.CommandOptions.CommandOptions'.--}--module Squeeze.Test.Data.CommandOptions(--- * Types--- ** Type-synonyms- CommandOptions-) where--import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol.-import Control.Applicative((<$>), (<*>))-import qualified Test.QuickCheck-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions-import Squeeze.Test.Data.Verbosity()--instance (- Enum ratio,- Fractional ratio,- Ord ratio,- Real ratio,- Test.QuickCheck.Arbitrary ratio- ) => Test.QuickCheck.Arbitrary (Data.CommandOptions.CommandOptions ratio) where- arbitrary = Data.CommandOptions.mkCommandOptions <$> Test.QuickCheck.arbitrary {-includeEmpty-} <*> (- abs <$> Test.QuickCheck.arbitrary -- maximumBytes.- ) <*> Test.QuickCheck.arbitrary {-maybeRandomSeed-} <*> (- recip . succ . abs <$> Test.QuickCheck.arbitrary -- minimumUsageRatio.- ) <*> Test.QuickCheck.arbitrary {-verbosity-}---- | Defines a concrete type for testing.-type CommandOptions = Data.CommandOptions.CommandOptions Double-
− src/Squeeze/Test/Data/FileCombinations.hs
@@ -1,50 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-- Copyright (C) 2010-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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Defines tests to dynamically verify the module "Squeeze.Data.FileCombinations" against arbitrary data.--}--module Squeeze.Test.Data.FileCombinations(--- * Functions- quickChecks-) where--import Control.Arrow((&&&))-import qualified Data.List-import qualified Squeeze.Data.FileCombination as Data.FileCombination-import qualified Test.QuickCheck--instance Test.QuickCheck.Arbitrary Data.FileCombination.FileCombination where- arbitrary = do- filePathList <- Data.List.nub `fmap` (Test.QuickCheck.elements [0 .. 99] >>= Test.QuickCheck.vector)- aggregateFileSize <- Test.QuickCheck.elements [0 .. Data.List.genericLength filePathList] -- Assume files of size either zero or one byte.-- return $ Data.FileCombination.mkFileCombination aggregateFileSize filePathList---- | Defines invariant properties.-quickChecks :: IO ()-quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_risingFilter, prop_risingFilter', prop_risingMergeByAggregateFileSize] where- prop_risingFilter, prop_risingFilter', prop_risingMergeByAggregateFileSize :: [Data.FileCombination.FileCombination] -> Test.QuickCheck.Property- prop_risingFilter = Test.QuickCheck.label "prop_risingFilter" . uncurry (==) . (id &&& Data.List.sort) . map Data.FileCombination.getAggregateFileSize . Data.FileCombination.risingFilter 0- prop_risingFilter' = Test.QuickCheck.label "prop_risingFilter'" . uncurry (==) . (id &&& Data.FileCombination.risingFilter 0) . Data.List.sortBy Data.FileCombination.comparingAggregateFileSize-- prop_risingMergeByAggregateFileSize = Test.QuickCheck.label "prop_risingMergeByAggregateFileSize" . uncurry (==) . (- id &&& map head . Data.List.group . uncurry Data.FileCombination.risingMergeByAggregateFileSize . (id &&& id)- ) . Data.FileCombination.risingFilter 0
− src/Squeeze/Test/Data/Verbosity.hs
@@ -1,30 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-- 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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' for 'Distribution.Verbosity.Verbosity'.--}--module Squeeze.Test.Data.Verbosity() where--import qualified Distribution.Verbosity-import qualified Test.QuickCheck--instance Test.QuickCheck.Arbitrary Distribution.Verbosity.Verbosity where- arbitrary = Test.QuickCheck.elements [minBound .. maxBound]
− src/Squeeze/Test/Performance.hs
@@ -1,73 +0,0 @@-{-- Copyright (C) 2011-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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Defines a performance-test, based on randomly generated /virtual/ files.--}--module Squeeze.Test.Performance(--- * Functions- run-) where--import qualified Control.Monad-import qualified Control.Monad.Writer-import qualified Data.List-import qualified Data.Maybe-import qualified Factory.Math.Probability-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions-import qualified Squeeze.Data.File as Data.File-import qualified Squeeze.Data.FileCombination as Data.FileCombination-import qualified Squeeze.Squeeze as Squeeze-import qualified System.IO-import qualified System.Random--{- |- * Find the best-fit, into the available space, using a set composed from the specified number of virtual files.-- * The files have a random size, conforming to the specified distribution.-- * The generated file-name, is merely a counter.-- * CAVEAT: fewer files than requested may be used, because depending on the requested distribution, some may overflow the maximum permissible size.--}-run :: (Factory.Math.Probability.Distribution distribution, RealFrac ratio)- => Data.CommandOptions.CommandOptions ratio- -> Int -- ^ The number of virtual files to randomly generate.- -> distribution- -> IO [Data.FileCombination.FileCombination]-run commandOptions fileCount probabilityDistribution = do- randomGen <- Data.Maybe.maybe System.Random.getStdGen {-use the global random-number generator-} (- return {-to IO-monad-} . System.Random.mkStdGen -- Seed the random-number generator as specified.- ) $ Data.CommandOptions.getMaybeRandomSeed commandOptions -- Select a random-number generator.-- let- (acceptedFileSizeAndPathList, logFile) = Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (- <= Data.CommandOptions.getMaximumBytes commandOptions -- This may reduce the requested number of files, but compensating distorts the requested distribution.- ) . (- `zip` map show [0 :: Int ..] -- Construct a Data.File.FileSizeAndPath, by using a counter as the file-name.- ) . take fileCount . filter (- >= 0 -- A suitable distribution shouldn't generate negative file-sizes.- ) . map (- ceiling :: Double -> Integer -- File-sizes are integral.- ) $ Factory.Math.Probability.generatePopulation probabilityDistribution randomGen-- Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > minBound) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile-- Squeeze.distributeAndFindBestFit commandOptions acceptedFileSizeAndPathList-
− src/Squeeze/Test/QuickChecks.hs
@@ -1,39 +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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Defines tests to dynamically verify the application against arbitrary data.--}--module Squeeze.Test.QuickChecks(--- * Functions- run-) where--import qualified Control.Arrow-import qualified Squeeze.Test.Data.FileCombinations as Test.Data.FileCombinations-import qualified Squeeze.Test.Squeeze as Test.Squeeze---- | Runs checks on invariant properties.-run :: IO ()-run = mapM_ (- uncurry (>>) . Control.Arrow.first putStrLn- ) [- ("Data.FileCombinations", Test.Data.FileCombinations.quickChecks),- ("Squeeze", Test.Squeeze.quickChecks)- ]
− src/Squeeze/Test/Squeeze.hs
@@ -1,70 +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 <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@] Dr. Alistair Ward-- [@DESCRIPTION@] Defines tests to dynamically verify the module "Squeeze.Squeeze" against arbitrary data.--}--module Squeeze.Test.Squeeze(--- * Functions- quickChecks-) where--import Control.Arrow((&&&))-import qualified Data.List-import qualified Factory.Data.Interval-import qualified Squeeze.Data.File as Data.File-import qualified Squeeze.Data.FileCombination as Data.FileCombination-import qualified Squeeze.Squeeze as Squeeze-import qualified Test.QuickCheck-import qualified ToolShed.Data.Foldable-import qualified ToolShed.Data.List---- | Defines invariant properties.-quickChecks :: IO ()-quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_totalCombinations, prop_fileSizeBounds, prop_allFiles, prop_monotonicFileSize, prop_uniqueFileNames] where- mkFileSizeAndPathList :: (Integral i, Show i) => [i] -> [Data.File.FileSizeAndPath]- mkFileSizeAndPathList = take 12 . Data.List.nubBy (ToolShed.Data.List.equalityBy snd) . map (toInteger . abs &&& show) -- CAVEAT: may be shorter than requested.-- prop_totalCombinations, prop_fileSizeBounds, prop_allFiles, prop_monotonicFileSize, prop_uniqueFileNames :: [Integer] -> Test.QuickCheck.Property- prop_totalCombinations integers = Test.QuickCheck.label "prop_totalCombinations" $ (length . Data.List.nub . Squeeze.findCombinations (0, fromIntegral (maxBound :: Int)) $ Data.File.orderByDecreasingSize fileSizeAndPathList) == 2 ^ length fileSizeAndPathList where- fileSizeAndPathList = mkFileSizeAndPathList integers-- prop_fileSizeBounds integers = Test.QuickCheck.label "prop_fileSizeBounds" . all ((`Factory.Data.Interval.elem'` fileSizeBounds) . Data.FileCombination.getAggregateFileSize) . Squeeze.findCombinations fileSizeBounds $ Data.File.orderByDecreasingSize fileSizeAndPathList where- fileSizeAndPathList = mkFileSizeAndPathList integers-- fileSizeBounds :: Factory.Data.Interval.Interval Data.File.FileSize- fileSizeBounds = (minimumBytes, maximumBytes) where- maximumBytes, minimumBytes :: Data.File.FileSize- maximumBytes = round $ fromIntegral (Data.File.aggregateSize fileSizeAndPathList) / (4.0 :: Double) -- Arbitrarily.- minimumBytes = maximumBytes `div` 2 -- Arbitrarily.-- prop_allFiles integers = Test.QuickCheck.label "prop_allFiles" . (== aggregateSize) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (Factory.Data.Interval.precisely aggregateSize) fileSizeAndPathList where- fileSizeAndPathList = mkFileSizeAndPathList integers-- aggregateSize :: Data.File.FileSize- aggregateSize = Data.File.aggregateSize fileSizeAndPathList-- prop_monotonicFileSize integers = Test.QuickCheck.label "prop_monotonicFileSize" . uncurry (==) . (id &&& Data.List.sort {-stable-}) . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (0, fromIntegral (maxBound :: Int)) fileSizeAndPathList where- fileSizeAndPathList = mkFileSizeAndPathList integers-- prop_uniqueFileNames integers = Test.QuickCheck.label "prop_uniqueFileNames" . all (- all ((== 1) . length) . ToolShed.Data.Foldable.gather . Data.FileCombination.getFilePathList- ) $ Squeeze.findBestFit (0, fromIntegral (maxBound :: Int)) fileSizeAndPathList where- fileSizeAndPathList = mkFileSizeAndPathList integers-