Plot.elm 10.4 KB
Newer Older
1
module Plot exposing (main)
2
3
4
5

import Browser
import Common exposing (classes)
import Dict
André Espaze's avatar
André Espaze committed
6
import Either exposing (Either)
7
import Html.Styled exposing (..)
8
import Html.Styled.Attributes as A
9
10
import Html.Styled.Events exposing (onClick)
import Http
André Espaze's avatar
André Espaze committed
11
import Json.Decode as Decode exposing (Decoder)
12
import Json.Encode as Encode
13
14
import KeywordMultiSelector
import KeywordSelector
André Espaze's avatar
André Espaze committed
15
import LruCache exposing (LruCache)
16
import Tachyons.Classes as T
André Espaze's avatar
André Espaze committed
17
import Task exposing (Task)
18
19
20
21
22
23
24
25
26
27
import Time
import Url.Builder as UB


type alias Model =
    { urlPrefix : String
    , series : List String
    , searchString : String
    , searchedSeries : List String
    , selectedSeries : List String
28
    , selectedNamedSeries : List NamedSerie
29
    , activeSelection : Bool
André Espaze's avatar
André Espaze committed
30
    , cache : SeriesCache
31
32
33
34
35
36
37
    }


type alias SeriesCatalog =
    Dict.Dict String String


André Espaze's avatar
André Espaze committed
38
39
40
41
type alias Serie =
    Dict.Dict String Float


André Espaze's avatar
André Espaze committed
42
43
44
45
type alias NamedSerie =
    ( String, Serie )


André Espaze's avatar
André Espaze committed
46
47
48
49
50
serieDecoder : Decoder Serie
serieDecoder =
    Decode.dict Decode.float


André Espaze's avatar
André Espaze committed
51
52
53
54
type alias SeriesCache =
    LruCache String Serie


55
56
57
58
59
60
type Msg
    = CatalogReceived (Result Http.Error SeriesCatalog)
    | ToggleSelection
    | ToggleItem String
    | SearchSeries String
    | MakeSearch
André Espaze's avatar
André Espaze committed
61
    | RenderPlot (Result String ( SeriesCache, List NamedSerie ))
André Espaze's avatar
André Espaze committed
62
63
64
65
66
67
68
69
70
71
72


type alias Trace =
    { type_ : String
    , name : String
    , x : List String
    , y : List Float
    , mode : String
    }


73
74
75
76
77
78
79
80
81
82
83
encodeTrace : Trace -> Encode.Value
encodeTrace t =
    Encode.object
        [ ( "type", Encode.string t.type_ )
        , ( "name", Encode.string t.name )
        , ( "x", Encode.list Encode.string t.x )
        , ( "y", Encode.list Encode.float t.y )
        , ( "mode", Encode.string t.mode )
        ]


André Espaze's avatar
André Espaze committed
84
85
86
87
88
89
90
91
92
93
type alias TraceArgs =
    String -> List String -> List Float -> String -> Trace


scatterPlot : TraceArgs
scatterPlot =
    Trace "scatter"


type alias PlotArgs =
94
95
    { div : String
    , data : List Trace
André Espaze's avatar
André Espaze committed
96
97
98
    }


99
100
101
102
103
104
encodePlotArgs : PlotArgs -> Encode.Value
encodePlotArgs x =
    Encode.object
        [ ( "div", Encode.string x.div )
        , ( "data", Encode.list encodeTrace x.data )
        ]
105
106


107
108
109
plotFigure : List (Attribute msg) -> List (Html msg) -> Html msg
plotFigure =
    node "plot-figure"
110
111


André Espaze's avatar
André Espaze committed
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
fetchSeries : List String -> Model -> Task String ( SeriesCache, List NamedSerie )
fetchSeries selectedNames model =
    let
        ( usedCache, cachedSeries ) =
            List.foldr
                (\name ( cache, xs ) ->
                    let
                        ( newCache, maybeSerie ) =
                            LruCache.get name cache

                        x : Either String NamedSerie
                        x =
                            maybeSerie
                                |> Either.fromMaybe name
                                |> Either.map (Tuple.pair name)
                    in
                    ( newCache, x :: xs )
                )
                ( model.cache, [] )
                selectedNames

        missingNames =
            Either.lefts cachedSeries

        getSerie : String -> Task String Serie
        getSerie serieName =
            Http.task
                { method = "GET"
                , url =
                    UB.crossOrigin
                        model.urlPrefix
                        [ "api", "series", "state" ]
                        [ UB.string "name" serieName ]
                , headers = []
                , body = Http.emptyBody
                , timeout = Nothing
                , resolver =
                    Http.stringResolver <|
                        Common.decodeJsonMessage serieDecoder
                }

        getMissingSeries : Task String (List Serie)
        getMissingSeries =
            Task.sequence <| List.map getSerie missingNames

        getSeries : List NamedSerie -> List NamedSerie
        getSeries missing =
            let
                series =
                    List.append (Either.rights cachedSeries) missing
                        |> Dict.fromList
            in
            List.foldr
                (\a b -> Common.maybe b (\x -> ( a, x ) :: b) (Dict.get a series))
                []
                selectedNames

        updateCache : List NamedSerie -> SeriesCache
        updateCache missing =
            List.foldl
                (\( name, serie ) cache -> LruCache.insert name serie cache)
                usedCache
                missing
    in
    getMissingSeries
        |> Task.andThen
            (\missingSeries ->
                let
                    xs =
                        List.map2 Tuple.pair missingNames missingSeries
                in
                Task.succeed ( updateCache xs, getSeries xs )
            )


