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

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


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


type alias SeriesCatalog =
    Dict.Dict String String


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


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


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


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


53
54
55
56
57
58
59
60
type Msg
    = CatalogReceived (Result Http.Error SeriesCatalog)
    | ToggleSelection
    | ToggleItem String
    | SearchSeries String
    | MakeSearch
    | OnApply
    | GotPlot (Result Http.Error String)
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87


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


type alias TraceArgs =
    String -> List String -> List Float -> String -> Trace


scatterPlot : TraceArgs
scatterPlot =
    Trace "scatter"


type alias PlotArgs =
    { data : List Trace
    }


port renderPlot : PlotArgs -> Cmd msg
88
89
90
91
92
93
94
95
96
97
98
99


type alias RenderArgs =
    { plotlyResponse : String
    , selectedSeries : List String
    , permalinkQuery : String
    }


port renderPlotly : RenderArgs -> Cmd msg


André Espaze's avatar
André Espaze committed
100
101
102
103
104
105
106
107
108
109
110
111
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
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 )
            )


175
176
177
178
179
180
181
182
183
184
185
186
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
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

        plotUrl =
            UB.crossOrigin model.urlPrefix
                [ "tsplot" ]
                (List.map (\x -> UB.string "series" x) model.selectedSeries)
    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
222
223
224
225
226
            let
                selectedSeries =
                    toggleItem x model.selectedSeries
            in
            ( { model | selectedSeries = selectedSeries }
André Espaze's avatar
André Espaze committed
227
            , Task.attempt RenderPlot <| fetchSeries selectedSeries model
André Espaze's avatar
André Espaze committed
228
            )
229
230
231
232
233
234
235

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

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

André Espaze's avatar
André Espaze committed
236
        RenderPlot (Ok ( cache, namedSeries )) ->
André Espaze's avatar
André Espaze committed
237
238
            let
                vals =
André Espaze's avatar
André Espaze committed
239
240
                    List.map
                        (\( name, serie ) ->
André Espaze's avatar
André Espaze committed
241
242
                            scatterPlot
                                name
André Espaze's avatar
André Espaze committed
243
244
                                (Dict.keys serie)
                                (Dict.values serie)
André Espaze's avatar
André Espaze committed
245
246
                                "lines"
                        )
André Espaze's avatar
André Espaze committed
247
                        namedSeries
André Espaze's avatar
André Espaze committed
248
            in
André Espaze's avatar
André Espaze committed
249
            ( { model | cache = cache }, renderPlot <| PlotArgs vals )
André Espaze's avatar
André Espaze committed
250
251
252
253
254
255
256
257

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

258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
        OnApply ->
            ( model, Http.get { url = plotUrl, expect = Http.expectString GotPlot } )

        GotPlot (Ok x) ->
            let
                validUrl =
                    Common.maybe
                        ("http://dummy" ++ plotUrl)
                        (always plotUrl)
                        (Url.fromString plotUrl)

                q =
                    validUrl
                        |> Url.fromString
                        |> Maybe.map (.query >> Maybe.withDefault "")
                        |> Maybe.withDefault ""
            in
            ( model, renderPlotly <| RenderArgs x model.selectedSeries q )

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


selectorConfig : KeywordMultiSelector.Config Msg
selectorConfig =
    { searchSelector =
        { action = Nothing
        , defaultText =
            text
                "Type some keywords in input bar for selecting time series"
        , toggleMsg = ToggleItem
        }
    , actionSelector =
        { action =
            Just
                { attrs = [ classes [ T.white, T.bg_dark_blue ] ]
                , html = text "Apply"
                , clickMsg = OnApply
                }
        , defaultText = text ""
        , toggleMsg = ToggleItem
        }
    , onInputMsg = SearchSeries
    , divAttrs = [ classes [ T.mb4 ] ]
    }


view : Model -> Html Msg
view model =
    let
        cls =
            classes [ T.pb2, T.f4, T.fw6, T.db, T.navy, T.link, T.dim ]

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

        ctx =
319
320
321
322
            KeywordMultiSelector.Context
                model.searchString
                model.searchedSeries
                model.selectedSeries
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
    in
    div [ classes [ T.center, T.pt4, T.w_90 ] ]
        (if model.activeSelection then
            List.append children
                [ KeywordMultiSelector.view selectorConfig ctx
                ]

         else
            children
        )


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
348
349
350
351
352
            let
                c =
                    LruCache.empty 100
            in
            ( Model urlPrefix [] "" [] [] True c, initialGet urlPrefix )
353
354
355
356
357
358
359
360
361
362
363
364
365
366

        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
        }