diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -59,3 +59,10 @@ * 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. + diff --git a/debian/DEBIAN/control b/debian/DEBIAN/control --- a/debian/DEBIAN/control +++ b/debian/DEBIAN/control @@ -1,11 +1,11 @@ Package: squeeze -Version: 1.0.2.3-1 +Version: 1.0.2.4-1 Section: utils Priority: optional Architecture: i386 -Depends: libc6 (>= 2.7) -Installed-size: 1612 -Maintainer: Dr. Alistair Ward +Depends: libc6 +Installed-size: 2500 +Maintainer: Dr. Alistair Ward Provides: Homepage: http://functionalley.eu Description: Finds the optimal subset of the specified files, to fit into a limited space. diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -15,59 +15,60 @@ .PHONY: all build check clean clobber configure copy deb haddock help hlint install lintian prof rpm rpmlint sdist +PACKAGE_NAME=squeeze + all: install install: build haddock @[ -z "$$CABAL_INSTALL_OPTIONS" ] || echo "INFO: CABAL_INSTALL_OPTIONS='$$CABAL_INSTALL_OPTIONS'" - runhaskell Setup.hs $@ $$CABAL_INSTALL_OPTIONS + runhaskell Setup $@ $$CABAL_INSTALL_OPTIONS prof: CABAL_CONFIGURE_OPTIONS="--enable-executable-profiling $$CABAL_CONFIGURE_OPTIONS" make build copy: build @[ -z "$$CABAL_COPY_OPTIONS" ] || echo "INFO: CABAL_COPY_OPTIONS='$$CABAL_COPY_OPTIONS'" - runhaskell Setup.hs $@ $$CABAL_COPY_OPTIONS + runhaskell Setup $@ $$CABAL_COPY_OPTIONS build: configure @[ -z "$$CABAL_BUILD_OPTIONS" ] || echo "INFO: CABAL_BUILD_OPTIONS='$$CABAL_BUILD_OPTIONS'" - runhaskell Setup.hs $@ $$CABAL_BUILD_OPTIONS + runhaskell Setup $@ $$CABAL_BUILD_OPTIONS -configure: squeeze.cabal Setup.hs +configure: $(PACKAGE_NAME).cabal Setup.hs @[ -z "$$CABAL_CONFIGURE_OPTIONS" ] || echo "INFO: CABAL_CONFIGURE_OPTIONS='$$CABAL_CONFIGURE_OPTIONS'" - runhaskell Setup.hs $@ $$CABAL_CONFIGURE_OPTIONS #--user + runhaskell Setup $@ $$CABAL_CONFIGURE_OPTIONS #--user haddock: configure - PATH=~/.cabal/bin:$$PATH runhaskell Setup.hs $@ --hyperlink-source --executables #Amend path to find 'HsColour', as required for 'hyperlink-source'. + PATH=~/.cabal/bin:$$PATH runhaskell Setup $@ --hyperlink-source --executables #Amend path to find 'HsColour', as required for 'hyperlink-source'. hlint: @$@ -i 'Reduce duplication' src/ -sdist: configure - runhaskell Setup.hs $@ +sdist: + runhaskell Setup $@ check: sdist cabal upload --check --verbose=3 dist/*.tar.gz; -rpm: squeeze.spec - rpmbuild -bb -- $^ - mv -- `find /usr/src/packages/ -type f -name 'squeeze*.rpm' -mtime 0 -print` ./ +rpm: $(PACKAGE_NAME).spec + rpmbuild -bb --nodeps -- $^ + mv -- `find /usr/src/packages/ -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./ -rpmlint: squeeze.spec +rpmlint: $(PACKAGE_NAME).spec @$@ $^ deb: build - mkdir -p 'debian/usr/bin/' && strip --strip-all 'dist/build/squeeze/squeeze' && mv 'dist/build/squeeze/squeeze' 'debian/usr/bin/' - mkdir -p 'debian/usr/share/doc/squeeze/' && cp 'changelog' 'changelog.Debian' 'LICENSE' 'debian/usr/share/doc/squeeze/' && gzip --best debian/usr/share/doc/squeeze/* - cp 'copyright' 'debian/usr/share/doc/squeeze/' - mkdir -p 'debian/usr/share/man/man1/' && cp 'man/man1/squeeze.1' 'debian/usr/share/man/man1/' && gzip --best debian/usr/share/man/man1/*.1 - cd 'debian' && md5sum `find usr -type f -print` >'DEBIAN/md5sums' + mkdir -p debian/usr/bin/ && strip --strip-all 'dist/build/$(PACKAGE_NAME)/$(PACKAGE_NAME)' && mv 'dist/build/$(PACKAGE_NAME)/$(PACKAGE_NAME)' debian/usr/bin/ + mkdir -p 'debian/usr/share/doc/$(PACKAGE_NAME)/' && cp changelog changelog.Debian copyright LICENSE 'debian/usr/share/doc/$(PACKAGE_NAME)/' && cd 'debian/usr/share/doc/$(PACKAGE_NAME)/' && gzip --best -f changelog changelog.Debian LICENSE + mkdir -p debian/usr/share/ && cp -R man/ debian/usr/share/ && gzip --best -f debian/usr/share/man/man1/*.1 + cd debian/ && md5sum `find usr -type f -print` >'DEBIAN/md5sums' fakeroot dpkg-deb --build debian . lintian: lintian -v *.deb clean: - runhaskell Setup.hs $@ + runhaskell Setup $@ rm -rf 'debian/usr/' 'debian/DEBIAN/md5sums' find src -type f \( -name '*.hc' -o -name '*.hcr' -o -name '*.hi' -o -name '*.o' \) -delete diff --git a/man/man1/squeeze.1 b/man/man1/squeeze.1 --- a/man/man1/squeeze.1 +++ b/man/man1/squeeze.1 @@ -2,59 +2,66 @@ .SH NAME \fBsqueeze\fR - Finds the best subset, of the specified files, which fits into a given space. .SH SYNOPSIS -\fBsqueeze\fR [\fIOPTIONS\fR] \fIFILE\fR ... +\fBsqueeze\fR [\fIOPTIONS\fR] [\fIFile-path\fR ...] .SH DESCRIPTION .PP -Finds the subset of the named \fIFILE\fRs, which fits into \fIBYTES\fR, with least room to spare, whilst meeting \fBminimumUsageRatio\fR. +Finds the subset of the specified \fIFile-path\fRs, which fits into the specified \fIBytes\fR, with least room to spare, whilst meeting \fBminimumUsageRatio\fR. .PP -Any directories amongst the specified \fIFILE\fRs are treated as atomic units, & therefore only solutions which involve either all or none of the files in that directory, are returned. +Any directories amongst the specified \fIFile-path\fRs are treated as atomic units, & therefore only solutions which involve either all or none of the files contained, are returned. .PP -Because of its exponential time-complexity, solutions of increasing suitability are continuously returned, rather than waiting until the optimal solution is known; which might take an inordinately long time. +Because of its exponential time-complexity, solutions of increasing suitability are continuously returned, rather than waiting until the optimal solution is known (which might take an inordinately long time). .SH OPTIONS .SS "Selection" .TP -\fB-b\fR, \fB--bisectionRatio='\fR\fILHS%Total\fR' -Defines the ratio (in the unit interval [0 .. 1], defaulting to \fB1%2\fR, i.e. 50%), at which the file-list will be bisected. -The first of the combinations generated from the LHS, is then concatenated with each of the combinations generated from the RHS. -The same operation is then performed on subsequent combinations from the LHS. +\fB-b\fR, \fB--bisectionRatio='\fR\fILHS%Total\fR\fB'\fR +Defines the ratio (in the closed unit-interval [0,1], defaulting to '\fB1%2\fR', i.e. 50%), @ which the list of file-paths will be bisected. +The first of the combinations generated from the first list, is then concatenated with each of the combinations generated from the second list. +The same operation is then performed on subsequent combinations generated from the first list. This alters the order in which file-combinations are assessed, & so the set of suitable combinations returned may differ, though the optimum value remains the same. .TP -\fB-M\fR, \fB--maximumBytes=\fR\fIBYTES\fR -Define the maximum available space, in bytes, defaulting to the space available on a DVD; i.e. \fB4700000000\fR bytes. +\fB-M\fR, \fB--maximumBytes=\fR\fIBytes\fR +Defines the maximum available space, in bytes; defaulting to the space available on a DVD, i.e. \fB4700000000\fR bytes. .TP -\fB-m\fR, \fB--minimumUsageRatio=\fR\fIRATIO\fR -Define the minimum acceptable usage-ratio of \fBmaximumBytes\fR, -from 0 .. 1, defaulting to \fB99%100\fR, i.e. 99%. +\fB-m\fR, \fB--minimumUsageRatio='\fR\fIRational\fR\fB'\fR +Defines the minimum acceptable usage-ratio (in the closed unit-interval [0,1], defaulting to '\fB99%100\fR', i.e. 99%), of \fBmaximumBytes\fR. .TP +\fB-z\fR, \fB--includeEmpty=\fR\fIBool\fR +When \fBTrue\fR, any empty file or directory, can be a member of all solutions. +.br +CAVEAT: for \fIn\fR such files or directories, a factor of \fI2^n\fR more viable solutions exist, obscuring the minimal solutions on which they're based. +.SS Test +.TP \fB-q\fR, \fB--runQuickChecks\fR -Run Quick-checks using arbitrary data & then exit. +Uses \fBQuickCheck\fR to validate invariant properties, using arbitrary data ... & then exits. .TP -\fB--testPerformance\fR='(, \fBPoissonDistribution\fR \fIlambda\fR | \fBNormalDistribution\fR \fImean\fR \fIvariance\fR)' -Measure the CPU-time required to find the best fit, -for the specified number of randomly generated, virtual files, -the size of which conform to the required probability-distribution, -and the names of which reflect their size, & then exit. +\fB--testPerformance='(\fR\fIInteger\fR\fB,\fR \fBPoissonDistribution\fR \fIlambda\fR\fB)'\fR +Measures the CPU-time required to find the best fit, +for the specified number of randomly generated virtual files, +the size of which conform to the specified probability-distribution, +& the names of which reflect their size ... & then exits. .TP -\fB--graphPerformance\fR='\fBPoissonDistribution\fR \fIlambda\fR | \fBNormalDistribution\fR \fImean\fR \fIvariance\fR' -Measure the CPU-time required to find the best fit, -for a linearly increasing number of randomly generated, virtual files, -the size of which conform to the required probability-distribution, -and the names of which reflect their size. +\fB--graphPerformance='\fR\fBPoissonDistribution\fR \fIlambda\fR\fB'\fR +Measures the CPU-time required to find the best fit, +for a linearly increasing number of randomly generated virtual files, +the size of which conform to the specified probability-distribution, +& the names of which reflect their size. +.br Doesn't normally terminate. .TP \fB-v\fR, \fB--verbose\fR -Produce additional explanatory output where appropriate. +Produces additional explanatory output where appropriate. +.br This option, if required, may need to precede other options. .SS "Generic Program-information" .TP -\fB--version\fR -Output version-information & exit. +.B --version +Outputs version-information & then exits. .TP \fB-?\fR, \fB--help\fR -Display help & exit. -.SS "File-list" +Displays help & then exits. +.SS "File-paths" .TP -When a \fIFILE\fR is defined as a single hyphen-minus (\fB-\fR), replace it with the list of file-names read from standard-input. +If \fIFile-path\fR is a single hyphen-minus (\fB-\fR), replace it with the list of file-paths read from standard-input. .SH EXIT-STATUS \fB0\fR on success, & >\fB0\fR if an error occurs. .SH EXAMPLES @@ -64,48 +71,41 @@ \fBls -p\fR ArabStrap/ BobDylan/ JeffBuckley/ JohnMartyn/ JoniMitchell/ ReservoirDogsOST/ RichardThompson/ SethLakeman/ SusheelaRaman/ TeddyThompson/ Vangelis/ .PP -.TP +.nf \fBsqueeze -M 700000000 -m '999%1000' *\fR - -699871313 ["BobDylan","RichardThompson","SethLakeman","TeddyThompson"] - -.br -699893320 ["ArabStrap","BobDylan","JeffBuckley","JohnMartyn","SethLakeman","SusheelaRaman"] - -.br -\fI699998310\fR ["ArabStrap","BobDylan","JoniMitchell","ReservoirDogsOST","SethLakeman","TeddyThompson","Vangelis"] + 699871313 ["BobDylan","RichardThompson","SethLakeman","TeddyThompson"] + 699893320 ["ArabStrap","BobDylan","JeffBuckley","JohnMartyn","SethLakeman","SusheelaRaman"] + \fI699998310\fR ["ArabStrap","BobDylan","JoniMitchell","ReservoirDogsOST","SethLakeman","TeddyThompson","Vangelis"] +.fi .PP Note that the proposed solutions don't split any of the directories, into their constituent files. .PP We can confirm the validity of the optimal result: -.TP +.PP +.nf \fBfind ArabStrap BobDylan JoniMitchell ReservoirDogsOST SethLakeman TeddyThompson Vangelis -type f -print | perl -e 'use List::Util qw(sum); printf(qq(%d\\n), sum map { chomp; (stat)[7] } <>);'\fR -699998310 + 699998310 +.fi .PP NB: \fBdu\fR will return a slightly larger size, since it includes the space required for directory-structures. .SS Trial 2 We can improve on that result if we're prepared to split some of the artist-specific directories into individual albums. -.TP +.PP +.nf \fBsqueeze -M 700000000 -m '99999%100000' ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST RichardThompson SethLakeman SusheelaRaman TeddyThompson Vangelis\fR -699995815 ["ArabStrap","BobDylan/BlondeOnBlonde","BobDylan/Highway61Revisited","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","JoniMitchell","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] - -.br -699998578 ["BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/StreetLegal","JeffBuckley","JohnMartyn","JoniMitchell","RichardThompson","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] - -.br -\fI699999112\fR ["BobDylan/BlondeOnBlonde","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","JeffBuckley","JohnMartyn","ReservoirDogsOST","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] + 699995815 ["ArabStrap","BobDylan/BlondeOnBlonde","BobDylan/Highway61Revisited","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","JoniMitchell","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] + 699998578 ["BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/StreetLegal","JeffBuckley","JohnMartyn","JoniMitchell","RichardThompson","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] + \fI699999112\fR ["BobDylan/BlondeOnBlonde","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","JeffBuckley","JohnMartyn","ReservoirDogsOST","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] +.fi .SS Trial 3 If we're prepared to add individual files from another artist: -.TP +.PP +.nf \fBsqueeze -M 700000000 -m '9999999%10000000' ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST $(find RichardThompson -type f) SethLakeman SusheelaRaman TeddyThompson Vangelis\fR - -699999964 ["ArabStrap","BobDylan/Desire","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JohnMartyn","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-06-MySoulMySoul.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] - -.br -699999987 ["BobDylan/BlondeOnBlonde","BobDylan/BloodOnTheTracks","BobDylan/Desire","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/IWantToSeeTheBrightLightsTonight/RichardAndLindaThompson-13-TheCalvaryCross[Live-Bonus].ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] - -.br -\fI700000000\fR ["ArabStrap","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/RumorAndSigh/RichardThompson-08-BacklashLoveAffair.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-04-ALoveYouCantSurvive.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","SusheelaRaman","TeddyThompson","Vangelis"] + 699999964 ["ArabStrap","BobDylan/Desire","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JohnMartyn","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-06-MySoulMySoul.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] + 699999987 ["BobDylan/BlondeOnBlonde","BobDylan/BloodOnTheTracks","BobDylan/Desire","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/IWantToSeeTheBrightLightsTonight/RichardAndLindaThompson-13-TheCalvaryCross[Live-Bonus].ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] + \fI700000000\fR ["ArabStrap","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/RumorAndSigh/RichardThompson-08-BacklashLoveAffair.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-04-ALoveYouCantSurvive.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","SusheelaRaman","TeddyThompson","Vangelis"] +.fi .PP ^C .PP @@ -116,8 +116,6 @@ .SH BUGS .SS "REPORTING BUGS" Report bugs to \fBsqueeze\fR \fIat\fR \fBfunctionalley\fR \fIdot\fR \fBeu\fR -.PP -Home page: \fBhttp://functionalley.eu\fR .SH COPYRIGHT Copyright \(co 2010 Dr. Alistair Ward .PP @@ -127,4 +125,11 @@ .PP You should have received a copy of the GNU General Public License along with this program. If not, see \fB\fR. .SH "SEE ALSO" -The full documentation for \fBsqueeze\fR is generated by \fBHaddock\fR, & is available in the distribution. +.IP \(bu +Home-page: \fBhttp://functionalley.eu\fR +.IP \(bu +Source-documentation is generated by \fBHaddock\fR, & is available in the distribution. +.IP \(bu +.I http://www.haskell.org/haddock/ +.IP \(bu +.I http://en.wikipedia.org/wiki/QuickCheck diff --git a/squeeze.cabal b/squeeze.cabal --- a/squeeze.cabal +++ b/squeeze.cabal @@ -1,6 +1,6 @@ --Package-properties Name: squeeze -Version: 1.0.2.3 +Version: 1.0.2.4 Cabal-Version: >= 1.6 Copyright: (C) 2010 Dr. Alistair Ward License: GPL @@ -11,12 +11,12 @@ 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: Utils -Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0 +Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0, GHC == 7.4 Homepage: http://functionalley.eu Maintainer: squeeze functionalley eu Bug-reports: squeeze functionalley eu Data-files: -Extra-Source-Files: man/man1/*.1, *.spec, changelog, copyright, debian/DEBIAN/control, makefile +Extra-Source-Files: changelog copyright debian/DEBIAN/control makefile man/man1/*.1 *.spec flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. @@ -40,9 +40,10 @@ directory, factory >= 0.1, filepath, + mtl, QuickCheck >= 2.4, random, - toolshed == 0.13.*, + toolshed >= 0.13, unix GHC-options: -Wall -O2 diff --git a/squeeze.spec b/squeeze.spec --- a/squeeze.spec +++ b/squeeze.spec @@ -1,13 +1,29 @@ +# Copyright (C) 2012 Dr. Alistair Ward +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + %define package %name-%version %define tarBall %package.tar.gz %define _bindir %prefix/bin -%define _datadir %prefix/share/%package -%define _docdir %prefix/share/doc/%package -%define _mandir %prefix/share/man +%define _sharedir %prefix/share +%define _datadir %_sharedir/%package +%define _docdir %_sharedir/doc/%package +%define _mandir %_sharedir/man -Summary: Finds the optimal subset of the specified files, to fit into a limited space, with minimal wastage. +Summary: Finds the optimal subset of the specified files, to fit into a limited space, with minimal wastage Name: squeeze -Version: 1.0.2.3 +Version: 1.0.2.4 Release: 1 License: GPLv3 #From '/usr/share/doc/packages/rpm/GROUPS'. @@ -15,33 +31,37 @@ Source0: http://functionalley.eu/Downloads/sdist/%tarBall URL: http://functionalley.eu Prefix: /usr +BuildRequires: ghc %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 -rm -rf -- '%package/' -CABAL_CONFIGURE_OPTIONS='--user' make --directory="$OLDPWD/" sdist && mv -- "$OLDPWD/dist/%tarBall" '%_sourcedir/' && tar -zxf '%_sourcedir/%tarBall' #Build & copy the tar-ball into the source-directory, then unpack it into the build-directory. +(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. %build +cd '%package/' && runhaskell Setup build #Descend into the source-distribution and build according to the previously established configuration. %install -rm -rf -- '%buildroot' #Clean any previous build. CAVEAT: the user might have specified '--buildroot', for which I can't account. -CABAL_CONFIGURE_OPTIONS='--user --prefix=%buildroot%prefix/' make --directory='%package/' install #Which regrettably also builds 'Haddock', which then requires 'HsColour'. -mkdir -p -- '%buildroot%_mandir/' && mv -- '%_builddir/%package/man/man1' '%buildroot%_mandir/' -mkdir -p -- '%buildroot%_docdir/' && mv -- %_builddir/%package/{changelog,copyright,LICENSE} '%buildroot%_docdir/' -rm -rf -- '%buildroot%_docdir/html' #We don't need source-code documentation in a binary package. +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/' +mkdir -p -- '%buildroot%_mandir' && mv -- 'man/man1' '%buildroot%_mandir/' %clean -make --directory='%package/' clobber -rm -- '%_sourcedir/%tarBall' -rm -rf -- '%_builddir/%package' '%buildroot' +make --directory='%package' clobber +rm -rf -- '%_builddir/%package/' '%buildroot' %files -%attr(0755, root, root) %_bindir/squeeze -%attr(0644, root, root) %doc %_mandir/man1/*.1.gz +%attr(0755, root, root) %_bindir/%name %attr(0644, root, root) %doc %_docdir/changelog %attr(0644, root, root) %doc %_docdir/copyright %attr(0644, root, root) %doc %_docdir/LICENSE +%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. diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -31,6 +31,8 @@ -- CommandOptions', -- CommandLineAction, -- * Functions +-- read', +-- readCommandArg, main ) where @@ -51,9 +53,11 @@ import qualified System.Console.GetOpt as G import qualified System.Environment import qualified System.Exit +import qualified System.FilePath import qualified System.IO import qualified System.IO.Error import qualified Test.QuickCheck +import qualified Text.Printf import qualified ToolShed.Defaultable import qualified ToolShed.SelfValidate import qualified ToolShed.System.TimeAction @@ -64,29 +68,34 @@ -- | 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 " + {- | * Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', some of which may over-ride the 'ToolShed.Defaultable.defaultValue'. * 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 'System.IO.stdin' is read, to augment other non-options specified. + * 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 'Squeeze.squeeze'. - Because this may take an inordinately long time, - it prints the results in real time, rather than batching until the optimum has been determined. + Because this may take a long time, it prints the results in real time, rather than batching until the optimum has been determined. - * If /verbose/ has been specified, prints the CPU-time used, + * If /verbose/ has been specified, prints the CPU-time used. -} main :: IO () main = do progName <- System.Environment.getProgName - args <- System.Environment.getArgs let - usage :: String - usage = "Usage:\t" ++ G.usageInfo progName optDescrList ++ " [, ...]\n\nExamples:\n\t" ++ progName ++ " -M 700000000 *.ogg\t\t#Find the best-fit for the globbed file-names, into the space available on a CD." - defaultValue :: CommandOptions' defaultValue = ToolShed.Defaultable.defaultValue @@ -96,47 +105,49 @@ G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help, & then exit.", G.Option "v" ["verbose"] (G.NoArg $ return . Data.CommandOptions.setVerbose) "Produce additional explanatory output where appropriate. CAVEAT: to be effective, it should precede other options.", G.Option "" ["version"] (G.NoArg $ const printVersion) "Print version-information, & then exit.", - G.Option "b" ["bisectionRatio"] (setBisectionRatio `G.ReqArg` "") ("The list of file-paths is bisected at LHS/Total, & combinations from the LHS, concatenated with each of those from the RHS; default '" ++ show (Data.CommandOptions.bisectionRatio defaultValue) ++ "'."), + G.Option "b" ["bisectionRatio"] (setBisectionRatio `G.ReqArg` "") ("The list of file-paths is bisected at LHS/Total, & combinations from the LHS, concatenated with each of those from the RHS; default '" ++ show (Data.CommandOptions.bisectionRatio defaultValue) ++ "'."), + G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.ReqArg` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.includeEmpty defaultValue) ++ "'."), G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.maximumBytes defaultValue) ++ "'."), - G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("The minimum acceptable space usage-ratio; default '" ++ show (Data.CommandOptions.minimumUsageRatio defaultValue) ++ "'."), - G.Option "q" ["runQuickChecks"] (G.NoArg runQuickChecks) "Run Quick-checks using arbitrary data & then exit.", + G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("The minimum acceptable space usage-ratio; default '" ++ show (Data.CommandOptions.minimumUsageRatio defaultValue) ++ "'."), + G.Option "q" ["runQuickChecks"] (G.NoArg runQuickChecks) "Run Quick-checks using arbitrary data, & then exit.", G.Option "" ["testPerformance"] ( - testPerformance `G.ReqArg` "(, )" - ) "Test the performance, using the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution; then exit.", + testPerformance `G.ReqArg` "(, )" + ) "Test the performance, using the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution, & then exit", G.Option "" ["graphPerformance"] ( - graphPerformance `G.ReqArg` "" + graphPerformance `G.ReqArg` "" ) "Graph the performance, against a linearly increasing number of randomly generated virtual files, the size of which conform to the specified probability-distribution. Doesn't normally terminate." ] where - setBisectionRatio, setMaximumBytes, setMinimumUsageRatio, testPerformance, graphPerformance :: String -> CommandLineAction - setBisectionRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.bisectionRatio = read arg} - setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.maximumBytes = read arg} - setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.minimumUsageRatio = read arg} + setBisectionRatio, setIncludeEmpty, setMaximumBytes, setMinimumUsageRatio, testPerformance, graphPerformance :: String -> CommandLineAction + setBisectionRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.bisectionRatio = readCommandArg arg} + setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.includeEmpty = readCommandArg arg} + setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.maximumBytes = readCommandArg arg} + setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.minimumUsageRatio = readCommandArg arg} - testPerformance arg commandOptions = if not $ ToolShed.SelfValidate.isValid commandOptions - then error $ ToolShed.SelfValidate.getFirstError commandOptions - else do + testPerformance arg commandOptions + | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions + | otherwise = do ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print System.Exit.exitWith System.Exit.ExitSuccess where fileCount :: Int probabilityDistribution :: Factory.Math.Probability.DiscreteDistribution Double - (fileCount, probabilityDistribution) = read arg + (fileCount, probabilityDistribution) = readCommandArg arg - graphPerformance arg commandOptions = if not $ ToolShed.SelfValidate.isValid commandOptions - then error $ ToolShed.SelfValidate.getFirstError commandOptions - else do + graphPerformance arg commandOptions + | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions + | otherwise = do mapM_ (\fileCount -> ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print) [1 ..] System.Exit.exitWith $ System.Exit.ExitFailure 1 where probabilityDistribution :: Factory.Math.Probability.DiscreteDistribution Double - probabilityDistribution = read arg + probabilityDistribution = readCommandArg arg runQuickChecks :: (Num f, Ord f, Show f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f) - runQuickChecks commandOptions = if not $ ToolShed.SelfValidate.isValid commandOptions - then error $ ToolShed.SelfValidate.getFirstError commandOptions - else do + runQuickChecks commandOptions + | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions + | otherwise = do Test.QC.quickChecks $ if Data.CommandOptions.verbose commandOptions then #if MIN_VERSION_QuickCheck(2,4,0) @@ -149,14 +160,28 @@ 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\nCopyright (C) 2010 Dr. Alistair Ward.\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by Dr. Alistair Ward.") >> System.Exit.exitWith System.Exit.ExitSuccess where + printVersion = Text.Printf.printf "%s\n\n%s %s.\n%s.\n%s.\n%s %s.\n" packageName "Copyright (C) 2010" author "This program comes with ABSOLUTELY NO WARRANTY" "This is free software, & you are welcome to redistribute it under certain conditions" "Written by" author >> System.Exit.exitWith System.Exit.ExitSuccess where packageIdentifier :: Distribution.Package.PackageIdentifier packageIdentifier = Distribution.Package.PackageIdentifier { - Distribution.Package.pkgName = Distribution.Package.PackageName "squeeze", + Distribution.Package.pkgName = Distribution.Package.PackageName progName, --CAVEAT: coincidentally. Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] } - printUsage = System.IO.hPutStrLn System.IO.stderr usage >> System.Exit.exitWith System.Exit.ExitSuccess + packageName, author :: String + packageName = Distribution.Text.display packageIdentifier + author = "Dr. Alistair Ward" + + printUsage = Text.Printf.hPrintf System.IO.stderr "Usage:\t%s %s\n\nEBNF argument-format:\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\nE.g.\n\t%s\n\t%s\n" ( + G.usageInfo progName optDescrList + ) "[ ...]" "Bool" "\"True\" | \"False\"\t(* Case-sensitive *)" "Integer" "[0-9]+" "File-path" ( + "File-name | File-name '" ++ [System.FilePath.pathSeparator] ++ "' File-path" + ) "ProbabilityDistribution" "PoissonDistribution Integer\t(* Defines both mean & variance *)" "Rational" "Integer '%' Integer\t(* I.e. a fraction *)" ( + progName ++ " -M 700000000 *.ogg\t#Find the best-fit for the globbed file-names, into the space available on a CD." + ) ( + progName ++ " -v --testPerformance='(100, PoissonDistribution 1000000000)'\t#Test performance." + ) >> System.Exit.exitWith System.Exit.ExitSuccess + + args <- System.Environment.getArgs -- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr CommandLineAction] -> [String] -> ([CommandLineAction], [String], [String]) case G.getOpt G.RequireOrder optDescrList args of diff --git a/src/Squeeze/Data/CommandOptions.hs b/src/Squeeze/Data/CommandOptions.hs --- a/src/Squeeze/Data/CommandOptions.hs +++ b/src/Squeeze/Data/CommandOptions.hs @@ -19,9 +19,9 @@ [@DESCRIPTION@] - * Defines options for program-operation, which are expected to be set from the command-line. + * Defines options for program-operation. - * Defines an appropriate default value. + * Defines an appropriate default value, which is expected to be over-ridden on the command-line. * Self-validates. -} @@ -32,14 +32,17 @@ CommandOptions( -- MkCommandOptions, bisectionRatio, + includeEmpty, maximumBytes, minimumUsageRatio, verbose ), -- * Functions - fileSizeBounds, - minimumBytes, - setVerbose + solutionSizeBounds, +-- minimumBytes, + setVerbose, +-- ** Predicates + withinSizeBounds ) where import qualified Factory.Data.Interval @@ -54,6 +57,7 @@ -} data CommandOptions ratio = MkCommandOptions { bisectionRatio :: ratio, -- ^ The file-list is bisected at LHS/Total, and combinations from the LHS are concatenated with each of those from the RHS. + includeEmpty :: Bool, -- ^ Whether empty directories or files should be included in any solution. maximumBytes :: Data.File.FileSize, -- ^ The maximum space (in bytes) available in which to store a subset of the specified files. minimumUsageRatio :: ratio, -- ^ The minimum acceptable usage of 'maximumBytes'. verbose :: Bool -- ^ Output ancillary information. @@ -62,6 +66,7 @@ instance Fractional f => ToolShed.Defaultable.Defaultable (CommandOptions f) where defaultValue = MkCommandOptions { bisectionRatio = recip 2, --Bisection the file-list into equal halves. + includeEmpty = False, maximumBytes = 4700000000, --DVD-size; just under 4.4GiB. minimumUsageRatio = 99 / 100, --99% full. verbose = False @@ -80,11 +85,20 @@ minimumBytes :: RealFrac f => CommandOptions f -> Data.File.FileSize minimumBytes commandOptions = floor $ minimumUsageRatio commandOptions * realToFrac (maximumBytes commandOptions) --- | The permissible bounds on the size of a file, or set of files. -fileSizeBounds :: RealFrac f => CommandOptions f -> Factory.Data.Interval.Interval Data.File.FileSize -fileSizeBounds commandOptions = (minimumBytes commandOptions, maximumBytes commandOptions) +-- | The bounds on the aggregate size of the set of files. +solutionSizeBounds :: RealFrac f => CommandOptions f -> Factory.Data.Interval.Interval Data.File.FileSize +solutionSizeBounds commandOptions = (minimumBytes commandOptions, maximumBytes commandOptions) -- | Mutator. setVerbose :: CommandOptions f -> CommandOptions f setVerbose commandOptions = commandOptions { verbose = True } + +-- | Whether a file of the specified size is an acceptable component of any solution. +withinSizeBounds :: CommandOptions f -> Data.File.FileSize -> Bool +withinSizeBounds commandOptions size = all ($ size) [ + if includeEmpty commandOptions + then (>= 0) + else (> 0), + (<= maximumBytes commandOptions) + ] diff --git a/src/Squeeze/Data/File.hs b/src/Squeeze/Data/File.hs --- a/src/Squeeze/Data/File.hs +++ b/src/Squeeze/Data/File.hs @@ -88,7 +88,7 @@ then System.IO.withFile f System.IO.ReadMode System.IO.hFileSize else {-not a regular file-} if System.Posix.Files.isDirectory stat then System.Directory.getDirectoryContents f >>= fmap {-into IO-monad-} aggregateSize . findSizes . map (f ) . filter (`notElem` [".", ".."]) --Treat any directory as an atomic unit. - else {-non-directory-} Control.Exception.throw $ System.IO.Error.mkIOError System.IO.Error.illegalOperationErrorType ("file='" ++ f ++ "' has unexpected type") Nothing (Just f) + else {-non-directory-} Control.Exception.throw $ System.IO.Error.mkIOError System.IO.Error.illegalOperationErrorType ("file=" ++ show f ++ " has unexpected type") Nothing (Just f) -- | Finds file-sizes. findSizes :: FilePathList -> IO [FileSizeAndPath] diff --git a/src/Squeeze/Squeeze.hs b/src/Squeeze/Squeeze.hs --- a/src/Squeeze/Squeeze.hs +++ b/src/Squeeze/Squeeze.hs @@ -28,7 +28,7 @@ [@CAVEATS@] - Though it runs in constant space, the algorithm has @O(2^n)@ time-complexity, and may take an excessive time to calculate all possibilities. + * Though it runs in constant space, the algorithm has @O(2^n)@ time-complexity, and may take an excessive time to calculate all possibilities. -} module Squeeze.Squeeze( @@ -38,13 +38,15 @@ distribute, findBestFit, -- getFileSizeStatistics, - findBestFitM, + findBestFitWriter, squeeze ) where +import Control.Applicative((<$>)) import Control.Arrow((&&&)) import qualified Control.Arrow import qualified Control.Monad +import qualified Control.Monad.Writer import qualified Data.List import qualified Factory.Data.Interval import qualified Factory.Math.Statistics @@ -79,8 +81,8 @@ -} findCombinations :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The acceptable size-span of file-combinations. - -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. - -> [Data.FileCombination.FileCombination] -- ^ The resulting unordered list of suitable file-combinations. + -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. + -> [Data.FileCombination.FileCombination] -- ^ The resulting unordered list of suitable file-combinations. findCombinations (minimumCombinationSize, maximumCombinationSize) = filter ( Data.FileCombination.hasSize (>= minimumCombinationSize) ) . ( @@ -107,16 +109,17 @@ combinationIncluding = fileSizeAndPath +> combinationExcluding -- | Bisects the data and calls 'findCombinations' on the halves. -distribute :: RealFrac ratio +distribute + :: RealFrac ratio => ratio -- ^ The ratio at which to bisect the list of files, in a /divide-and-conquer/ strategy. -> Factory.Data.Interval.Interval Data.File.FileSize -- ^ The /interval/ within which to find file-combinations. -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. -> [Data.FileCombination.FileCombination] -- ^ The complete unordered list of suitable file-combinations. -distribute bisectionRatio fileSizeBounds fileSizeAndPathList +distribute bisectionRatio solutionSizeBounds fileSizeAndPathList | any ($ bisectionIndex) [ (<= 0), (>= fileSizeAndPathListLength) - ] = findCombinations fileSizeBounds fileSizeAndPathList --Bisecting @ either the zeroeth, or the last element, leaves only one non-null list. + ] = findCombinations solutionSizeBounds fileSizeAndPathList --Bisecting @ either the zeroeth, or the last element, leaves only one non-null list. | otherwise = distribute' `uncurry` splitAt bisectionIndex fileSizeAndPathList where fileSizeAndPathListLength, bisectionIndex :: Int @@ -126,9 +129,9 @@ distribute' :: [Data.File.FileSizeAndPath] -> [Data.File.FileSizeAndPath] -> [Data.FileCombination.FileCombination] distribute' fileSizeAndPathListL fileSizeAndPathListR = concatMap ( \combinationL -> (combinationL <+>) `map` findCombinations ( - negate (Data.FileCombination.getAggregateFileSize combinationL) `Factory.Data.Interval.shift` fileSizeBounds + negate (Data.FileCombination.getAggregateFileSize combinationL) `Factory.Data.Interval.shift` solutionSizeBounds ) fileSizeAndPathListR - ) $ Control.Arrow.first (+ negate (Data.File.aggregateSize fileSizeAndPathListR)) {-Adjust the lower bound-} fileSizeBounds `findCombinations` fileSizeAndPathListL + ) $ Control.Arrow.first (+ negate (Data.File.aggregateSize fileSizeAndPathListR)) {-Adjust the lower bound-} solutionSizeBounds `findCombinations` fileSizeAndPathListL {- | * Calls 'Data.File.order' to sort the files by size (largest first), on the empirical basis that the generated file-combinations, will more quickly result in a good match for the available space. @@ -137,58 +140,68 @@ * Calls the private function 'risingFilter' to progressively select better file-combinations from those returned by 'distribute'. -} -findBestFit :: RealFrac ratio +findBestFit + :: RealFrac ratio => ratio -- ^ The ratio at which to bisect the list of files, in a /divide-and-conquer/ strategy. -> Factory.Data.Interval.Interval Data.File.FileSize -- ^ The /interval/ within which to find file-combinations. -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. -> [Data.FileCombination.FileCombination] -- ^ A reduced list of suitable file-combinations, sorted best first. -findBestFit bisectionRatio fileSizeBounds = risingFilter (Factory.Data.Interval.getMinBound fileSizeBounds) . distribute bisectionRatio fileSizeBounds . Data.File.orderBySize +findBestFit bisectionRatio solutionSizeBounds = risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . distribute bisectionRatio solutionSizeBounds . Data.File.orderBySize -- | Acquire statistics related to a list of files. -getFileSizeStatistics :: (Fractional mean, Floating standardDeviation) => [Data.File.FileSizeAndPath] -> (Int, Data.File.FileSize, mean, standardDeviation) -getFileSizeStatistics l = (length l, sum sizes, Factory.Math.Statistics.getMean sizes, Factory.Math.Statistics.getStandardDeviation sizes) where +getFileSizeStatistics + :: (Fractional mean, Floating standardDeviation) + => [Data.File.FileSizeAndPath] + -> (Int, Data.File.FileSize, mean, standardDeviation) -- ^ (Number of components, Total size, Mean size, Standard-deviation). +getFileSizeStatistics l = ( + length l, + sum sizes, + Factory.Math.Statistics.getMean sizes, + Factory.Math.Statistics.getStandardDeviation sizes + ) where sizes = map Data.File.getSize l {- | - * Optionally prints file-statistics. - * Unpacks the command-line options. * Removes files which individually are of unsuitable size. - * Optionally prints file-size statistics. + * Optionally writes file-size statistics. * Calls 'findBestFit' to solve the problem. -} -findBestFitM :: RealFrac ratio - => Data.CommandOptions.CommandOptions ratio -- ^ The caller's selection-criteria. - -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. - -> IO [Data.FileCombination.FileCombination] -- ^ A reduced list of suitable file-combinations, sorted best first. -findBestFitM commandOptions fileSizeAndPathList = let - bisectionRatio = Data.CommandOptions.bisectionRatio commandOptions - fileSizeBounds = Data.CommandOptions.fileSizeBounds commandOptions - maximumBytes = Data.CommandOptions.maximumBytes commandOptions - verbose = Data.CommandOptions.verbose commandOptions - - (fileSizeAndPathList', rejectedFiles) = Data.List.partition (Data.File.hasSize (\size -> all ($ size) [(>= 0), (<= maximumBytes)])) fileSizeAndPathList +findBestFitWriter + :: RealFrac ratio + => Data.CommandOptions.CommandOptions ratio -- ^ The caller's selection-criteria. + -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes. + -> Control.Monad.Writer.Writer [String] [Data.FileCombination.FileCombination] -- ^ A reduced list of suitable file-combinations, sorted best first. +findBestFitWriter commandOptions fileSizeAndPathList = let + (fileSizeAndPathList', rejectedFiles) = Data.List.partition ( + Data.File.hasSize (Data.CommandOptions.withinSizeBounds commandOptions) + ) fileSizeAndPathList in do - Control.Monad.when verbose $ do - Control.Monad.unless (null rejectedFiles) . System.IO.hPutStrLn System.IO.stderr $ "Squeeze.Squeeze:\trejecting files of unsuitable size; " ++ show rejectedFiles + Control.Monad.unless (null rejectedFiles) $ Control.Monad.Writer.tell ["Rejecting components of unsuitable size; " ++ show rejectedFiles] - System.IO.hPutStrLn System.IO.stderr $ "Squeeze.Squeeze:\tfile-(count, total size, mean, standard-deviation):\t" ++ show (getFileSizeStatistics fileSizeAndPathList' :: (Int, Data.File.FileSize, Double, Double)) + Control.Monad.Writer.tell ["Component-(count, total size, mean, standard-deviation):\t" ++ show (getFileSizeStatistics fileSizeAndPathList' :: (Int, Data.File.FileSize, Double, Double))] - return $ findBestFit bisectionRatio fileSizeBounds fileSizeAndPathList' + return {-to Writer-monad-} $ findBestFit (Data.CommandOptions.bisectionRatio commandOptions) (Data.CommandOptions.solutionSizeBounds commandOptions) fileSizeAndPathList' {- | * Removes duplicate file-names. * Determines the size of each specified file. - * Calls 'findBestFitM' to solve the problem. + * Calls 'findBestFitWriter' to solve the problem. -} -squeeze :: RealFrac ratio +squeeze + :: RealFrac ratio => Data.CommandOptions.CommandOptions ratio -- ^ The caller's selection-criteria. -> Data.File.FilePathList -- ^ The list of file-names from which to select. -> IO [Data.FileCombination.FileCombination] -squeeze commandOptions filePathList = Data.File.findSizes (Data.List.nub filePathList) >>= findBestFitM commandOptions +squeeze commandOptions filePathList = do + (bestFileCombinations, log') <- Control.Monad.Writer.runWriter . findBestFitWriter commandOptions <$> Data.File.findSizes (Data.List.nub filePathList) + + Control.Monad.when (Data.CommandOptions.verbose commandOptions) $ mapM_ (System.IO.hPutStrLn System.IO.stderr) log' + + return {-to IO-monad-} bestFileCombinations diff --git a/src/Squeeze/Test/Performance.hs b/src/Squeeze/Test/Performance.hs --- a/src/Squeeze/Test/Performance.hs +++ b/src/Squeeze/Test/Performance.hs @@ -25,16 +25,19 @@ run ) where +import Control.Applicative((<$>)) import Control.Arrow((&&&)) +import qualified Control.Monad +import qualified Control.Monad.Writer import qualified Factory.Math.Probability import qualified Squeeze.Data.CommandOptions as Data.CommandOptions 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. + * 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 requested distribution. @@ -42,8 +45,13 @@ -} run :: (RealFrac ratio, RealFloat f, Show f, System.Random.Random f) => Data.CommandOptions.CommandOptions ratio - -> Int -- ^ The number of /virtual/ files to randomly generate. + -> Int -- ^ The number of /virtual/ files to randomly generate. -> Factory.Math.Probability.DiscreteDistribution f - -> IO [Data.FileCombination.FileCombination] -- ^ The results. -run commandOptions fileCount probabilityDistribution = System.Random.getStdGen >>= Squeeze.findBestFitM commandOptions . map (id &&& show) . Factory.Math.Probability.generateDiscretePopulation fileCount probabilityDistribution + -> IO [Data.FileCombination.FileCombination] +run commandOptions fileCount probabilityDistribution = do + (bestFileCombinations, log') <- Control.Monad.Writer.runWriter . Squeeze.findBestFitWriter commandOptions . map (id &&& show) . Factory.Math.Probability.generateDiscretePopulation fileCount probabilityDistribution <$> System.Random.getStdGen + + Control.Monad.when (Data.CommandOptions.verbose commandOptions) $ mapM_ (System.IO.hPutStrLn System.IO.stderr) log' + + return {-to IO-monad-} bestFileCombinations diff --git a/src/Squeeze/Test/QC.hs b/src/Squeeze/Test/QC.hs --- a/src/Squeeze/Test/QC.hs +++ b/src/Squeeze/Test/QC.hs @@ -72,7 +72,7 @@ maximumBytes = round $ fromIntegral (Data.File.aggregateSize l) / (4.0 :: Double) --Arbitrarily. minimumBytes = maximumBytes `div` 2 --Arbitrarily. - prop_all fileSizeAndPathList = Test.QuickCheck.label "prop_all" . (== bytes) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (recip 2 :: Double) (Factory.Data.Interval.precisely bytes) l where + prop_all fileSizeAndPathList = Test.QuickCheck.label "prop_all" . (== bytes) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (recip 2 :: Double) (Factory.Data.Interval.precisely bytes) l where l :: [Data.File.FileSizeAndPath] l = take 16 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested.