    module XMonad.Wallpaper.Find (findImages) where

    import System.Posix.Directory
    import System.Posix.Files

    import Control.Applicative
    import Control.Monad
    import Control.Exception

    import Magic
    import Control.Monad.State
    import Data.Maybe
    import Data.List

    -- File recursive list

    data UnixFile = RegularFile FilePath | Directory FilePath
        deriving (Int -> UnixFile -> ShowS
    [UnixFile] -> ShowS
    UnixFile -> String
    (Int -> UnixFile -> ShowS)
    -> (UnixFile -> String) -> ([UnixFile] -> ShowS) -> Show UnixFile
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnixFile -> ShowS
    showsPrec :: Int -> UnixFile -> ShowS
    $cshow :: UnixFile -> String
    show :: UnixFile -> String
    $cshowList :: [UnixFile] -> ShowS
    showList :: [UnixFile] -> ShowS
    Show, UnixFile -> UnixFile -> Bool
    (UnixFile -> UnixFile -> Bool)
    -> (UnixFile -> UnixFile -> Bool) -> Eq UnixFile
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnixFile -> UnixFile -> Bool
    == :: UnixFile -> UnixFile -> Bool
    $c/= :: UnixFile -> UnixFile -> Bool
    /= :: UnixFile -> UnixFile -> Bool
    Eq)

    toUnixFile :: String -> IO (Maybe UnixFile)
    toUnixFile String
    filepath = do
        exist <- String -> IO Bool
    fileExist String
    filepath
        if exist
            then do
                status <- getFileStatus filepath
                return $ toUnixFile' status filepath
            else return Nothing
        where
            toUnixFile' :: FileStatus -> String -> Maybe UnixFile
    toUnixFile' FileStatus
    status
                | FileStatus -> Bool
    isRegularFile FileStatus
    status = UnixFile -> Maybe UnixFile
    forall a. a -> Maybe a
    Just (UnixFile -> Maybe UnixFile)
    -> (String -> UnixFile) -> String -> Maybe UnixFile
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> UnixFile
    RegularFile
                | FileStatus -> Bool
    isDirectory FileStatus
    status   = UnixFile -> Maybe UnixFile
    forall a. a -> Maybe a
    Just (UnixFile -> Maybe UnixFile)
    -> (String -> UnixFile) -> String -> Maybe UnixFile
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> UnixFile
    Directory
                | Bool
    otherwise            = Maybe UnixFile -> String -> Maybe UnixFile
    forall a b. a -> b -> a
    const Maybe UnixFile
    forall a. Maybe a
    Nothing

    toFilepath :: UnixFile -> String
    toFilepath (RegularFile String
    filepath) = String
    filepath
    toFilepath (Directory String
    filepath)   = String
    filepath

    findDir :: UnixFile -> IO [UnixFile]
    findDir (Directory String
    filepath) = do
        let readPaths :: DirStream -> IO [UnixFile]
    readPaths DirStream
    stream = do
                path <- DirStream -> IO String
    readDirStream DirStream
    stream
                if length path == 0
                    then return []
                    else do
                        paths <- readPaths stream
                        if head path == '.'
                            then return paths
                            else do
                                unix <- toUnixFile $ filepath ++ "/" ++ path
                                case unix of
                                    Maybe UnixFile
    Nothing    -> [UnixFile] -> IO [UnixFile]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [UnixFile]
    paths
                                    Just UnixFile
    unix' -> [UnixFile] -> IO [UnixFile]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([UnixFile] -> IO [UnixFile]) -> [UnixFile] -> IO [UnixFile]
    forall a b. (a -> b) -> a -> b
    $ UnixFile
    unix' UnixFile -> [UnixFile] -> [UnixFile]
    forall a. a -> [a] -> [a]
    : [UnixFile]
    paths
        IO DirStream
    -> (DirStream -> IO ())
    -> (DirStream -> IO [UnixFile])
    -> IO [UnixFile]
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (String -> IO DirStream
    openDirStream String
    filepath) DirStream -> IO ()
    closeDirStream DirStream -> IO [UnixFile]
    readPaths
    findDir UnixFile
    _                    = [UnixFile] -> IO [UnixFile]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    findDirRecursive :: UnixFile -> IO [UnixFile]
    findDirRecursive unixPath :: UnixFile
    unixPath@(Directory String
    filepath) = do
        paths <- UnixFile -> IO [UnixFile]
    findDir UnixFile
    unixPath
        subPaths <- concat <$> mapM findDirRecursive paths
        return $ paths ++ subPaths
    findDirRecursive UnixFile
    _                             = [UnixFile] -> IO [UnixFile]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    -- mimetype detection

    mimetype :: FilePath -> StateT Magic IO String
    mimetype :: String -> StateT Magic IO String
    mimetype String
    filepath = do
        magic <- StateT Magic IO Magic
    forall s (m :: * -> *). MonadState s m => m s
    get
        liftIO $ magicFile magic filepath

    runMimetypeDetection :: StateT Magic IO b -> IO b
    runMimetypeDetection StateT Magic IO b
    action = do
        magic <- [MagicFlag] -> IO Magic
    magicOpen [ MagicFlag
    MagicMimeType ]
        magicLoadDefault magic
        evalStateT action magic

    -- find image files

    isImage :: UnixFile -> StateT Magic IO Bool
    isImage (RegularFile String
    filepath) = String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf String
    "image" (String -> Bool) -> StateT Magic IO String -> StateT Magic IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> StateT Magic IO String
    mimetype String
    filepath
    isImage UnixFile
    _ = Bool -> StateT Magic IO Bool
    forall a. a -> StateT Magic IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    {- |
    Recursively search supplied paths. Files are filtered by mimetypes, which is determined by magic bits. Duplicated paths will be removed.
    -}
    findImages :: [String] -> IO [String]
    findImages [String]
    filepaths = do
        paths  <- [Maybe UnixFile] -> [UnixFile]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe UnixFile] -> [UnixFile])
    -> IO [Maybe UnixFile] -> IO [UnixFile]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> IO (Maybe UnixFile)) -> [String] -> IO [Maybe UnixFile]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO (Maybe UnixFile)
    toUnixFile [String]
    filepaths
        files  <- concat <$> mapM findDirRecursive paths
        images <- runMimetypeDetection $ filterM isImage files
        return $ nub $ map toFilepath images