diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -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 . + +## Author + +This application is written and maintained by Dr. Alistair Ward. + + diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,110 +0,0 @@ -2010-11-18 Dr. Alistair Ward - -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 . -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. - diff --git a/changelog.Debian b/changelog.Debian --- a/changelog.Debian +++ b/changelog.Debian @@ -16,4 +16,4 @@ -- Alistair Ward 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 diff --git a/changelog.markdown b/changelog.markdown new file mode 100644 --- /dev/null +++ b/changelog.markdown @@ -0,0 +1,119 @@ +# 2010-11-18 Dr. Alistair Ward + +## 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%. diff --git a/copyright b/copyright --- a/copyright +++ b/copyright @@ -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'. diff --git a/debian/DEBIAN/control b/debian/DEBIAN/control --- a/debian/DEBIAN/control +++ b/debian/DEBIAN/control @@ -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 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. diff --git a/man/man1/squeeze.1 b/man/man1/squeeze.1 --- a/man/man1/squeeze.1 +++ b/man/man1/squeeze.1 @@ -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\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 diff --git a/squeeze.cabal b/squeeze.cabal --- a/squeeze.cabal +++ b/squeeze.cabal @@ -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 functionalley eu -Bug-reports: squeeze functionalley 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 . --- 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 squeeze functionalley eu +Bug-reports: mailto squeeze functionalley 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 diff --git a/squeeze.spec b/squeeze.spec --- a/squeeze.spec +++ b/squeeze.spec @@ -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 1.0.2.4-1 -Removed "rm -rf -- '%buildroot'" from build, for security. -Corrected "Paths" module, even though it's unused. +First cut. + diff --git a/src-exe/Main.hs b/src-exe/Main.hs new file mode 100644 --- /dev/null +++ b/src-exe/Main.hs @@ -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 . +-} +{- | + [@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` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."), + G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show defaultMaximumBytes ++ "'."), + G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("The minimum acceptable space usage-ratio; default '" ++ show (realToFrac $ Data.CommandOptions.getMinimumUsageRatio defaultCommandOptions :: Double) ++ "'."), + G.Option "r" ["randomSeed"] (G.OptArg setRandomSeed "") ("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` "(, )" + ) "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` "(, )" + ) "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 + ) "[ ...]" "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 + diff --git a/src-exe/Squeeze/Test/Performance.hs b/src-exe/Squeeze/Test/Performance.hs new file mode 100644 --- /dev/null +++ b/src-exe/Squeeze/Test/Performance.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-lib/Squeeze/Control/Concurrent/DivideAndConquer.hs b/src-lib/Squeeze/Control/Concurrent/DivideAndConquer.hs new file mode 100644 --- /dev/null +++ b/src-lib/Squeeze/Control/Concurrent/DivideAndConquer.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-lib/Squeeze/Data/CommandOptions.hs b/src-lib/Squeeze/Data/CommandOptions.hs new file mode 100644 --- /dev/null +++ b/src-lib/Squeeze/Data/CommandOptions.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-lib/Squeeze/Data/File.hs b/src-lib/Squeeze/Data/File.hs new file mode 100644 --- /dev/null +++ b/src-lib/Squeeze/Data/File.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-lib/Squeeze/Data/FileCombination.hs b/src-lib/Squeeze/Data/FileCombination.hs new file mode 100644 --- /dev/null +++ b/src-lib/Squeeze/Data/FileCombination.hs @@ -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 . +-} +{- | + [@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 diff --git a/src-lib/Squeeze/Squeeze.hs b/src-lib/Squeeze/Squeeze.hs new file mode 100644 --- /dev/null +++ b/src-lib/Squeeze/Squeeze.hs @@ -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 . +-} +{- | + [@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. + diff --git a/src-test/Main.hs b/src-test/Main.hs new file mode 100644 --- /dev/null +++ b/src-test/Main.hs @@ -0,0 +1,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 . +-} +{- | + [@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) + ] diff --git a/src-test/Squeeze/Test/Data/CommandOptions.hs b/src-test/Squeeze/Test/Data/CommandOptions.hs new file mode 100644 --- /dev/null +++ b/src-test/Squeeze/Test/Data/CommandOptions.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-test/Squeeze/Test/Data/FileCombinations.hs b/src-test/Squeeze/Test/Data/FileCombinations.hs new file mode 100644 --- /dev/null +++ b/src-test/Squeeze/Test/Data/FileCombinations.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src-test/Squeeze/Test/Data/Verbosity.hs b/src-test/Squeeze/Test/Data/Verbosity.hs new file mode 100644 --- /dev/null +++ b/src-test/Squeeze/Test/Data/Verbosity.hs @@ -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 . +-} +{- | + [@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] diff --git a/src-test/Squeeze/Test/Squeeze.hs b/src-test/Squeeze/Test/Squeeze.hs new file mode 100644 --- /dev/null +++ b/src-test/Squeeze/Test/Squeeze.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -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 . --} -{- | - [@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` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."), - G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show defaultMaximumBytes ++ "'."), - G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("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 "") ("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` "(, )" - ) "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` "(, )" - ) "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 - ) "[ ...]" "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 - diff --git a/src/Squeeze/Control/Concurrent/DivideAndConquer.hs b/src/Squeeze/Control/Concurrent/DivideAndConquer.hs deleted file mode 100644 --- a/src/Squeeze/Control/Concurrent/DivideAndConquer.hs +++ /dev/null @@ -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 . --} -{- | - [@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 - diff --git a/src/Squeeze/Data/CommandOptions.hs b/src/Squeeze/Data/CommandOptions.hs deleted file mode 100644 --- a/src/Squeeze/Data/CommandOptions.hs +++ /dev/null @@ -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 . --} -{- | - [@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 - diff --git a/src/Squeeze/Data/File.hs b/src/Squeeze/Data/File.hs deleted file mode 100644 --- a/src/Squeeze/Data/File.hs +++ /dev/null @@ -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 . --} -{- | - [@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 - diff --git a/src/Squeeze/Data/FileCombination.hs b/src/Squeeze/Data/FileCombination.hs deleted file mode 100644 --- a/src/Squeeze/Data/FileCombination.hs +++ /dev/null @@ -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 . --} -{- | - [@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 diff --git a/src/Squeeze/Squeeze.hs b/src/Squeeze/Squeeze.hs deleted file mode 100644 --- a/src/Squeeze/Squeeze.hs +++ /dev/null @@ -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 . --} -{- | - [@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. - diff --git a/src/Squeeze/Test/Data/CommandOptions.hs b/src/Squeeze/Test/Data/CommandOptions.hs deleted file mode 100644 --- a/src/Squeeze/Test/Data/CommandOptions.hs +++ /dev/null @@ -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 . --} -{- | - [@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 - diff --git a/src/Squeeze/Test/Data/FileCombinations.hs b/src/Squeeze/Test/Data/FileCombinations.hs deleted file mode 100644 --- a/src/Squeeze/Test/Data/FileCombinations.hs +++ /dev/null @@ -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 . --} -{- | - [@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 diff --git a/src/Squeeze/Test/Data/Verbosity.hs b/src/Squeeze/Test/Data/Verbosity.hs deleted file mode 100644 --- a/src/Squeeze/Test/Data/Verbosity.hs +++ /dev/null @@ -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 . --} -{- | - [@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] diff --git a/src/Squeeze/Test/Performance.hs b/src/Squeeze/Test/Performance.hs deleted file mode 100644 --- a/src/Squeeze/Test/Performance.hs +++ /dev/null @@ -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 . --} -{- | - [@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 - diff --git a/src/Squeeze/Test/QuickChecks.hs b/src/Squeeze/Test/QuickChecks.hs deleted file mode 100644 --- a/src/Squeeze/Test/QuickChecks.hs +++ /dev/null @@ -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 . --} -{- | - [@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) - ] diff --git a/src/Squeeze/Test/Squeeze.hs b/src/Squeeze/Test/Squeeze.hs deleted file mode 100644 --- a/src/Squeeze/Test/Squeeze.hs +++ /dev/null @@ -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 . --} -{- | - [@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 -