module Squeeze.Squeeze(
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
findCombinations
:: Factory.Data.Interval.Interval Data.File.FileSize
-> [Data.File.FileSizeAndPath]
-> [Data.FileCombination.FileCombination]
findCombinations (minimumCombinationSize, maximumCombinationSize) = filter (
Data.FileCombination.hasSizeBy (>= minimumCombinationSize)
) . (
Data.FileCombination.nullFileCombination :
) . nonEmptyCombinations minimumCombinationSize . uncurry zip . (
id &&& Data.File.accumulateSize
) . dropWhile (
Data.File.hasSizeBy (> maximumCombinationSize)
) where
nonEmptyCombinations :: Data.File.FileSize -> [(Data.File.FileSizeAndPath, Data.File.FileSize)] -> [Data.FileCombination.FileCombination]
nonEmptyCombinations _ [] = []
nonEmptyCombinations minimumBytes ((fileSizeAndPath, aggregateSize) : remainder)
| aggregateSize < minimumBytes = []
| otherwise = Data.FileCombination.singleton fileSizeAndPath : foldr binaryChoice [] (
nonEmptyCombinations (minimumBytes Data.File.getSize fileSizeAndPath) remainder
)
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
findBestFit
:: Factory.Data.Interval.Interval Data.File.FileSize
-> [Data.File.FileSizeAndPath]
-> [Data.FileCombination.FileCombination]
findBestFit solutionSizeBounds = Data.FileCombination.risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . findCombinations solutionSizeBounds . Data.File.orderByDecreasingSize
distributeAndFindBestFit
:: RealFrac ratio
=> Data.CommandOptions.CommandOptions ratio
-> [Data.File.FileSizeAndPath]
-> IO [Data.FileCombination.FileCombination]
distributeAndFindBestFit commandOptions fileSizeAndPathList = let
slave _ _ [] = return [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 $ findBestFit solutionSizeBounds increasingFileSizeAndPathList
slave numCapabilities' commandOptions' (selectedFileSizeAndPath : remainingFileSizeAndPaths) = let
recurse = slave $ numCapabilities' `div` 2
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' remainingFileSizeAndPaths
let
commandOptions'' = Data.CommandOptions.subtractFile (Data.File.getSize selectedFileSizeAndPath) commandOptions'
if Data.CommandOptions.getMaximumBytes commandOptions'' < 0
then return fileCombinationsExcludingSelected
else map (
Data.FileCombination.prepend selectedFileSizeAndPath
) `fmap` recurse commandOptions'' remainingFileSizeAndPaths >>= Control.Concurrent.DivideAndConquer.divideAndConquer Data.FileCombination.risingMergeByAggregateFileSize fileCombinationsExcludingSelected
in Control.Concurrent.getNumCapabilities >>= (\numCapabilities -> slave numCapabilities commandOptions $ Data.File.orderByIncreasingSize fileSizeAndPathList)
partitionEmptyFilesAndDistributeAndFindBestFit
:: RealFrac ratio
=> Data.CommandOptions.CommandOptions ratio
-> [Data.File.FileSizeAndPath]
-> 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 emptyFiles
) `fmap` nonEmptyFileCombinations
| otherwise = 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