1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
-- | File Manager demo.
-- Author : Andy Stewart
-- Copyright : (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
-- | This simple file-manager base on gio.
--
module Main where
import Control.Monad
import Data.Maybe
import Graphics.UI.Gtk
import Graphics.UI.Gtk.General.IconTheme
import Graphics.UI.Gtk.ModelView
import System.GIO
import System.Glib.GDateTime
import System.Glib.GError
import System.Locale
import System.Time
import Text.Printf
import qualified Data.ByteString.UTF8 as UTF8
data FMInfo = FMInfo {
fIcon :: Pixbuf, -- icon
fName :: String, -- file name
fDesc :: String, -- mime type description
fSize :: Integer, -- file size
fTime :: ClockTime -- modified time
}
-- | Main.
main :: IO ()
main = do
-- Init.
initGUI
-- Create window.
window <- windowNew
windowSetDefaultSize window 900 600
windowSetPosition window WinPosCenter
scrolledWindow <- scrolledWindowNew Nothing Nothing
window `containerAdd` scrolledWindow
-- Get file infos under specify directory.
infos <- directoryGetFileInfos "/"
-- Get FMInfo.
fInfos <- mapM (\info -> do
-- Get Icon.
icon <- fileInfoGetIcon info
iconTheme <- iconThemeGetDefault
iconInfo <- iconThemeLookupByGIcon iconTheme icon 24 IconLookupUseBuiltin
pixbuf <- case iconInfo of
Just ii -> iconInfoLoadIcon ii
Nothing -> liftM fromJust $ iconThemeLoadIcon iconTheme "unknown" 24 IconLookupUseBuiltin
let
-- Get file name.
name = fromJust $ fileInfoGetName info
-- File size.
size = toInteger $ fileInfoGetSize info
-- File modified time.
time = gTimeValToClockTime $ fileInfoGetModificationTime info
-- File mime description.
Just contentType = fileInfoGetContentType info
desc = contentTypeGetDescription contentType
return $ FMInfo pixbuf (UTF8.toString name) desc size time
) infos
-- Initialize tree view.
store <- listStoreNew fInfos
tv <- treeViewNewWithModel store
scrolledWindow `containerAdd` tv
-- List Icons.
tvc <- treeViewColumnNew
set tvc [ treeViewColumnTitle := "Icon"
, treeViewColumnResizable := True ]
treeViewAppendColumn tv tvc
icon <- cellRendererPixbufNew
treeViewColumnPackStart tvc icon True
cellLayoutSetAttributes tvc icon store $ \FMInfo { fIcon = icon } ->
[ cellPixbuf := icon ]
-- List Name.
tvc <- treeViewColumnNew
set tvc [ treeViewColumnTitle := "Name"
, treeViewColumnResizable := True ]
treeViewAppendColumn tv tvc
name <- cellRendererTextNew
treeViewColumnPackStart tvc name True
cellLayoutSetAttributes tvc name store $ \FMInfo { fName = name } ->
[ cellText := name ]
-- List file mime description.
tvc <- treeViewColumnNew
set tvc [ treeViewColumnTitle := "Description"
, treeViewColumnResizable := True ]
treeViewAppendColumn tv tvc
desc <- cellRendererTextNew
treeViewColumnPackStart tvc desc True
cellLayoutSetAttributes tvc desc store $ \FMInfo { fDesc = desc } ->
[ cellText := desc ]
-- List file size.
tvc <- treeViewColumnNew
set tvc [ treeViewColumnTitle := "Size"
, treeViewColumnResizable := True ]
treeViewAppendColumn tv tvc
size <- cellRendererTextNew
treeViewColumnPackStart tvc size True
cellLayoutSetAttributes tvc size store $ \FMInfo { fSize = size } ->
[ cellText := formatFileSizeForDisplay size
, cellXAlign := 1.0]
-- List modified time.
tvc <- treeViewColumnNew
set tvc [ treeViewColumnTitle := "Modified"
, treeViewColumnResizable := True ]
treeViewAppendColumn tv tvc
time <- cellRendererTextNew
treeViewColumnPackStart tvc time True
cellLayoutSetAttributes tvc time store $ \FMInfo { fTime = time } ->
[ cellText :=> do
calTime <- toCalendarTime time
return (formatCalendarTime defaultTimeLocale "%Y/%m/%d %T" calTime)]
-- Show window.
window `onDestroy` mainQuit
widgetShowAll window
mainGUI
directoryGetFileInfos :: FilePath -> IO [FileInfo]
directoryGetFileInfos directory = do
let dir = fileFromPath (UTF8.fromString directory)
enumerator <- fileEnumerateChildren dir "*" [] Nothing
fileEnumeratorGetFileInfos enumerator
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 []
formatFileSizeForDisplay :: Integer -> String
formatFileSizeForDisplay size
| size < 2 ^ 10 = humanSize 1 ++ " bytes"
| size < 2 ^ 20 = humanSize (2 ^ 10) ++ " KB"
| size < 2 ^ 30 = humanSize (2 ^ 20) ++ " MB"
| size < 2 ^ 40 = humanSize (2 ^ 30) ++ " GB"
| size < 2 ^ 50 = humanSize (2 ^ 40) ++ " TB"
| size < 2 ^ 60 = humanSize (2 ^ 50) ++ " PB"
| size < 2 ^ 70 = humanSize (2 ^ 60) ++ " EB"
| size < 2 ^ 80 = humanSize (2 ^ 70) ++ " ZB"
| size < 2 ^ 90 = humanSize (2 ^ 80) ++ " YB"
| size < 2 ^ 100 = humanSize (2 ^ 90) ++ " NB"
| size < 2 ^ 110 = humanSize (2 ^ 100) ++ " DB"
where humanSize base = printf "%.1f" (integralToDouble size / base) :: String
integralToDouble :: Integral a => a -> Double
integralToDouble v = fromIntegral v :: Double
gTimeValToClockTime :: GTimeVal -> ClockTime
gTimeValToClockTime GTimeVal {gTimeValSec = seconds
,gTimeValUSec = microseconds} =
TOD (toInteger seconds) (toInteger microseconds * 1000)
|
