Plot.elm 9.23 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
28
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
29
    , selectedNamedSeries : List NamedSerie
30
    , activeSelection : Bool
André Espaze's avatar
André Espaze committed
31
    , cache : SeriesCache
32
33
34
35
36
37
38
    }


type alias SeriesCatalog =
    Dict.Dict String String


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


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


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


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


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


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


74
75
76
77
78
79
80
81
82
83
84
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
85
86
87
88
89
90
91
92
93
94
type alias TraceArgs =
    String -> List String -> List Float -> String -> Trace


scatterPlot : TraceArgs
scatterPlot =
    Trace "scatter"


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


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


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


André Espaze's avatar
André Espaze committed
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
187
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 )
            )


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

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

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

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

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

254
255
256
257
258
259
260
261
262
263
264

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


view : Model -> Html Msg
view model =
    let
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
        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
294

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

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

303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
                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
                )
    in
    div [ classes [ T.bg_light_blue ] ]
        [ header [] [ selector ]
        , div [ A.id plotDiv ] []
        , plotFigure [ A.attribute "args" args ] []
        , footer [] []
        ]
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339


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
340
            let
341
342
343
                p =
                    Common.checkUrlPrefix urlPrefix

André Espaze's avatar
André Espaze committed
344
345
346
                c =
                    LruCache.empty 100
            in
347
            ( Model p [] "" [] [] [] True c, initialGet p )
348
349
350
351
352
353
354
355
356
357
358
359
360
361

        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
        }