Elm, how to get current time and post it to server - time

According to this answer and its helpful Ellie I now have an idea of how we get the current time in Elm 0.18.
I want to get the current time and then post it in JSON to my server. I already have a POST working with a hardcoded timestamp, but I just don't see how to get the current time and then include it in the JSON I am POSTing.
My guess is that I need to chain a couple of commands (get current time, make a POST to server).
[I have also read another SO which shows how you can run a few commands in a row by directly calling the update function, which sounds like a nice idea but I am not sure if it is what I need for my situation.]
Experiment ([edit] perhaps more of a distraction than was intended)
In order to get my head around this I thought I would try to solve a similar problem that I can more easily set up in Ellie.
In the original Ellie the current time is gotten, updated into the model, and then the view function shows it.
In my version I wanted this to be a two-step process and therefore have grown the model to be a Maybe Float for the time and a String message. The view function shows the message string and a button -- the plan is that when the button is pressed it tells the runtime to 'go get the current time and then copy it across into the message slot'.
If I can solve this problem then I feel like I can solve my original problem.
My Ellie does not do this yet. When you press the button the time is gotten and is put into the time slot in the model, but I do not know how to tell the runtime to '...now copy that time across into the message slot'. The PutTimeInMessage message is in place, but I don't know how to get it to run after the GetCurrentTime message/command.
Any suggestions?
Here is my code so far (it compiles), which you can run here in Ellie:
module Main exposing (..)
import Html exposing (..)
import Html.Events exposing (..)
import Time exposing (Time)
import Date
import Task
type alias Model =
{ time : Maybe Float
, message : String
}
type Msg
= OnTime Time
| GetCurrentTime
| PutTimeInMessage
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
OnTime t ->
( { model | time = Just t }, Cmd.none )
GetCurrentTime ->
( model, getTime )
PutTimeInMessage ->
case model.time of
Nothing ->
( model, Cmd.none )
Just t ->
( { model | message = toString t }, Cmd.none )
view : Model -> Html Msg
view model =
div []
[ div []
[ button [ onClick GetCurrentTime ] [ Html.text "Get now time." ]
]
, model.message |> Html.text
]
getTime : Cmd Msg
getTime =
Time.now
|> Task.perform OnTime
main =
Html.program
{ init = ( Model Nothing "Empty message.", Cmd.none )
, update = update
, view = view
, subscriptions = always Sub.none
}

The way I see it, you can just update message field along with time field, when OnTime message is received. Thus, the whole update function is going to look like this:
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
OnTime t ->
( { model | time = Just t, message = toString t }, Cmd.none )
GetCurrentTime ->
( model, getTime )
The message is set in OnTime action, because in the GetCurrentTime time is unknown and is known only after getTime function is perform and OnTime message is received.
If you still want to use a separate action for putting the message, then the following code is the option:
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
OnTime t ->
update PutTimeInMessage { model | time = Just t }
GetCurrentTime ->
( model, getTime )
PutTimeInMessage ->
case model.time of
Nothing ->
( model, Cmd.none )
Just t ->
( { model | message = toString t }, Cmd.none )
But to be honest, the most preferable solution, would be just displaying the time in the view differently, so you don't need the message field (but probably I don't see the whole picture):
view : Model -> Html Msg
view model =
div []
[ div []
[ button [ onClick GetCurrentTime ] [ Html.text "Get now time." ]
]
, viewTime model.time
]
viewTime : Maybe Float -> Html Msg
viewTime time =
case time of
Nothing -> Html.text "Empty message."
Just t -> Html.text (toString t)

I came across an SO which explained how to do a sequence of Http requests with Task.andThen. Since I can see the type of Time.now is a Task I figured that I could adapt that example for my purposes if I use Http.toTask.
Below is the solution I came up with and here it is in Ellie:
module Main exposing (..)
import Html exposing (..)
import Html.Events exposing (..)
import Http
import Json.Decode as JD
import Json.Encode as JE
import Task
import Time
type alias Model =
{ url : String
}
type Msg
= PostTimeToServer
| PostDone (Result Http.Error String)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
PostTimeToServer ->
( model, postTimeToServer model.url )
PostDone _ ->
( model, Cmd.none )
view : Model -> Html Msg
view model =
div []
[ div []
[ button [ onClick PostTimeToServer ] [ Html.text "POST the current time." ]
]
]
postTimeToServer : String -> Cmd Msg
postTimeToServer url =
let
getTime =
Time.now
postTime t =
JD.string
|> Http.post url (JE.float t |> Http.jsonBody)
|> Http.toTask
request =
getTime <<-- Here is
|> Task.andThen postTime <<-- the key bit.
in
Task.attempt PostDone request
main =
Html.program
{ init = ( Model "url_here", Cmd.none )
, update = update
, view = view
, subscriptions = always Sub.none
}

