ListViewDemo

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where

import qualified GI.Gtk as Gtk
import qualified GI.Gio as Gio
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject
import Data.GI.Base
import System.Exit
import qualified Data.Text as T
import qualified Data.ByteString as BS
import Paths_FilterListModel

data Model = Model
    { names :: [T.Text] }
    deriving (Show)

activate :: Gtk.Application -> IO ()
activate app = do
    window <- Gtk.applicationWindowNew app
    Gtk.setWindowTitle window "FilterListModel - Demo"
    Gtk.setWindowDefaultWidth window 400
    Gtk.setWindowDefaultHeight window 400

    let model = Model $ map (T.pack . show) [(1 :: Int)..2000 * 1000]
    stringList <- Gtk.stringListNew $ (Just $ names model)

    gtype <- glibType @Gtk.StringObject
    expression <- Gtk.propertyExpressionNew gtype (Nothing :: Maybe Gtk.Expression) "string"
    stringFilter <- Gtk.stringFilterNew (Just expression)

    filterModel <- Gtk.filterListModelNew (Just stringList) (Just stringFilter)
    Gtk.filterListModelSetIncremental filterModel True

    selectionModel <- Gtk.singleSelectionNew (Just filterModel)

    uiFile <- getDataFileName "resources/factory.ui"
    uiByteString <- BS.readFile uiFile
    bytes <- GLib.bytesNew (Just uiByteString)
    factory <- Gtk.builderListItemFactoryNewFromBytes (Nothing :: Maybe Gtk.BuilderScope) bytes
    listView <- Gtk.listViewNew (Just selectionModel) (Just factory)

    scolledWindow <- Gtk.scrolledWindowNew
    Gtk.scrolledWindowSetChild scolledWindow (Just listView)

    searchEntry <- Gtk.searchEntryNew
    _ <- GObject.objectBindProperty searchEntry "text" stringFilter "search" [GObject.BindingFlagsDefault]

    vbox <- Gtk.boxNew Gtk.OrientationVertical 0
    Gtk.widgetSetVexpand scolledWindow True
    Gtk.boxAppend vbox searchEntry
    Gtk.boxAppend vbox scolledWindow

    Gtk.windowSetChild window (Just vbox)

    Gtk.windowPresent window

main :: IO ()
main = do
    app <- Gtk.applicationNew
        (Just $ "de.oliver-epper.phone-project.FilterListModel")
        [Gio.ApplicationFlagsDefaultFlags]

    _ <- Gio.onApplicationActivate app $ activate app

    status <- Gio.applicationRun app Nothing

    exitWith $ if status == 0
        then ExitSuccess
        else ExitFailure $ fromIntegral status