Bảng phản ứng với chuối phản ứng và gtk2hs

Question

Tôi đã viết một ứng dụng nhỏ theo dõi sự tiến bộ của tôi trong TV Series. Ứng dụng này được viết bằng Haskell với chức năng lập trình phản ứng (FRP) với reactive banana.

Ứng dụng này có thể:

• thêm/gỡ bỏ dòng TV mới vào bảng
• thay đổi mùa và tập của một loạt

Tôi có vấn đề văn bản mã thêm chuỗi TV mới vào bảng và kết nối các sự kiện mới. Ví dụ CRUD từ here không hoàn toàn giúp tôi bởi vì tôi có nhiều yêu cầu hơn sau đó chỉ cần chọn một phần tử từ danh sách.

Làm cách nào để viết hàm reactiveTable như hàm reactiveListDisplay từ CRUD Example theo cách FRP? Làm cách nào để các sự kiện có thể được thêm vào cho nút xóa và các nút xoay phần và tập sau khi mạng được biên dịch?

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 

Tôi muốn tái cấu trúc phương thức insertIntoTable để sử dụng các sự kiện và hành vi thay vì sử dụng gọi lại đơn giản.

EDIT:

Tôi đã thử các gtk TreeView với một backend ListStore. Trong trường hợp này, bạn không cần chuyển đổi sự kiện động. Tôi đã viết hàm reactiveList bên dưới để có được hành vi danh sách ngoài chèn, thay đổi và xóa sự kiện. Nó hoạt động ^^

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 

Tôi đang mở để nhận xét và đề xuất.

Answer 1

Có vẻ như vấn đề của bạn gần giống với ví dụ Bar Tab so với ví dụ CRUD.

Ý tưởng cơ bản để thêm tiện ích mới - cùng với hành vi và sự kiện mới - là sử dụng cái gọi là "chuyển đổi sự kiện động". Về cơ bản, đây là một cách để đưa các sự kiện và hành vi mới được tạo lại vào mạng của bạn.

Hành động tạo tiện ích con mới có hai phần. Phần đầu tiên là chỉ cần tạo widget, sử dụng liftIO. Thứ hai là lấy các đầu vào của nó và sử dụng trimE hoặc trimB nếu thích hợp. Rời khỏi hầu hết các GTK cụ thể chi tiết (tôi không biết làm thế nào để sử dụng GTK: P), nó sẽ giống như thế này:

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, ...) 

Vì vậy, chức năng này sẽ tạo ra một widget mới, "Trims" của nó đầu vào và trả về các giá trị cho bạn. Bây giờ bạn có thực sự sử dụng những giá trị này:

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

đây nameEvents phải là một Event String chứa một sự kiện với tên của bộ phim mới mỗi khi bạn muốn thêm vào.

Bây giờ bạn có một luồng tất cả các phần mới, bạn có thể kết hợp tất cả các phần đó thành một hành vi duy nhất của một danh sách của mục nhập bằng cách sử dụng một cái gì đó như stepper.

Để biết thêm chi tiết - bao gồm những thứ như nhận thông tin tổng hợp từ tất cả các tiện ích của bạn - hãy xem mã ví dụ thực tế.