Created
June 18, 2011 20:54
-
-
Save joeyadams/1033494 to your computer and use it in GitHub Desktop.
Pick a file by randomly descending until one is found.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Prelude hiding (catch) | |
import Control.Applicative | |
import Control.Exception | |
import System.Directory | |
import System.Exit | |
import System.FilePath | |
import System.Posix.Files | |
import System.Random | |
notSpecial :: FilePath -> Bool | |
notSpecial name = name /= "." && name /= ".." | |
listFiles :: FilePath -> IO [FilePath] | |
listFiles dir = map (dir </>) . filter notSpecial <$> getDirectoryContents dir | |
data Stat = File | Directory | Other | |
stat :: FilePath -> IO Stat | |
stat path = | |
(decode <$> getFileStatus path) | |
`catch` ((\_ -> return Other) :: IOException -> IO Stat) | |
where | |
decode :: FileStatus -> Stat | |
decode stat = | |
if isRegularFile stat | |
then File | |
else if isDirectory stat | |
then Directory | |
else Other | |
randFile :: FilePath -> IO (Maybe FilePath) | |
randFile dir = listFiles dir >>= pickFromList where | |
pickFromList list = | |
if null list | |
then return Nothing | |
else do | |
let len = length list | |
idx <- randomRIO (0, len-1) | |
let path = list !! idx | |
st <- stat path | |
case st of | |
File -> return (Just path) | |
Directory -> do | |
r <- randFile path | |
case r of | |
Just _ -> return r | |
Nothing -> pickFromList (list `without` idx) | |
Other -> pickFromList (list `without` idx) | |
without list idx = as ++ bs where | |
(as,b:bs) = splitAt idx list | |
main = do | |
file <- randFile "." | |
case file of | |
Just f -> putStrLn $ makeRelative "." $ f | |
Nothing -> do | |
putStrLn "Current directory does not contain any files" | |
exitFailure |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment