57 lines
2 KiB
Haskell
57 lines
2 KiB
Haskell
-- Copyright © 2025 Hashirama Senju
|
|
|
|
{-
|
|
this program will skip directories with more than 10 xml files in it.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import System.IO (stdout, hSetEncoding, utf8)
|
|
import Control.Monad (when, unless, filterM, mzero)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.DirStream (childOf)
|
|
import Pipes (ListT, for, every, runEffect)
|
|
import Pipes.Safe (SafeT, runSafeT)
|
|
import Control.Applicative
|
|
import qualified Filesystem as FS -- system-filepath
|
|
import qualified Filesystem.Path.CurrentOS as FP
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as TIO
|
|
|
|
-- | Count up to 11 immediate .xml files in `dir`.
|
|
countImmediateXMLs :: FP.FilePath -> IO Int
|
|
countImmediateXMLs dir = do
|
|
children <- FS.listDirectory dir
|
|
files <- filterM FS.isFile children
|
|
let xmls = Prelude.filter (\f -> FP.extension f == Just "xml") files
|
|
return (min 11 (Prelude.length xmls))
|
|
|
|
-- | Stream the tree under `dir`, pruning any directory with
|
|
-- >10 immediate .xml files, yielding both files and dirs.
|
|
walk :: FP.FilePath -> ListT (SafeT IO) FP.FilePath
|
|
walk dir = do
|
|
child <- childOf dir -- streams FP.FilePath directly
|
|
isDir <- liftIO $ FS.isDirectory child
|
|
|
|
if isDir
|
|
then do
|
|
cnt <- liftIO $ countImmediateXMLs child
|
|
if cnt > 10
|
|
then mzero -- skip this entire subtree
|
|
else return child <|> walk child
|
|
else
|
|
return child -- yield a file
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hSetEncoding stdout utf8
|
|
let root = FP.fromText "/mnt/Data/Japanese_Resources/"
|
|
|
|
-- Convert our ListT (SafeT IO) FP.FilePath into actual IO
|
|
runSafeT . runEffect $
|
|
for (every (walk root)) $ \fp ->
|
|
liftIO $
|
|
when (FP.extension fp == Just "mdx") $
|
|
TIO.putStrLn (T.pack $ FP.encodeString fp)
|