diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -11,12 +11,18 @@ import System.Console.CmdArgs import System.Exit +import Control.Exception (finally) import Control.Monad (filterM, forM, forM_, unless, when) -import Data.Word (Word8) - import Data.List (intersperse, isSuffixOf, partition) import Data.Maybe (fromMaybe) +import Data.Word (Word8) +#ifdef mingw32_HOST_OS +import Data.Function (on) +import Data.List (groupBy, sortBy) +import Data.Ord (comparing) +#endif + import Context import DefinitionHelpers import ExpressionConversion @@ -30,10 +36,16 @@ import PerformOperations import SimpleDefinitionCycles -import System.Directory (doesFileExist, getCurrentDirectory, - listDirectory, removeFile) +import System.Directory (doesDirectoryExist, doesFileExist, + getCurrentDirectory, listDirectory, + removeDirectoryRecursive, removeFile) import System.FilePath (dropFileName, ()) +#ifdef mingw32_HOST_OS +import System.Directory (renameFile) +import System.FilePath (takeFileName) +#endif + #ifndef mingw32_HOST_OS import System.Posix.Files (createLink) #endif @@ -48,6 +60,7 @@ { outputDirectory :: Maybe FilePath , setdownFile :: Maybe FilePath , showTransient :: Bool + , keepProcessing :: Bool } deriving (Show, Data, Typeable) options :: Options @@ -69,6 +82,10 @@ &= explicit &= name "show-transient" &= help "Also show intermediate results for sub-expressions generated internally to evaluate your definitions. Useful for debugging complex .setdown files." + , keepProcessing = def + &= explicit + &= name "keep-processing" + &= help "Keep the processing/ subdirectory after the run completes instead of deleting it. Useful for inspecting intermediate files when debugging." } &= program "setdown" &= summary "setdown evaluates a .setdown definitions file to perform set operations (intersection, union, difference) on line-based text files, writing one result file per definition to an output directory." @@ -128,9 +145,11 @@ putStrLn "==> Creating the environment..." let baseDir = dropFileName inputFilePath + let outputDir = baseDir fromMaybe "output" (outputDirectory opts) let context = standardContext { cBaseDir = baseDir - , cOutputDir = baseDir fromMaybe "output" (outputDirectory opts) + , cOutputDir = outputDir + , cProcessingDir = outputDir "processing" } putStrLn $ " Base Directory: " ++ cBaseDir context @@ -191,34 +210,43 @@ putStrLn " OK: No cycles were found in the definitions." printNewline - putStrLn "==> Sorting and de-duplicated input files from the definitions..." - -- Step 1: For every unique file, sort it (Use external sort for this purpose: - -- https://hackage.haskell.org/package/external-sort-0.2/docs/Algorithms-ExternalSort.html add - -- docs to that library if at all possible) - -- TODO use file timestamps to not sort these big files more than once if possible - sortedFiles <- extractAndSortFiles context (S.toList . extractFilenamesFromDefinitions $ setData) -- TODO use the simple set data here - printTabularResults sortedFiles - printNewline + let cleanup = unless (keepProcessing opts) $ do + exists <- doesDirectoryExist (cProcessingDir context) + when exists $ removeDirectoryRecursive (cProcessingDir context) - putStrLn "==> Setdown results" - -- Step 2: Calculate the graph of everything that needs to be computed and compute things one at - -- a time. Even make sure that you store the temporary results along the way. That way we can - -- refer to them later if the same computation is made twice. We should certainly memoize with - -- the file system. It would be great if we could print out the results of the computations as we - -- go. - computedFiles <- runSimpleDefinitions context simpleSetData sortedFiles - -- Step 3: Publish retained results under their definition names. - publishedFiles <- publishResults context computedFiles - -- Step 4: Count the elements in each result file. - annotatedFiles <- forM publishedFiles $ \(sd, fp) -> do - n <- countLines fp - return (sd, fp, n) - -- Step 5: Print out the final statistics with the definitions pointing to how many elements that - -- each contained and where to find their output files. - printComputedResults opts annotatedFiles + flip finally cleanup $ do + putStrLn "==> Sorting and de-duplicated input files from the definitions..." + -- Step 1: For every unique file, sort it (Use external sort for this purpose: + -- https://hackage.haskell.org/package/external-sort-0.2/docs/Algorithms-ExternalSort.html add + -- docs to that library if at all possible) + -- TODO use file timestamps to not sort these big files more than once if possible + sortedFiles <- extractAndSortFiles context (S.toList . extractFilenamesFromDefinitions $ setData) -- TODO use the simple set data here + printTabularResults sortedFiles + printNewline + + putStrLn "==> Setdown results" + -- Step 2: Calculate the graph of everything that needs to be computed and compute things one at + -- a time. Even make sure that you store the temporary results along the way. That way we can + -- refer to them later if the same computation is made twice. We should certainly memoize with + -- the file system. It would be great if we could print out the results of the computations as we + -- go. + computedFiles <- runSimpleDefinitions context simpleSetData sortedFiles + -- Step 3: Publish retained results under their definition names. + publishedFiles <- publishResults context computedFiles + -- Step 4: Count the elements in each result file. + annotatedFiles <- forM publishedFiles $ \(sd, fp) -> do + n <- countLines fp + return (sd, fp, n) + -- Step 5: Print out the final statistics with the definitions pointing to how many elements that + -- each contained and where to find their output files. + printComputedResults opts annotatedFiles + publishResults :: Context -> [(SimpleDefinition, FilePath)] -> IO [(SimpleDefinition, FilePath)] #ifndef mingw32_HOST_OS +-- Unix: hard-link each retained result from processing/ into output/. +-- createLink is a no-op on the source, so duplicate sources are handled +-- naturally — multiple links can point to the same inode. publishResults ctx results = mapM publish results where publish (sd, src) @@ -230,7 +258,36 @@ return (sd, dest) | otherwise = return (sd, src) #else -publishResults _ results = return results +-- Windows: no hard links available. +-- Group retained definitions by their source file in processing/. +-- Singletons are renamed (atomic move) to output/.txt. +-- Groups that share a source are all pointed at output/, where the +-- UUID comes from the existing filename — the file is moved once and all +-- definitions in the group reference the promoted UUID file. +publishResults ctx results = do + let (retained, transient) = partition (sdRetain . fst) results + published <- fmap concat . mapM (publishGroup ctx) $ groupBySrc retained + return (published ++ transient) + where + groupBySrc = groupBy ((==) `on` snd) . sortBy (comparing snd) + +publishGroup :: Context -> [(SimpleDefinition, FilePath)] -> IO [(SimpleDefinition, FilePath)] +publishGroup _ [] = return [] +publishGroup ctx [(sd, src)] = do + -- Unique source: rename to a human-readable named file. + let dest = cOutputDir ctx LT.unpack (sdId sd) ++ ".txt" + destExists <- doesFileExist dest + when destExists $ removeFile dest + renameFile src dest + return [(sd, dest)] +publishGroup ctx grp@((_, src) : _) = do + -- Shared source: promote the UUID file to output/ keeping its UUID name. + -- All definitions in the group point to this single promoted file. + let dest = cOutputDir ctx takeFileName src + destExists <- doesFileExist dest + when destExists $ removeFile dest + renameFile src dest + return [(sd, dest) | (sd, _) <- grp] #endif countLines :: FilePath -> IO Int diff --git a/setdown.cabal b/setdown.cabal --- a/setdown.cabal +++ b/setdown.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.4.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Treating files as sets to perform rapid set manipulation. diff --git a/src/Context.hs b/src/Context.hs --- a/src/Context.hs +++ b/src/Context.hs @@ -1,18 +1,20 @@ -module Context +module Context ( Context(..) , standardContext , smallContext , prepareContext , inOutput + , inProcessing ) where import Data.Int import System.FilePath (()) import System.Directory (createDirectoryIfMissing) -data Context = Context +data Context = Context { cBaseDir :: FilePath , cOutputDir :: FilePath + , cProcessingDir :: FilePath , cFilesPerMerge :: Int , cBytesPerFileSplit :: Int64 } deriving (Show, Eq) @@ -24,12 +26,18 @@ standardContext = Context { cBaseDir = "./" , cOutputDir = "output" + , cProcessingDir = "output" "processing" , cFilesPerMerge = 10 , cBytesPerFileSplit = 100 * 1024 * 1024 } prepareContext :: Context -> IO () -prepareContext ctx = createDirectoryIfMissing True (cOutputDir ctx) +prepareContext ctx = do + createDirectoryIfMissing True (cOutputDir ctx) + createDirectoryIfMissing True (cProcessingDir ctx) inOutput :: Context -> FilePath -> FilePath inOutput ctx fp = cOutputDir ctx fp + +inProcessing :: Context -> FilePath -> FilePath +inProcessing ctx fp = cProcessingDir ctx fp diff --git a/src/ExternalSort.hs b/src/ExternalSort.hs --- a/src/ExternalSort.hs +++ b/src/ExternalSort.hs @@ -63,7 +63,7 @@ sequence_ . fmap (uncurry T.writeFile) $ namesAndContents return . fmap fst $ namesAndContents where - names = map (\num -> cOutputDir ctx inputFile ++ "." ++ show num ++ ".split") [(1 :: Integer)..] + names = map (\num -> cProcessingDir ctx inputFile ++ "." ++ show num ++ ".split") [(1 :: Integer)..] mergeFiles :: Context -> [FilePath] -> IO FilePath mergeFiles _ [] = error "Tried to merge no files..." @@ -77,7 +77,7 @@ directMergeFiles ctx fps = do fileContents <- fmap T.lines <$> mapM T.readFile fps randomFilename <- fmap show UUID.nextRandom - let newFile = cOutputDir ctx randomFilename + let newFile = cProcessingDir ctx randomFilename writeFileLines newFile . merge $ fileContents return newFile diff --git a/src/PerformOperations.hs b/src/PerformOperations.hs --- a/src/PerformOperations.hs +++ b/src/PerformOperations.hs @@ -81,7 +81,7 @@ return outputFilename randomFilenameInOutput :: Context -> IO FilePath -randomFilenameInOutput ctx = inOutput ctx . show <$> UUID.nextRandom +randomFilenameInOutput ctx = inProcessing ctx . show <$> UUID.nextRandom linesSetOperation :: OperatorTools T.Text -> [T.Text] -> [T.Text] -> [T.Text] linesSetOperation ot = go