Tabella reattiva con banana reattiva e gtk2hs

Question

Ho scritto una piccola applicazione che tiene traccia dei miei progressi in serie TV. L'applicazione è scritta in Haskell con programmazione reattiva funzionale (FRP) con reactive banana.

l'applicazione può:

• Add/Remove nuova serie tv al tavolo
• cambiamento della stagione e episodio di una serie

ho problemi a scrivere il codice che aggiunge una nuova serie TV al tavolo e collega i nuovi eventi. L'esempio CRUD di here non mi è stato di grande aiuto perché ho più requisiti quindi semplicemente selezionando un elemento dall'elenco.

Come si scrive una funzione reactiveListDisplay da CRUD Example in modo FRP? Come possono essere aggiunti gli eventi per il pulsante Rimuovi e per i pulsanti di rotazione della stagione e dell'episodio dopo che la rete è stata compilata?

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 

voglio refactoring il metodo insertIntoTable di utilizzare gli eventi e comportamenti, piuttosto che utilizzare i callback semplici.

EDIT:

Ho provato il gtk TreeView con un ListStore backend. In questo scenario non è necessario passare agli eventi dinamici. Ho scritto la funzione reactiveList di seguito per ottenere un comportamento di lista da inserire, modificare e rimuovere eventi. Funziona ^^

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 

Sono aperto a commenti e suggerimenti.

Answer 1

Sembra che il tuo problema è molto più vicino all'esempio Bar Tab rispetto al CRUD uno.

L'idea di base per l'aggiunta di nuovi widget - insieme a nuovi comportamenti ed eventi - è quello di utilizzare i cosiddetti "evento dinamico di commutazione". Essenzialmente, questo è un modo per rimettere gli eventi e i comportamenti appena creati nella tua rete.

L'azione di creare un nuovo widget ha due parti. La prima parte è semplicemente creare il widget, usando liftIO. Il secondo è quello di ottenere i suoi input e utilizzare trimE o trimB come appropriato. Tralasciando la maggior parte delle GTK-specifici dettagli (non so come usare GTk: P), sembrerà qualcosa di simile:

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

Quindi questa funzione crea un nuovo widget, "pezzi speciali" il suo immette e restituisce i valori. Ora si deve utilizzare in realtà questi valori:

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

qui nameEvents dovrebbe essere un Event String contenente un evento con il nome della nuova serie ogni volta che si desidera aggiungerlo.

Ora che avete un flusso di tutte le nuove stagioni, è possibile combinare il tutto in un unico comportamento di una lista di voci che utilizzano qualcosa come stepper.

Per ulteriori dettagli, inclusi elementi come ottenere informazioni aggregate da tutti i widget, osservare il codice di esempio attuale.