Main.hs

module Main (main) where

import RecursiveContents
import System.FilePath (takeExtension)
import System.IO (hPutStrLn,stderr)
import GHC.IO.Encoding (setLocaleEncoding, utf8)
import System.Environment (getArgs)

hasExtension :: String -> -- extension
                String -> -- filepath
                Bool -- wheter path has extension
hasExtension ext path = takeExtension path == ("." ++ ext)

searchFiltered ext = do 
    contents <- getRecursiveContents "."
    let filtered = filter (hasExtension ext) contents
    mapM_ putStrLn filtered

main :: IO ()
main = do
    setLocaleEncoding utf8
    args <- getArgs
    case args of
        [ext] -> searchFiltered ext
        _ -> hPutStrLn stderr "Dosya uzantisi belirtilmedi."

RecursiveContents.hs

module RecursiveContents (getRecursiveContents)
where

import Control.Monad (forM)
import Control.Applicative (liftA2)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
import Control.Exception (catch,IOException)
import System.IO (hPrint,stderr)

myFilterM :: (Applicative m) => (a -> m Bool) -> [a] -> m ([a],[a])
myFilterM pred = foldr myFilterM' (pure ([],[]))
    where myFilterM' x = liftA2 (
                \flg -> if flg then
                        \(taken,dropped) -> (x:taken,dropped)
                    else
                        \(taken,dropped) -> (taken,x:dropped)
                ) (pred x)

getRecursiveContents :: FilePath -> -- path to root directory
                        IO [FilePath] -- list of found paths
getRecursiveContents root = do
    isDir <- doesDirectoryExist root
    if isDir then do
        contents <- catch (listDirectory root) (\e -> hPrint stderr (e :: IOException) >> return [])
        (dirs, others) <- myFilterM doesDirectoryExist [root </> x | x <- contents]
        paths <- mapM getRecursiveContents dirs
        return $ others ++ concat paths
    else
        return []