haskell - 带有反应香蕉和 gtk2hs 的 react 表

Question

我编写了一个小应用程序来跟踪我在电视剧中的进度。该应用程序是用 Haskell 使用函数响应式(Reactive)编程 (FRP) 编写的 reactive banana .

应用程序可以:

• 在表格中添加/删除新电视剧
• 更改剧集的季节和剧集

我在编写将新电视剧添加到表中并连接新事件的代码时遇到问题。来自 here 的 CRUD 示例并没有太大帮助我，因为我有更多的要求，然后只是从列表中选择一个元素。

如何编写一个 reactiveTable 函数，例如 CRUD Example 中的 reactiveListDisplay 函数以玻璃钢方式？网络编译完成后，如何为删除按钮以及季节和剧集旋转按钮添加事件？

data Series = Series { name :: String
                     , season :: Int
                     , episode :: Int
                     }


insertIntoTable :: TableClass t => t -> SeriesChangeHandler -> SeriesRemoveHandler -> Series -> IO ()
insertIntoTable table changeHandler removeHandler (Series name s e) = do
   (rows, cols) <- tableGetSize table
   tableResize table (rows+1) cols

   nameLabel     <- labelNew $ Just name 
   adjustmentS   <- adjustmentNew (fromIntegral s) 1 1000 1 0 0
   adjustmentE   <- adjustmentNew (fromIntegral e) 1 1000 1 0 0
   seasonButton  <- spinButtonNew adjustmentS 1.0 0
   episodeButton <- spinButtonNew adjustmentE 1.0 0
   removeButton  <- buttonNewWithLabel "remove"
   let getSeries = do
            s <- spinButtonGetValue seasonButton
            e <- spinButtonGetValue episodeButton
            return $ Series name (round s) (round e)
       handleSeries onEvent widget handler = do
            onEvent widget $ do
                series <- getSeries
                handler series

    handleSeries onValueSpinned seasonButton  changeHandler
    handleSeries onValueSpinned episodeButton changeHandler
    onPressed removeButton $ do
        series <- getSeries
        containerRemove table nameLabel
        containerRemove table seasonButton 
        containerRemove table episodeButton 
        containerRemove table removeButton 
        removeHandler series

    let tadd widget x = tableAdd table widget x (rows - 1)
    tadd nameLabel     0
    tadd seasonButton  1
    tadd episodeButton 2
    tadd removeButton  3
    widgetShowAll table


main :: IO ()
main = do

    initGUI

    window     <- windowNew
    scroll     <- scrolledWindowNew Nothing Nothing
    table      <- tableNew 1 5 True
    addButton  <- buttonNewWithLabel "add series"
    vbox       <- vBoxNew False 10

    containerAdd window vbox
    boxPackStart vbox addButton PackNatural 0

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do

            addEvent <- eventButton addButton

            (changeHandler,fireChange) <- liftIO $ newAddHandler
            changeEvent <- fromAddHandler changeHandler
            (removeHandler,fireRemove) <- liftIO $ newAddHandler
            removeEvent <- fromAddHandler removeHandler

            let insertIntoTable' = insertIntoTable table fireChange fireRemove
                addSeries e = do
                     s <- addSeriesDialog
                     liftIO $ insertIntoTable' s

            liftIO $ mapM_ insertIntoTable' initSeries

            reactimate $ addSeries         <$> addEvent
            reactimate $ updateSeries conn <$> changeEvent
            reactimate $ removeSeries conn <$> removeEvent

    network <- compile networkDescription
    actuate network

    onDestroy window $ do
        D.disconnect conn
        mainQuit

    widgetShowAll window
    mainGUI

我想重构 insertIntoTable 方法以使用事件和行为，而不是使用简单的回调。

编辑:

我已经尝试过gtk TreeView与 ListStore后端。在这种情况下，您不需要动态事件切换。我编写了下面的 reactiveList 函数来从插入、更改和删除事件中获取列表行为。有效^^

reactiveList :: (Frameworks t)
    => ListStore a
    -> Event t (Int,a) -- insert event
    -> Event t (Int,a) -- change event
    -> Event t (Int,a) -- remove event
    -> Moment t (Behavior t [a])
reactiveList store insertE changeE removeE = do

    (listHandler,fireList) <- liftIO $ newAddHandler

    let onChange f (i,a) = do
            f i a
            list <- listStoreToList store
            fireList list

    reactimate $ onChange (listStoreInsert store)         <$> insertE
    reactimate $ onChange (listStoreSetValue store)       <$> changeE
    reactimate $ onChange (const . listStoreRemove store) <$> removeE

    initList <- liftIO $ listStoreToList store
    fromChanges initList listHandler


