Add advancedFileStream.hs

advancedFileStream.hs

@@ -0,0 +1,57 @@
+-- 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)