import Prelude hiding (catch) import Stat import Control.Applicative import Control.Exception import Control.Monad.CryptoRandom import Control.Monad.Trans.Class import Control.Monad.Trans.Error import Crypto.Random import System.Directory import System.Environment import System.Exit import System.FilePath import System.IO -- | Handle an IOException by returning the given value instead. onIOException :: a -> IO a -> IO a onIOException fallback_result action = action `catch` handler fallback_result where handler :: a -> IOException -> IO a handler x _ = return x notSpecial :: FilePath -> Bool notSpecial name = name /= "." && name /= ".." listFiles :: FilePath -> IO [FilePath] listFiles dir = onIOException [] $ map (dir ) . filter notSpecial <$> getDirectoryContents dir randFile :: (CryptoRandomGen g, Error e, ContainsGenError e) => FilePath -> CRandT g e IO (Maybe FilePath) randFile dir = lift (listFiles dir) >>= pickFromList where pickFromList list = if null list then return Nothing else do let len = length list idx <- getCRandomR (0, len-1) let path = list !! idx st <- lift (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, _:bs) = splitAt idx list -- | Like 'runCRandT', but discard the generator and throw the error -- (if necessary). runCRandT_ :: CRandT g GenError IO a -> g -> IO a runCRandT_ action gen = do res <- runCRandT action gen case res of Left e -> throwIO $ userError $ show e Right (a, _) -> return a main :: IO () main = do g <- newGenIO :: IO SystemRandom file <- runCRandT_ (randFile ".") g case file of Just f -> putStrLn $ makeRelative "." $ f Nothing -> do progName <- getProgName hPutStrLn stderr $ progName ++ ": Current directory does not contain any files" exitFailure