oi-0.0.1: sample/recdircs.hs

{-# LANGUAGE TypeOperators #-}
module Main where

import Data.OI

import Data.List

import System.FilePath
import System.Directory
import System.Environment

main :: IO ()
main = do { args <- getArgs
          ; case args of
              []  -> print =<< run (pmain ".")
              a:_ -> print =<< run (pmain a)
          }

pmain :: FilePath -> [(Bool, [FilePath])] :-> [FilePath]
pmain = recDirectoryContents

isDirectory :: FilePath -> Bool :-> Bool
isDirectory = iooi . doesDirectoryExist

directoryContents :: FilePath -> [FilePath] :-> [FilePath]
directoryContents f = map (f </>) . filter (`notElem` [".",".."])
                    . iooi (getDirectoryContents f)

recDirectoryContents :: FilePath -> [(Bool,[FilePath])] :-> [FilePath]
recDirectoryContents root = fst . recdircs root

recdircs :: FilePath -> [(Bool,[FilePath])] :-> ([FilePath], OI [(Bool,[FilePath])])
recdircs t r = case deList r of
  Just (rbfps, rbfpss) -> case deTuple rbfps of
    (rb,rfps) -> case isDirectory t rb of
      False -> ([t],rbfpss)
      True  -> let { ts = directoryContents t rfps
                   ; (rs,tss) = mapAccumL acc rbfpss ts
                   ; acc r' fp = swap (recdircs fp r')
                   } in 
               (concat tss, rs)
  _ -> error $ "recdircs: perhaps `"++t++"' is not found"

swap :: (a,b) -> (b,a)
swap (x,y) = (y,x)