module Manatee.Toolkit.Gio.Gio where
import Control.Monad (liftM)
import Control.Applicative hiding (empty)
import Data.Map (Map)
import Data.List (nub)
import Data.ByteString.UTF8
import Distribution.Simple.Utils
import Graphics.UI.Gtk.Gdk.Pixbuf
import Graphics.UI.Gtk.General.IconTheme
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Maybe
import System.FilePath
import System.GIO
import Manatee.Toolkit.Glib.GError
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B
import qualified Manatee.Toolkit.General.ByteString as GB
type FileContentType = String
type FileIconPixbufDatabase = Map FileContentType Pixbuf
fileDoesExist :: ByteString -> Bool
fileDoesExist filepath =
fileQueryExists (fileFromPath filepath) Nothing
directoryDoesExist :: ByteString -> Bool
directoryDoesExist directory =
fileDoesExist directory && isDirectory directory
isDirectory :: ByteString -> Bool
isDirectory directory =
FileTypeDirectory == fileQueryFileType (fileFromPath directory) [] Nothing
directoryGetFiles :: ByteString -> IO [ByteString]
directoryGetFiles directory =
map fileInfoGetNameWithType <$> directoryGetFileInfos directory
directoryGetFilesRecursive :: ByteString -> IO [ByteString]
directoryGetFilesRecursive dir = do
infos <- directoryGetFileInfos dir
liftM concat $ mapM (\info -> do
let fType = fileInfoGetFileType info
fName = maybeError (fileInfoGetName info)
"directoryGetFilesRecursive - `fileInfoGetName`."
fPath = GB.combine dir fName
if fType == FileTypeDirectory
then directoryGetFilesRecursive fPath
else return [fPath]
) infos
fileInfoGetNameWithType :: FileInfoClass info => info -> ByteString
fileInfoGetNameWithType info
| fType == FileTypeDirectory
= B.concat [fName, B.singleton pathSeparator]
| otherwise
= fName
where fType = fileInfoGetFileType info
fName = maybeError (fileInfoGetName info)
"fileInfoGetNameWithType - `fileInfoGetName`."
fileInfoGetDisplayNameWithType :: FileInfoClass info => info -> String
fileInfoGetDisplayNameWithType info
| fType == FileTypeDirectory
= fName ++ [pathSeparator]
| otherwise
= fName
where fType = fileInfoGetFileType info
fName = maybeError (fileInfoGetDisplayName info)
"fileInfoGetDisplayNameWithType - `fileInfoGetDisplayName`."
filepathGetDisplayName :: ByteString -> FilePath
filepathGetDisplayName =
fileParseName . fileFromPath
directoryGetFileInfos :: ByteString -> IO [FileInfo]
directoryGetFileInfos directory = catchGErrorM (return []) $ do
let dir = fileFromPath directory
enumerator <- fileEnumerateChildren dir "*" [] Nothing
fileEnumeratorGetFileInfos enumerator
getDirectoryPath :: String -> IO ByteString
getDirectoryPath dirStr = do
let dir = fileFromParseName dirStr
enumerator <- fileEnumerateChildren dir "*" [] Nothing
dirFile <- fileEnumeratorGetContainer enumerator
return $ filePath dirFile
fileEnumeratorGetFileInfos :: FileEnumeratorClass enumerator => enumerator -> IO [FileInfo]
fileEnumeratorGetFileInfos enum = do
fileInfo <- fileEnumeratorNextFile enum Nothing
case fileInfo of
Just info -> do
infos <- fileEnumeratorGetFileInfos enum
return $ info : infos
Nothing -> return []
compareFileWithType :: (FilePath, FileType) -> (FilePath, FileType) -> Ordering
compareFileWithType (fPath1, fType1) (fPath2, fType2)
| fType1 == fType2
= compare fName1 fName2
| fType1 == FileTypeDirectory
= LT
| fType2 == FileTypeDirectory
= GT
| otherwise
= compare fName1 fName2
where fName1 = lowercase fPath1
fName2 = lowercase fPath2
fileInfoGetDescription :: FileInfoClass info => info -> String
fileInfoGetDescription info =
case contentType of
Just ct -> contentTypeGetDescription ct
Nothing -> ""
where contentType = fileInfoGetContentType info
getAllExecuteFiles :: IO [ByteString]
getAllExecuteFiles =
catchGErrorM (return []) $ do
paths <- liftM (filter directoryDoesExist . map fromString . nub) getSearchPath
liftM nub $ concatMapM directoryGetFiles paths
launchCommandInTerminal :: String -> IO ()
launchCommandInTerminal command = do
appinfo <- appInfoCreateFromCommandline command Nothing [AppInfoCreateNeedsTerminal]
appInfoLaunch appinfo [] Nothing
return ()
fileInfoGetIconPixbuf :: FileInfoClass info => info -> IO Pixbuf
fileInfoGetIconPixbuf info =
getIconPixbuf =<< fileInfoGetIcon info
getIconPixbuf :: IconClass icon => icon -> IO Pixbuf
getIconPixbuf icon = do
iconTheme <- iconThemeGetDefault
iconInfo <- iconThemeLookupByGIcon iconTheme icon 24 IconLookupUseBuiltin
case iconInfo of
Just ii -> iconInfoLoadIcon ii
Nothing -> do
pixbuf <- iconThemeLoadIcon iconTheme "unknown" 24 IconLookupUseBuiltin
return $ maybeError pixbuf "getFileIconPixbuf: can't get `unknown` icon pixbuf."
updateFileIconPixbufDatabase :: FileInfoClass info => info -> FileIconPixbufDatabase -> IO FileIconPixbufDatabase
updateFileIconPixbufDatabase info database = do
let fMime = maybeError (fileInfoGetContentType info)
"getFileIconPixbuf: can't get file content type."
case findMinMatch database (\ mime _ -> mime == fMime) of
Just _ -> return database
Nothing -> do
pixbuf <- fileInfoGetIconPixbuf info
return $ M.insert fMime pixbuf database