module Manatee.Extension.FileManager.DiredBuffer where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import Data.ByteString.UTF8
import DBus.Client hiding (Signal)
import Data.Ord (comparing)
import Data.Typeable
import Graphics.UI.Gtk.General.Enums
import Graphics.UI.Gtk.ModelView.TreeSortable
import Manatee.Core.DBus
import Manatee.Core.Types
import Manatee.Extension.FileManager.PageMode
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Misc
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.General.Time
import Manatee.Toolkit.Gio.Gio
import Manatee.Toolkit.Gtk.Concurrent
import System.GIO
import System.GIO.File.FileAttribute
import System.Glib.GDateTime
import System.Locale
import System.Time
import qualified Data.Map as M
data DiredBuffer =
DiredBuffer {diredBufferCurrentDirectory :: TVar FilePath
,diredBufferClient :: Client
,diredBufferPageId :: PageId
,diredBufferFileInfoOptions :: [(FileInfoOption, SortColumnId)]
,diredBufferFileInfos :: TVar [DiredFileInfo]
,diredBufferSortStatus :: TVar (FileInfoOption, SortType)
,diredBufferIconPixbufDatabase :: TVar FileIconPixbufDatabase
,diredBufferMode :: PageMode
,diredBufferBroadcastChannel :: TChan DiredBufferSignal
}
deriving Typeable
data DiredBufferSignal = UpdateBuffer FilePath
| UpdateView (Maybe String)
deriving (Show, Eq, Ord)
data DiredFileInfo =
DiredFileInfo {dfiNameDescrible :: (String, String)
,dfiTypeDescrible :: (FileType, String)
,dfiSizeDescrible :: (Integer, String)
,dfiMimeDescrible :: (String, String)
,dfiMtimeDescrible :: (GTimeVal, String)
,dfiPermDescrible :: (String, String)
}
deriving Show
data FileInfoOption = FIName | FISize | FIMime | FIMTime | FIPermission
deriving (Eq, Show, Read)
class DiredFileInfoClass a where
getColumnTitle :: a -> String
getCellText :: a -> DiredFileInfo -> String
getCellXAlign :: a -> Float
compareRow :: a -> DiredFileInfo -> DiredFileInfo -> IO Ordering
instance DiredFileInfoClass FileInfoOption where
getColumnTitle FIName = "File name"
getColumnTitle FISize = "Size"
getColumnTitle FIMime = "Type"
getColumnTitle FIMTime = "Modification time"
getColumnTitle FIPermission = "Permission"
getCellText FIName info = snd $ dfiNameDescrible info
getCellText FISize info = snd $ dfiSizeDescrible info
getCellText FIMime info = snd $ dfiMimeDescrible info
getCellText FIMTime info = snd $ dfiMtimeDescrible info
getCellText FIPermission info = snd $ dfiPermDescrible info
getCellXAlign FIName = 0.0
getCellXAlign FISize = 1.0
getCellXAlign FIMime = 0.0
getCellXAlign FIMTime = 0.0
getCellXAlign FIPermission = 0.0
compareRow FIName row1 row2 = return $ diredFileInfoNameCompare row1 row2
compareRow FISize row1 row2 = return $ comparing fst (dfiSizeDescrible row1) (dfiSizeDescrible row2)
compareRow FIMime row1 row2 = return $ comparing fst (dfiMimeDescrible row1) (dfiMimeDescrible row2)
compareRow FIMTime row1 row2 = return $ comparing fst (dfiMtimeDescrible row1) (dfiMtimeDescrible row2)
compareRow FIPermission row1 row2 = return $ comparing fst (dfiPermDescrible row1) (dfiPermDescrible row2)
diredBufferNew :: FilePath -> Client -> PageId -> IO DiredBuffer
diredBufferNew dir client pageId = do
buffer <- DiredBuffer <$> newTVarIO dir
<*> pure client
<*> pure pageId
<*> pure (pairPred [FIName, FISize, FIMime, FIMTime, FIPermission])
<*> newTVarIO []
<*> newTVarIO (FIName, SortAscending)
<*> newTVarIO M.empty
<*> pure diredMode
<*> (newTChanIO :: IO (TChan DiredBufferSignal))
diredBufferLoad buffer dir
diredBufferListenChannel buffer
return buffer
diredBufferListenChannel :: DiredBuffer -> IO ()
diredBufferListenChannel DiredBuffer {diredBufferClient = client
,diredBufferPageId = pageId
,diredBufferMode = mode
,diredBufferBroadcastChannel = channel
} =
listenBufferChannel channel $ \ signal ->
case signal of
UpdateBuffer path ->
mkDaemonSignal client SynchronizationPathName (SynchronizationPathNameArgs (pageModeName mode) pageId path)
_ -> return ()
diredBufferLoad :: DiredBuffer -> FilePath -> IO ()
diredBufferLoad buffer dir = do
infos <- directoryGetFileInfos (fromString dir)
fileInfos <- diredBufferGenerateFileInfos infos
writeTVarIO (diredBufferCurrentDirectory buffer) dir
writeTVarIO (diredBufferFileInfos buffer) fileInfos
forM_ infos $ \info ->
modifyTVarIOM (diredBufferIconPixbufDatabase buffer)
(updateFileIconPixbufDatabase info)
diredBufferGenerateFileInfos :: [FileInfo] -> IO [DiredFileInfo]
diredBufferGenerateFileInfos infos =
forM infos $ \info -> do
typeDes <- do
let fType = fileInfoGetFileType info
title = show fType
return (fType, title)
nameDes <- do
let fName = maybeError (fileInfoGetName info)
"diredBufferGenerateFileInfos - `fileInfoGetName`."
title = maybeError (fileInfoGetDisplayName info)
"diredBufferGenerateFileInfos - `fileInfoGetDisplayName`."
return (toString fName, title)
sizeDes <- do
let fSize = toInteger $ fileInfoGetSize info
title = formatFileSizeForDisplay fSize
return (fSize, title)
mimeDes <- do
let fMime = maybeError (fileInfoGetContentType info)
"diredBufferGenerateFileInfos - `fileInfoGetContentType`."
title = contentTypeGetDescription fMime
return (fMime, title)
mtimeDes <- do
let fTime = fileInfoGetModificationTime info
title <- do
calTime <- toCalendarTime $ gTimeValToClockTime fTime
return (formatCalendarTime defaultTimeLocale "%Y/%m/%d %T" calTime)
return (fTime, title)
permissionDes <- do
let isDir = fileInfoGetFileType info == FileTypeDirectory
canRead <- fileInfoGetAttributeBool info fileAttributeAccessCanRead
canWrite <- fileInfoGetAttributeBool info fileAttributeAccessCanWrite
canExecute <- fileInfoGetAttributeBool info fileAttributeAccessCanExecute
let permission =
(if isDir then "d" else "-")
++ (if canRead then "r" else "-")
++ (if canWrite then "w" else "-")
++ (if canExecute then "x" else "-")
return (permission, permission)
return $ DiredFileInfo nameDes typeDes sizeDes mimeDes mtimeDes permissionDes
diredFileInfoNameCompare :: DiredFileInfo -> DiredFileInfo -> Ordering
diredFileInfoNameCompare row1 row2 =
compareFileWithType (fName1, fType1) (fName2, fType2)
where fType1 = fst $ dfiTypeDescrible row1
fType2 = fst $ dfiTypeDescrible row2
fName1 = fst $ dfiNameDescrible row1
fName2 = fst $ dfiNameDescrible row2