Commit e66e5b2a0445d99c718e1fcbda9e9cf266c9ccd5
Parent: e4a272c63cea55732abf0cb91a76b1cb4d6d7723
Author: mcol <mcol@posteo.net>
Date: 2021-08-21 01:13:50 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-08-21 01:13:50 +0100

Split icon-handling code into module

xanadu.cabal Modified

@@ -16,6 +16,7 @@
 executable xanadu
   hs-source-dirs:      src
   main-is:             Main.hs
+  other-modules:       Icons
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , directory

src/Main.hs Modified

@@ -2,18 +2,9 @@
 
 module Main where
 
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Maybe
-import Data.Functor (void)
-import Data.Maybe
-import Data.Text (pack)
-import Data.Void
-import GHC.Int (Int32)
-import System.Directory (getDirectoryContents, getHomeDirectory)
+import qualified Icons
 
 import Data.GI.Base
-import qualified Data.GI.Base.GType as GType
-import qualified GI.GdkPixbuf as Pixbuf
 import qualified GI.Gio as Gio
 import qualified GI.Gtk as Gtk
 
@@ -33,41 +24,7 @@
         [ #application := app
         , #title := "xanadu"
         ]
-    pixbufGType <- glibType @Pixbuf.Pixbuf
-    listStore <- Gtk.listStoreNew [GType.gtypeString, pixbufGType]
-    view <- new Gtk.IconView
-        [ #model := listStore
-        , #selectionMode := Gtk.SelectionModeMultiple
-        , #textColumn := 0
-        , #tooltipColumn := 0
-        , #pixbufColumn := 1
-        ]
-    screen <- Gtk.windowGetScreen win
-    iconTheme <- Gtk.iconThemeGetForScreen screen
-    homeDir <- getHomeDirectory
-    populate listStore iconTheme $ homeDir <> "/Desktop"
-    #add win view
+    iconView <- Icons.initIcons win
+    #add win iconView
     #showAll win
     return ()
-
-populate :: Gtk.ListStore -> Gtk.IconTheme -> FilePath -> IO ()
-populate listStore iconTheme root = ls root >>= mconcat . map (addItem listStore iconTheme)
-
-addItem :: Gtk.ListStore -> Gtk.IconTheme -> FilePath -> IO ()
-addItem listStore iconTheme path = do
-    iter <- Gtk.listStoreAppend listStore
-    value <- Gtk.toGValue $ Just path
-    icon <- runMaybeT $ getIcon iconTheme path
-    case icon of
-        Nothing -> Gtk.listStoreSet listStore iter [0] [value]
-        (Just icon') -> Gtk.listStoreSet listStore iter [0, 1] [value, icon']
-
-getIcon :: Gtk.IconTheme -> FilePath -> MaybeT IO GValue
-getIcon iconTheme path = do
-    contentType <- Gio.contentTypeGuess (Just . pack $ path) Nothing
-    iconName <- MaybeT $ Gio.contentTypeGetGenericIconName . fst $ contentType
-    pixbuf <- Gtk.iconThemeLoadIcon iconTheme iconName 32 []
-    liftIO . Gtk.toGValue $ pixbuf
-
-ls :: FilePath -> IO [FilePath]
-ls = fmap (filter (\f -> f /= "." && f /= "..")) . getDirectoryContents

src/Icons.hs Added

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings, OverloadedLabels, TypeApplications #-}
+
+module Icons where
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Maybe
+import Data.Maybe
+import Data.Text (pack)
+import System.Directory (getDirectoryContents, getHomeDirectory)
+
+import Data.GI.Base
+import qualified Data.GI.Base.GType as GType
+import qualified GI.GdkPixbuf as Pixbuf
+import qualified GI.Gio as Gio
+import qualified GI.Gtk as Gtk
+
+initIcons :: Gtk.ApplicationWindow -> IO Gtk.IconView
+initIcons win = do
+    pixbufGType <- glibType @Pixbuf.Pixbuf
+    listStore <- Gtk.listStoreNew [GType.gtypeString, pixbufGType]
+    view <- new Gtk.IconView
+        [ #model := listStore
+        , #selectionMode := Gtk.SelectionModeMultiple
+        , #textColumn := 0
+        , #tooltipColumn := 0
+        , #pixbufColumn := 1
+        ]
+    screen <- Gtk.windowGetScreen win
+    iconTheme <- Gtk.iconThemeGetForScreen screen
+    homeDir <- getHomeDirectory
+    populate listStore iconTheme $ homeDir <> "/Desktop"
+    return view
+
+populate :: Gtk.ListStore -> Gtk.IconTheme -> FilePath -> IO ()
+populate listStore iconTheme root = ls root >>= mconcat . map (addItem listStore iconTheme)
+
+addItem :: Gtk.ListStore -> Gtk.IconTheme -> FilePath -> IO ()
+addItem listStore iconTheme path = do
+    iter <- Gtk.listStoreAppend listStore
+    value <- Gtk.toGValue $ Just path
+    icon <- runMaybeT $ getIcon iconTheme path
+    case icon of
+        Nothing -> Gtk.listStoreSet listStore iter [0] [value]
+        (Just icon') -> Gtk.listStoreSet listStore iter [0, 1] [value, icon']
+
+getIcon :: Gtk.IconTheme -> FilePath -> MaybeT IO GValue
+getIcon iconTheme path = do
+    contentType <- Gio.contentTypeGuess (Just . pack $ path) Nothing
+    iconName <- MaybeT $ Gio.contentTypeGetGenericIconName . fst $ contentType
+    pixbuf <- Gtk.iconThemeLoadIcon iconTheme iconName 32 []
+    liftIO . Gtk.toGValue $ pixbuf
+
+ls :: FilePath -> IO [FilePath]
+ls = fmap (filter (\f -> f /= "." && f /= "..")) . getDirectoryContents