Related

Set current time in init ELM 0.19

I get input JSON data from JS. This is a simple object, among which there is a date in the format "DD.MM.YYYY" - just a string.
If there is no dateStart in the object, I have to replace it with the current date (in withDefault).
paramsDecoder : Decode.Decoder Params
paramsDecoer =
Decode.succeed Params
|> Decode.andMap (Decode.field "dateStart" (Decode.string) |> (Decode.withDefault) "")
|> Decode.andMap (Decode.field "dateEnd" (Decode.string) |> (Decode.withDefault) "")
|> Decode.andMap (Decode.field "country" (Decode.string) |> (Decode.withDefault) "spain")
How can I do this in ELM?
Timezone is not important and is always equal to the same region.
I found an example of Time.now Time.zone usage,
but there time is getting in Update and its too late.
I solved this in two parts:
Part 1
Send the current time in to Elm when it initializes, using flags:
Elm.Main.init({flags: Date.now()});
And put it in your model:
import Time exposing (Posix, millisToPosix)
type alias Model = { now : Time.Posix, ... }
init : Int -> (Model, Cmd Msg)
init time = (Model (millisToPosix time), Cmd.none)
For your use case, you can then use withDefault model.now.
Part 2
The solution in Part 1 will only set now to the time when the page is loaded.
If you want to keep an up to date time you can use Time.every to update your model:
import Time exposing (Posix, millisToPosix, every)
timeOutCheck : Sub Msg
timeOutCheck = Time.every 250 UpdateTimeNow
type Msg = UpdateTimeNow Posix | ...
update msg model = case msg of
UpdateTimeNow time = { model | now = time }
...
This will ensure now is never more than 250 ms behind the current time. You can change 250 to suit your need.

How to connect leaflet map clicks (events) with plot creation in a shiny app