187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    let
        removeItem x xs =
            List.filter ((/=) x) xs

        toggleItem x xs =
            if List.member x xs then
                removeItem x xs

            else
                x :: xs

        newModel x =
            ( x, Cmd.none )

        keywordMatch xm xs =
            if String.length xm < 2 then
                []

            else
                KeywordSelector.select xm xs |> List.take 20
    in
    case msg of
        CatalogReceived (Ok x) ->
            let
                series =
                    Dict.keys x
            in
            newModel { model | series = series }

        CatalogReceived (Err x) ->
            let
                _ =
                    Debug.log "Error on CatalogReceived" x
            in
            newModel model

        ToggleSelection ->
            newModel { model | activeSelection = not model.activeSelection }

        ToggleItem x ->
André Espaze's avatar
André Espaze committed
229
230
231
232
233
            let
                selectedSeries =
                    toggleItem x model.selectedSeries
            in
            ( { model | selectedSeries = selectedSeries }
André Espaze's avatar
André Espaze committed
234
            , Task.attempt RenderPlot <| fetchSeries selectedSeries model
André Espaze's avatar
André Espaze committed
235
            )
236
237
238
239
240
241
242

        SearchSeries x ->
            newModel { model | searchString = x }

        MakeSearch ->
            newModel { model | searchedSeries = keywordMatch model.searchString model.series }

André Espaze's avatar
André Espaze committed
243
        RenderPlot (Ok ( cache, namedSeries )) ->
244
            ( { model | cache = cache, selectedNamedSeries = namedSeries }, Cmd.none )
André Espaze's avatar
André Espaze committed
245
246
247
248
249
250
251
252

        RenderPlot (Err x) ->
            let
                _ =
                    Debug.log "Error on RenderPlot" x
            in
            newModel model

253
254
255
256
257
258
259
260
261
262
263

selectorConfig : KeywordMultiSelector.Config Msg
selectorConfig =
    { searchSelector =
        { action = Nothing
        , defaultText =
            text
                "Type some keywords in input bar for selecting time series"
        , toggleMsg = ToggleItem
        }
    , actionSelector =
264
        { action = Nothing
265
266
267
268
269
270
271
272
273
274
275
        , defaultText = text ""
        , toggleMsg = ToggleItem
        }
    , onInputMsg = SearchSeries
    , divAttrs = [ classes [ T.mb4 ] ]
    }


view : Model -> Html Msg
view model =
    let
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
        plotDiv =
            "plotly_div"

        args =
            let
                data =
                    List.map
                        (\( name, serie ) ->
                            scatterPlot
                                name
                                (Dict.keys serie)
                                (Dict.values serie)
                                "lines"
                        )
                        model.selectedNamedSeries
            in
            PlotArgs plotDiv data |> encodePlotArgs |> Encode.encode 0
293

294
295
296
297
        selector =
            let
                cls =
                    classes [ T.pb2, T.f4, T.fw6, T.db, T.navy, T.link, T.dim ]
298

299
300
                children =
                    [ a [ cls, onClick ToggleSelection ] [ text "Series selection" ] ]
301

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
                ctx =
                    KeywordMultiSelector.Context
                        model.searchString
                        model.searchedSeries
                        model.selectedSeries
            in
            form [ classes [ T.center, T.pt4, T.w_90 ] ]
                (if model.activeSelection then
                    List.append children
                        [ KeywordMultiSelector.view selectorConfig ctx
                        ]

                 else
                    children
                )
André Espaze's avatar
André Espaze committed
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351

        urls =
            let
                cls =
                    classes [ T.link, T.blue, T.lh_title ]

                permalink =
                    let
                        url =
                            UB.relative
                                [ "tsview" ]
                                (List.map
                                    (\x -> UB.string "series" x)
                                    model.selectedSeries
                                )
                    in
                    a [ A.href url, cls ] [ text "Permalink" ]

                histories =
                    List.map
                        (\x ->
                            a
                                [ A.href <| UB.relative [ "tshistory", x ] []
                                , A.target "_blank"
                                , cls
                                ]
                                [ text <| "View " ++ x ++ " history" ]
                        )
                        model.selectedSeries
            in
            ul [ classes [ T.list, T.mt3, T.mb0 ] ]
                (List.map
                    (\x -> li [ classes [ T.pv2 ] ] [ x ])
                    (permalink :: histories)
                )
352
    in
André Espaze's avatar
André Espaze committed
353
354
    div []
        [ header [ classes [ T.bg_light_blue ] ] [ selector ]
355
356
        , div [ A.id plotDiv ] []
        , plotFigure [ A.attribute "args" args ] []
André Espaze's avatar
André Espaze committed
357
        , footer [] [ urls ]
358
        ]
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373


main : Program String Model Msg
main =
    let
        initialGet urlPrefix =
            Http.get
                { expect = Http.expectJson CatalogReceived (Decode.dict Decode.string)
                , url =
                    UB.crossOrigin urlPrefix
                        [ "api", "series", "catalog" ]
                        []
                }

        init urlPrefix =
André Espaze's avatar
André Espaze committed
374
            let
375
376
377
                p =
                    Common.checkUrlPrefix urlPrefix

André Espaze's avatar
André Espaze committed
378
379
380
                c =
                    LruCache.empty 100
            in
381
            ( Model p [] "" [] [] [] True c, initialGet p )
382
383
384
385
386
387
388
389
390
391
392
393
394
395

        sub model =
            if model.activeSelection then
                Time.every 1000 (always MakeSearch)

            else
                Sub.none
    in
    Browser.element
        { init = init
        , view = view >> toUnstyled
        , update = update
        , subscriptions = sub
        }