127 lines
5 KiB
Haskell
127 lines
5 KiB
Haskell
-- Copyright © 2024 Hashirama Senju
|
|
|
|
import System.Clock -- To measure time
|
|
import System.Console.ANSI -- For colored output
|
|
--
|
|
import Z.Data.CBytes (pack, unpack)
|
|
import Z.IO.FileSystem (scandirRecursively)
|
|
import System.FilePath (takeDirectory)
|
|
import Data.List (groupBy, isSuffixOf, nub)
|
|
import System.IO
|
|
import qualified Data.Map as Map
|
|
import Control.Concurrent.Async (mapConcurrently)
|
|
import Control.Concurrent
|
|
|
|
-- Derived version with automatic string handling
|
|
scanDirectoryRecursivelyStr :: String -> IO [String]
|
|
scanDirectoryRecursivelyStr path = do
|
|
result <- scandirRecursively (pack path) (\p _ -> return True)
|
|
return (map unpack result) -- Ensures all results are decoded to Strings (UTF-8)
|
|
|
|
-- Function to filter files with a specific extension
|
|
filterMdx :: [String] -> String -> [String]
|
|
filterMdx files ext = filter (isSuffixOf ext) files
|
|
|
|
-- Custom implementation of takeDirectory for UTF-8 strings
|
|
takeDirectory' :: String -> String
|
|
takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path
|
|
|
|
data FileGroup = FileGroup
|
|
{ directory :: String -- The directory part of the file path (UTF-8 String)
|
|
, files :: [String] -- List of file paths in that directory (UTF-8 Strings)
|
|
} deriving (Show, Eq)
|
|
|
|
-- Create a map from directory to list of .mdx files
|
|
groupMdxByDirectory :: [String] -> Map.Map String [String]
|
|
groupMdxByDirectory mdxFiles =
|
|
Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles]
|
|
|
|
-- Group files by their directory, including additional files that belong to the same directory
|
|
groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup]
|
|
groupFilesByDirectory mdxFiles additionalFiles = do
|
|
-- Create a map of directories to .mdx files
|
|
let mdxMap = groupMdxByDirectory mdxFiles
|
|
|
|
-- Function to process each directory group in parallel
|
|
let processGroup dir mdxFilesInDir = do
|
|
let -- Filter additional files that belong to the same directory
|
|
additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles
|
|
-- Remove matching files from additional files (those that are already in the .mdx list)
|
|
remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir
|
|
-- Combine and remove duplicates
|
|
allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles)
|
|
return $ FileGroup dir allFiles
|
|
|
|
-- Process each directory group concurrently
|
|
groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap)
|
|
return groupedFiles
|
|
|
|
-- Function to convert FileGroup to a string representation for file output
|
|
fileGroupToString :: FileGroup -> String
|
|
fileGroupToString (FileGroup dir files) =
|
|
"Directory: " ++ dir ++ "\n" ++
|
|
unlines (map (" " ++) files)
|
|
|
|
|
|
-- Box-like animation function with green color
|
|
boxAnimation :: IO ()
|
|
boxAnimation = do
|
|
let frames = ["[ ]", "[. ]", "[ . ]", "[ .]"] -- Frame progression for box
|
|
let loop frames' = do
|
|
mapM_ (\frame -> do
|
|
setSGR [SetColor Foreground Vivid Green] -- Set the box color to green
|
|
putStr "\r" -- Move cursor to the start of the line
|
|
putStr frame -- Print the current frame
|
|
hFlush stdout -- Flush output buffer
|
|
threadDelay 200000) frames' -- Wait 0.2 seconds between frames
|
|
loop frames' -- Recursively call to keep the loop running
|
|
loop frames -- Start the looping animation
|
|
|
|
|
|
-- Main function
|
|
main :: IO ()
|
|
main = do
|
|
|
|
-- Start timing the operation
|
|
start <- getTime Monotonic
|
|
|
|
-- Notify the start of processing with color
|
|
setSGR [SetColor Foreground Vivid Blue]
|
|
putStrLn "Processing started..."
|
|
setSGR [Reset] -- Reset colors
|
|
-- Create a thread for the box animation
|
|
animationThread <- forkIO boxAnimation
|
|
|
|
|
|
allFiles <- scanDirectoryRecursivelyStr "/mnt/Data/Japanese_Resources/"
|
|
|
|
-- Filter files with '.mdx' extension
|
|
let mdxFiles = filterMdx allFiles ".mdx"
|
|
|
|
-- Group the files by their directories concurrently
|
|
groupedFiles <- groupFilesByDirectory mdxFiles allFiles
|
|
|
|
-- just to show that we finished processing, might be faster than doing I/O
|
|
putStrLn "Processing complete. Data is grouped."
|
|
-- Kill the animation thread
|
|
killThread animationThread
|
|
-- Stop timing the operation
|
|
end <- getTime Monotonic
|
|
let elapsed = toNanoSecs (diffTimeSpec end start) `div` 1000000 -- Convert to milliseconds
|
|
|
|
-- Show a colorful message after processing with elapsed time
|
|
setSGR [SetColor Foreground Vivid Green]
|
|
putStrLn $ "Processing complete. Time taken: " ++ show elapsed ++ " ms."
|
|
setSGR [Reset] -- Reset colors
|
|
|
|
putStrLn "Starting to write results..."
|
|
animationThread <- forkIO boxAnimation
|
|
-- Open the output file and set its encoding to UTF-8
|
|
withFile "output.txt" WriteMode $ \handle -> do
|
|
hSetEncoding handle utf8
|
|
|
|
-- Write the grouped files to the file
|
|
mapM_ (hPutStrLn handle . fileGroupToString) groupedFiles
|
|
|
|
killThread animationThread
|
|
|