Hello I am creating an environmental shiny app in which I want to use a leaflet map to create some simple plots based on openair package(https://rpubs.com/NateByers/Openair).
Aq_measurements() general form
AQ<- (aq_measurements(country = “country”, city = “city”, location = “location”, parameter = “pollutant choice”, date_from = “YYYdateY-MM-DD”, date_to = “YYYY-MM-DD”).
All parameters available in locations dataframe.
worldmet() general form
met <- importNOAA(code = "12345-12345", year = YYYYY:YYYY)
NOAA Code available in locations dataframe
Below I create a sample of my initial data frame:
location = c("100 ail","16th and Whitmore","40AB01 - ANTWERPEN")
lastUpdated = c("2018-02-01 09:30:00", "2018-02-01 03:00:00", "2017-03-07 10:00:00")
firstUpdated = c("2015-09-01 00:00:00","2016-03-06 19:00:00","2016-11-22 15:00:00")
pm25=c("FALSE","FALSE","FALSE")
pm10=c("TRUE","FALSE","FALSE")
no2=c("TRUE","FALSE","FALSE")
latitude=c(47.932907,41.322470,36.809700)
longitude=c(106.92139000,-95.93799000
,-107.65170000)
df = data.frame(location, lastUpdated, firstUpdated,latitude,longitude,pm25,pm10,no2)
As a general idea I want to be able to click on a certain location in the map based on this dataframe. Then I have one selectInput() and 2 dateInput(). The 2 dateInput() should take as inputs the df$firstUpdated and df$lastUpdated respectively. Then the selectInput() should take as inputs the pollutants that exist in the df based on "TRUE"/"FALSE" value. And then the plots should be created. All of these should be triggered by clicking on the map.
Up to now I was not able to achieve this so in order to help you understand I connected the selectInput() and the dateInput() with input$loc which is a selectIpnut() with locations in the first tab as I will not need this when I find the solution.
library(shiny)
library(leaflet)
library(plotly)
library(shinythemes)
library(htmltools)
library(DT)
library(utilr)
library(openair)
library(plotly)
library(dplyr)
library(ggplot2)
library(gissr)
library(ropenaq)
library(worldmet)
# Define UI for application that draws a histogram
ui = navbarPage("ROPENAQ",
tabPanel("CREATE DATAFRAME",
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
wellPanel(
uiOutput("loc"),
helpText("Choose a Location to create the dataframe.")
)
),
mainPanel(
)
)
),
tabPanel("LEAFLET MAP",
leafletOutput("map"),
wellPanel(
uiOutput("dt"),
uiOutput("dt2"),
helpText("Choose a start and end date for the dataframe creation. Select up to 2 dates")
),
"Select your Pollutant",
uiOutput("pollutant"),
helpText("While all pollutants are listed here, not all pollutants are measured at all locations and all times.
Results may not be available; this will be corrected in further revisions of the app. Please refer to the measurement availability
in the 'popup' on the map."),
hr(),
fluidRow(column(8, plotOutput("tim")),
column(4,plotOutput("polv"))),
hr(),
fluidRow(column(4, plotOutput("win")),
column(8,plotOutput("cal"))),
hr(),
fluidRow(column(12, plotOutput("ser"))
)
)
)
#server.r
# load data
# veh_data_full <- readRDS("veh_data_full.RDS")
# veh_data_time_var_type <- readRDS("veh_data_time_var_type.RDS")
df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {
output$pollutant<-renderUI({
selectInput("pollutant", label = h4("Choose Pollutant"),
choices = colnames(df[,6:8]),
selected = 1)
})
#Stores the value of the pollutant selection to pass to openAQ request
###################################
#output$OALpollutant <- renderUI({OALpollutant})
##################################
# create the map, using dataframe 'locations' which is polled daily (using ropenaq)
#MOD TO CONSIDER: addd all available measurements to the popup - true/false for each pollutant, and dates of operation.
output$map <- renderLeaflet({
leaflet(subset(df,(df[,input$pollutant]=="TRUE")))%>% addTiles() %>%
addMarkers(lng = subset(df,(df[,input$pollutant]=="TRUE"))$longitude, lat = subset(df,(df[,input$pollutant]=="TRUE"))$latitude,
popup = paste("Location:", subset(df,(df[,input$pollutant]=="TRUE"))$location, "<br>",
"Pollutant:", input$pollutant, "<br>",
"First Update:", subset(df,(df[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
"Last Update:", subset(df,(df[,input$pollutant]=="TRUE"))$lastUpdated
))
})
#Process Tab
OAL_site <- reactive({
req(input$map_marker_click)
location %>%
filter(latitude == input$map_marker_click$lat,
longitude == input$map_marker_click$lng)
###########
#call Functions for data retrieval and processing. Might be best to put all data request
#functions into a seperate single function. Need to:
# call importNOAA() to retrieve meteorology data into temporary data frame
# call aq_measurements() to retrieve air quality into a temporary data frame
# merge meteorology and air quality datasets into one working dataset for computations; temporary
# meteorology and air quality datasets to be removed.
# call openAir() functions to create plots from merged file. Pass output to a dashboard to assemble
# into appealing output.
# produce output, either as direct download, or as an emailable PDF.
# delete all temporary files and reset for next run.
})
#fun
output$loc<-renderUI({
selectInput("loc", label = h4("Choose location"),
choices = df$location ,selected = 1
)
})
output$dt<-renderUI({
dateInput('date',
label = 'First Available Date',
value = subset(df$firstUpdated,(df[,1]==input$loc))
)
})
output$dt2<-renderUI({
dateInput('date2',
label = 'Last available Date',
value = subset(df$lastUpdated,(df[,1]==input$loc))
)
})
rt<-reactive({
AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2,parameter = input$pollutant)
met <- importNOAA(year = 2014:2018)
colnames(AQ)[9] <- "date"
merged<-merge(AQ, met, by="date")
# date output -- reports user-selected state & stop dates in UI
merged$location <- gsub( " " , "+" , merged$location)
merged
})
#DT
output$tim = renderPlot({
timeVariation(rt(), pollutant = "value")
})
}
shinyApp(ui = ui, server = server)
The part of my code that I believe input$MAPID_click should be applied is:
output$map <- renderLeaflet({
leaflet(subset(locations,(locations[,input$pollutant]=="TRUE")))%>% addTiles() %>%
addMarkers(lng = subset(locations,(locations[,input$pollutant]=="TRUE"))$longitude, lat = subset(locations,(locations[,input$pollutant]=="TRUE"))$latitude,
popup = paste("Location:", subset(locations,(locations[,input$pollutant]=="TRUE"))$location, "<br>",
"Pollutant:", input$pollutant, "<br>",
"First Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
"Last Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$lastUpdated
))
})
output$dt<-renderUI({
dateInput('date',
label = 'First Available Date',
value = subset(locations$firstUpdated,(locations[,1]==input$loc))
)
})
output$dt2<-renderUI({
dateInput('date2',
label = 'Last available Date',
value = subset(locations$lastUpdated,(locations[,1]==input$loc))
)
})
rt<-reactive({
AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2)
met <- importNOAA(year = 2014:2018)
colnames(AQ)[9] <- "date"
merged<-merge(AQ, met, by="date")
# date output -- reports user-selected state & stop dates in UI
merged$location <- gsub( " " , "+" , merged$location)
merged
})
#DT
output$tim = renderPlot({
timeVariation(rt(), pollutant = "value")
})
Here is a minimal example. You click on your marker and you get a plot.
ui = fluidPage(
leafletOutput("map"),
textOutput("temp"),
plotOutput('tim')
)
#server.r
#df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {
output$map <- renderLeaflet({
leaflet(df)%>% addTiles() %>% addMarkers(lng = longitude, lat = latitude)
})
output$temp <- renderPrint({
input$map_marker_click$lng
})
output$tim <- renderPlot({
temp <- df %>% filter(longitude == input$map_marker_click$lng)
# timeVariation(temp, pollutant = "value")
print(ggplot(data = temp, aes(longitude, latitude)) + geom_point())
})
}
shinyApp(ui = ui, server = server)

Elm - Random Number on init strange behaviour

Just working through the samples, and got the exercise about creating 2 random dice and rolling them with a button.
http://guide.elm-lang.org/architecture/effects/random.html
So I thought I would create the dice as a module, remove the roll action, and just have it create a D6 value on init.
So my code is now as follows (should open direct in elm-reactor)
module Components.DiceRoller exposing (Model, Msg, init, update, view)
import Html exposing (..)
import Html.App as Html
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Random
import String exposing (..)
main =
Html.program
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ dieFace : Int
}
init : ( Model, Cmd Msg )
init =
( Model 0, (Random.generate NewFace (Random.int 1 6)) )
-- UPDATE
type Msg
= NewFace Int
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NewFace newFace ->
( Model newFace, Cmd.none )
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.none
-- VIEW
dieFaceImage : Int -> String
dieFaceImage dieFace =
concat [ "/src/img/40px-Dice-", (toString dieFace), ".svg.png" ]
view : Model -> Html Msg
view model =
let
imagePath =
dieFaceImage model.dieFace
in
div []
[ img [ src imagePath ] []
, span [] [ text imagePath ]
]
The problem with this is that it is always producing the same value. I thought I had a problem with the seed to begin with, but if you change
init =
( Model 0, (Random.generate NewFace (Random.int 1 6)) )
init =
( Model 0, (Random.generate NewFace (Random.int 1 100)) )
it works exactly as intended. So it looks like the default generator is not working with small values, seems to work as low down as 10.
The odd thing is this, in this example (which i started with) http://guide.elm-lang.org/architecture/effects/random.html , it works fine with 1-6 when it's not in init.
So my question is, am I doing something wrong, or is this just a wrinkle in elm? Is my usage of the command in init ok?
In the end, I put this in to get the desired effect, which feels wonky.
init =
( Model 0, (Random.generate NewFace (Random.int 10 70)) )
with
NewFace newFace ->
( Model (newFace // 10), Cmd.none )
This must to have something to do with seeding. You're not specifying any value for seed so the generator is defaulting to use the current time.
I think you tried to refresh your page for a few times in a few seconds and you didn't see the value change. If you wait for longer (roughly a minute) you'll see your value change.
I had a look at the source code of Random and I suspect that for seed values that are close enough the first value generated in the range [1,6] doesn't change. I'm not sure whether this is expected or not, probably it's worth raising an issue on GitHub

Elm's Time is not Precise, is it?

I've been toying with Effects.tick and Time in one of my apps, and I can't seem to get my delays to be around the Time.second that it claims to be. It's nearly immediate. I understand that type alias Time = Float, and from my logs it seems that second = 1000, but this just burns so quickly, even with logging. Is there a clear explanation for this?
Effects.tick causes an action to be called nearly instantaneously, but the action that is being called gets passed a value of the current time of the tick. If you want to delay something by a second while using Effects.tick, you'll have to keep track of a starting point and compare it to the time of the current tick, and that's where you can add in Time.second.
Take this arbitrary example (you can paste it into http://elm-lang.org/try):
import Html exposing (..)
import Html.Events exposing (..)
import Html.Attributes exposing (..)
import StartApp
import Effects exposing (Never)
import Task
import Signal
import Time exposing (..)
app =
StartApp.start
{ init = init
, view = view
, update = update
, inputs = [ ]
}
main =
app.html
type alias Model =
{ lastTick : Maybe Time
, tickEverySecond : Maybe Time
}
init =
({ lastTick = Nothing, tickEverySecond = Nothing }, Effects.tick MyTicker)
view address model =
div []
[ div [] [ text <| "Current tick: " ++ (toString model.lastTick) ]
, div [] [ text <| "Updated every second: " ++ (toString model.tickEverySecond) ]
]
type Action
= MyTicker Time
update action model =
let
everySecond = Maybe.withDefault 0 model.tickEverySecond
getTickEverySecond time =
if time > everySecond + Time.second then
Just time
else
Just everySecond
in
case action of
MyTicker time -> (
{ model | lastTick = Just time
, tickEverySecond = getTickEverySecond time
}, Effects.tick MyTicker)
port tasks : Signal (Task.Task Never ())
port tasks =
app.tasks
Every update call requests a new tick, so it will just spin forever. The important part is that tickEverySecond is only updated if the last time it was updated is greater than one second ago.
You ask about the time precision. If you run that example, you'll notice that the increment every second is somewhat approximate; it will drift greater than a second. That isn't due to any kind of underlying imprecision. Remember that Elm's Time functionality is a thin veneer over Javascript's time and timer functionality. That drift is merely an artifact of all the tiny little delays caused by running code that responds to a timer signal.

capturing right-click event on treeview row [haskell gtk2hs]

I have searched thoroughly (at least I believe so) and I didn't find any answer for my problem, so I'd like to ask you for help.
I'm trying to determine when a user right-clicks a row in my treeView (list of users) and then show a pop-up window with options to edit and delete them.
Here's how my app looks so far
Here's the code that generates the treeView:
import Graphics.UI.Gtk
import System.Glib.Signals (on)
import Graphics.UI.Gtk.Glade
import Graphics.UI.Gtk.ModelView as New
import SzuDB
data GUI = GUI {
mainWindow :: Window,
--Buttony
dodajUczBt :: Button,
cancelAddUczBt :: Button,
zapiszUczBtn :: Button,
--TreeView
listaUczView :: TreeView,
-- Dialogi
dodajUzDialog :: Dialog,
-- Entry
nImie :: Entry,
nNazwisko :: Entry,
nWiek :: SpinButton,
lblLiczbaUcz :: Label
}
-- Różne listy
data ListStores = ListStores { uczestnicy :: ListStore Uczestnik }
main = do
initGUI
dbh <- connect "szu.db"
gui <- loadGlade "szu.glade" dbh
-- lapiemy uzytkownikow
uczestnicy <- getAllUsers dbh
labelSetText (lblLiczbaUcz gui) $ "Liczba uczestników: "++ show (length uczestnicy)
listaUczestnikow <- New.listStoreNew uczestnicy
New.treeViewSetModel (listaUczView gui) listaUczestnikow
wyswietlUczestnikow (listaUczView gui) listaUczestnikow
let liststore = ListStores $ listaUczestnikow
loadGUIEvents gui dbh liststore
widgetShowAll (mainWindow gui)
mainGUI
-- loadGlade etc.
wyswietlUczestnikow view uczestnik = do
New.treeViewSetHeadersVisible view True
-- add a couple columns
renderer1 <- New.cellRendererTextNew
col1 <- New.treeViewColumnNew
New.treeViewColumnPackStart col1 renderer1 True
New.cellLayoutSetAttributes col1 renderer1 uczestnik $ \row -> [ New.cellText := imie row ]
New.treeViewColumnSetTitle col1 "Imię"
New.treeViewAppendColumn view col1
renderer2 <- New.cellRendererTextNew
col2 <- New.treeViewColumnNew
New.treeViewColumnPackStart col2 renderer2 True
New.cellLayoutSetAttributes col2 renderer2 uczestnik $ \row -> [ New.cellText := nazwisko row ]
New.treeViewColumnSetTitle col2 "Nazwisko"
New.treeViewAppendColumn view col2
renderer3 <- New.cellRendererTextNew
col3 <- New.treeViewColumnNew
New.treeViewColumnPackStart col3 renderer3 True
New.cellLayoutSetAttributes col3 renderer3 uczestnik $ \row -> [ New.cellText := show (wiek row) ]
New.treeViewColumnSetTitle col3 "Wiek"
New.treeViewAppendColumn view col3
--
-- ladujemy wydarzenia
--
-- loadGuiEvents etc.
I have already tried to use the example at http://www.muitovar.com/gtk2hs/chap7-2.html but it resulted in compile error (it said that eventButton is used with one argument while it requires none).
Any help would be greatly appreciated :)
Cheers
Okay it seems I'm going be the first one to find answer for my own question :)
(1) First of all the example at http://www.muitovar.com/gtk2hs/chap7-2.html didn't work for me because you have two eventButton functions in gtk2hs and you have to use the one from Graphics.UI.Gtk.Gdk.Events. So you have to add at the beginning of the file:
import Graphics.UI.Gtk.Gdk.Events as Ev
and then add Ev. prefix to eventButton, RightButton and eventSent. It'll work now :)
(2) How to respond to right clicks on treeView row:
Having solved the aforementioned problem I stumbled upon this example, where it's shown how to respond to selecting a row in treeView. So I mixed those two solutions and came up with something like this (most of the code comes from the treeview example with some of my tweaks):
module Main where
{- an example how to select from a list
not satisfactory yet:
- there should be a simpler way to render a simple list
- i could not convert the model i got back to a list
from which to get the value
- the interface offers a great number of functions
and it is very difficult to find which ones are
really needed for simple tasks
-}
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as Model
import Graphics.UI.Gtk.Gdk.Events as Ev
main :: IO ()
main = do
initGUI -- is start
window <- windowNew
list <- listStoreNew ["Vince", "Jhen", "Chris", "Sharon"]
treeview <- Model.treeViewNewWithModel list
Model.treeViewSetHeadersVisible treeview True
-- there should be a simpler way to render a list as the following!
col <- Model.treeViewColumnNew
Model.treeViewColumnSetTitle col "colTitle"
renderer <- Model.cellRendererTextNew
Model.cellLayoutPackStart col renderer False
Model.cellLayoutSetAttributes col renderer list
$ \ind -> [Model.cellText := ind]
Model.treeViewAppendColumn treeview col
--tree <- Model.treeViewGetSelection treeview
--Model.treeSelectionSetMode tree SelectionSingle
--Model.onSelectionChanged tree (oneSelection list tree)
set window [ windowDefaultWidth := 100
, windowDefaultHeight := 200
, containerChild := treeview
]
-- here comes the right-click popup
eda <- actionNew "EDA" "Edit" Nothing Nothing
pra <- actionNew "PRA" "Process" Nothing Nothing
rma <- actionNew "RMA" "Remove" Nothing Nothing
saa <- actionNew "SAA" "Save" Nothing Nothing
agr <- actionGroupNew "AGR1"
mapM_ (actionGroupAddAction agr) [eda,pra,rma,saa]
uiman <- uiManagerNew
uiManagerAddUiFromString uiman uiDecl
uiManagerInsertActionGroup uiman agr 0
maybePopup <- uiManagerGetWidget uiman "/ui/popup"
let pop = case maybePopup of
(Just x) -> x
Nothing -> error "Cannot get popup from string"
onButtonPress treeview (\x -> if (Ev.eventButton x) == Ev.RightButton
then do
menuPopup (castToMenu pop) Nothing
return (Ev.eventSent x)
else return (Ev.eventSent x))
mapM_ (prAct treeview list) [eda,pra,rma,saa]
onDestroy window mainQuit
widgetShowAll window
mainGUI
return ()
uiDecl = "<ui> \
\ <popup>\
\ <menuitem action=\"EDA\" />\
\ <menuitem action=\"PRA\" />\
\ <menuitem action=\"RMA\" />\
\ <separator />\
\ <menuitem action=\"SAA\" />\
\ </popup>\
\ </ui>"
-- Handle the right-click. You can write a function that'll respond to various
-- actions, like for example: handleAction "EDA" = do something, etc.
prAct treeview list a = onActionActivate a $ do
name <- actionGetName a
-- getting the selected row
tree <- Model.treeViewGetSelection treeview
-- you can also use treeSelectionGetSelected to get the Iter object
-- and then convert it to Int by using listStoreIterToIndex and so get
-- the ListStore item at given index
sel <- Model.treeSelectionGetSelectedRows tree
let s = head (head sel)
v <- Model.listStoreGetValue list s
putStrLn ("Action Name: " ++ name ++ " | Item: " ++ v)
I hope it'll be helpful for someone :)
Cheers

Resources