main :: IO ()
main = do

    initGUI

    window     <- windowNew
    addButton  <- buttonNewWithLabel "add series"
    vbox       <- vBoxNew False 10
    seriesList <- listStoreNew (initSeries :: [Series])
    listView   <- treeViewNewWithModel seriesList

    treeViewSetHeadersVisible listView True

    let newCol title newRenderer f = do
            col <- treeViewColumnNew
            treeViewColumnSetTitle col title
            renderer <- newRenderer
            cellLayoutPackStart col renderer False
            cellLayoutSetAttributes col renderer seriesList f
            treeViewAppendColumn listView col
            return renderer

    newCol "Image"  cellRendererPixbufNew $ \s -> [cellPixbuf :=> newPixbuf s]
    newCol "Name"   cellRendererTextNew   $ \s -> [cellText   :=  name s]
    seasonSpin <- newCol "Season" cellRendererSpinNew   $ \s ->
        [ cellRendererSpinAdjustment :=> adjustmentNew (fromIntegral (season s)) 1 1000 1 0 0
        , cellText := (show $ season s)
        , cellTextEditable := True
        ]
    episodeSpin <- newCol "Episode" cellRendererSpinNew   $ \s ->
        [ cellRendererSpinAdjustment :=> adjustmentNew (fromIntegral (episode s)) 1 1000 1 0 0
        , cellText := (show $ episode s)
        , cellTextEditable := True
        ]

    containerAdd window vbox
    boxPackStart vbox listView PackGrow 0
    boxPackStart vbox addButton PackNatural 0

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do

            (addHandler,fireAdd) <- liftIO $ newAddHandler
            maybeSeriesE <- fromAddHandler addHandler
            (removeHandler,fireRemove) <- liftIO $ newAddHandler
            removeE <- fromAddHandler removeHandler

            -- when the add button was pressed,
            -- open a dialog and return maybe a new series
            askSeriesE <- eventButton addButton
            reactimate $ (const $ fireAdd =<< askSeries) <$> askSeriesE

            -- ommit all nothing series
            let insertE  = filterJust maybeSeriesE
                insert0E = ((,) 0) <$> insertE

            seasonSpinE  <- eventSpin seasonSpin  seriesList
            episodeSpinE <- eventSpin episodeSpin seriesList
            let changeSeason  (i,d,s) = (i,s {season = round d})
                changeEpisode (i,d,s) = (i,s {episode = round d})
            let changeE = (changeSeason <$> seasonSpinE) `union` (changeEpisode <$> episodeSpinE)

            listB <- reactiveList seriesList insert0E changeE removeE
            listE <- (changes listB)

            reactimate $ (putStrLn . unlines . map show) <$> listE
            reactimate $ insertSeries conn       <$> insertE
            reactimate $ updateSeries conn . snd <$> changeE
            reactimate $ removeSeries conn . snd <$> removeE

            return ()

    network <- compile networkDescription
    actuate network

    onDestroy window $ do
        D.disconnect conn
        mainQuit

    widgetShowAll window
    mainGUI

我愿意接受意见和建议。

Answer 1

听起来你的问题更接近 Bar Tab比 CRUD 的例子。

添加新小部件以及新行为和事件的基本思想是使用所谓的“动态事件切换”。从本质上讲，这是一种将新创建的事件和行为放回到网络中的方法。

创建新小部件的操作分为两部分。第一部分是使用 liftIO 创建小部件。第二个是获取其输入并使用 trimE或trimB作为适当的。省略大部分 GTk 特定的细节(我不知道如何使用 GTk :P)，它看起来像这样:

let newSeries name = do 
  label <- liftIO . labelNew $ Just name
  liftIO $ tadd labelNew 0
  {- ... the rest of your controls here ... -}
  seasonNumber <- trimB $ getSpinButtonBehavior seasonButton
  {- ... wrap the rest of the inputs using trimB and trimE ... -}
  return (label, seasonNumber, ...)

因此，此函数创建一个新的小部件，“修剪”其输入并将值返回给您。现在您必须实际使用这些值:

newSeasons <- execute (FrameworkMoment newSeries <$> nameEvents)

此处 nameEvents 应该是一个 Event String，其中包含每次要添加的新系列名称的事件。

现在您已经拥有了所有新季节的流，您可以使用诸如 stepper 之类的工具将其全部组合成条目列表的单个行为。

有关更多详细信息(包括从所有小部件中获取聚合信息等内容)，请查看实际的示例代码。