Deliverable for D3.2

Search.elm 7.6KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314
  1. port module Search exposing (..)
  2. import Date
  3. import Http
  4. import Html exposing (..)
  5. import Html.Attributes exposing (..)
  6. import Html.Events exposing (onClick)
  7. import List.Extra exposing (unique)
  8. import Decoders
  9. import Json.Encode exposing (..)
  10. main : Program Never Model Msg
  11. main =
  12. Html.program
  13. { init = init
  14. , view = view
  15. , update = update
  16. , subscriptions = subscriptions
  17. }
  18. port unsafeDrawGraph : List FloatDataItem -> Cmd msg
  19. port unsafeClearGraph : String -> Cmd msg
  20. -- MODEL
  21. type alias Model =
  22. { all : Maybe Decoders.Items
  23. , filter : Maybe String
  24. }
  25. initialModel : Model
  26. initialModel =
  27. { all = Nothing
  28. , filter = Nothing
  29. }
  30. init : ( Model, Cmd Msg )
  31. init =
  32. ( initialModel, getAllMetadata )
  33. -- UPDATE
  34. type Msg
  35. = NoOp
  36. | RefreshMetadata
  37. | RefreshMetadataCompleted (Result Http.Error Decoders.Items)
  38. | ShowLocations String
  39. | ViewGraph Decoders.Item
  40. | ViewGraphCompleted Decoders.Item (Result Http.Error Decoders.DataResponse)
  41. | RequestAccess Decoders.Item
  42. | RequestAccessCompleted (Result Http.Error Decoders.Entitlement)
  43. update : Msg -> Model -> ( Model, Cmd Msg )
  44. update msg model =
  45. case msg of
  46. NoOp ->
  47. ( model, Cmd.none )
  48. RefreshMetadata ->
  49. ( { model | filter = Nothing }, getAllMetadata )
  50. RefreshMetadataCompleted (Ok items) ->
  51. ( { model | all = Just items }, unsafeClearGraph "only-for-the-compiler" )
  52. RefreshMetadataCompleted (Err httpError) ->
  53. Debug.crash (toString httpError)
  54. ShowLocations tag ->
  55. case model.all of
  56. Nothing ->
  57. ( model, Cmd.none )
  58. Just r ->
  59. ( { model | filter = Just tag }, Cmd.none )
  60. ViewGraph item ->
  61. ( model, getTimeSeriesData item )
  62. ViewGraphCompleted requested (Ok graphData) ->
  63. let
  64. items =
  65. updateRight model.all requested Decoders.Unknown
  66. in
  67. ( { model | all = items }, unsafeDrawGraph (prepareGraphData (graphData.data)) )
  68. ViewGraphCompleted requested (Err (Http.BadStatus response)) ->
  69. let
  70. items =
  71. updateRight model.all requested Decoders.RequestAccess
  72. in
  73. ( { model | all = items }, Cmd.none )
  74. ViewGraphCompleted requested (Err httpError) ->
  75. Debug.crash (toString httpError)
  76. RequestAccess item ->
  77. let
  78. items =
  79. updateRight model.all item Decoders.Requesting
  80. in
  81. ( { model | all = items }, requestAccess item )
  82. RequestAccessCompleted (Ok items) ->
  83. ( model, Cmd.none )
  84. RequestAccessCompleted (Err httpError) ->
  85. Debug.crash (toString httpError)
  86. type alias FloatDataItem =
  87. { value : Float
  88. , date : String
  89. }
  90. prepareGraphData : List Decoders.DataItem -> List FloatDataItem
  91. prepareGraphData items =
  92. List.filterMap
  93. (\item ->
  94. case item.value of
  95. Decoders.JsFloat f ->
  96. Just (FloatDataItem f item.timeStamp)
  97. Decoders.JsInt i ->
  98. Just (FloatDataItem (toFloat i) item.timeStamp)
  99. _ ->
  100. Nothing
  101. )
  102. items
  103. -- RPC
  104. nodeURLFromLocation : Decoders.Location -> String
  105. nodeURLFromLocation location =
  106. location.scheme ++ "://" ++ location.ipAddress ++ ":" ++ toString (location.ipPort)
  107. metadataURL : String
  108. metadataURL =
  109. "http://localhost:8081"
  110. getAllMetadata : Cmd Msg
  111. getAllMetadata =
  112. let
  113. request =
  114. Http.get (metadataURL ++ "/catalog/items/") Decoders.decodeItems
  115. in
  116. Http.send RefreshMetadataCompleted request
  117. getTimeSeriesEncoder : String -> Json.Encode.Value
  118. getTimeSeriesEncoder key =
  119. Json.Encode.object [ ( "key", Json.Encode.string key ) ]
  120. getTimeSeriesData : Decoders.Item -> Cmd Msg
  121. getTimeSeriesData item =
  122. let
  123. request =
  124. Http.post (nodeURLFromLocation (item.location) ++ "/data/") (Http.jsonBody (getTimeSeriesEncoder item.key)) Decoders.decodeDataResponse
  125. in
  126. Http.send (ViewGraphCompleted item) request
  127. entitlementRequestEncoder : Decoders.Item -> Json.Encode.Value
  128. entitlementRequestEncoder item =
  129. Json.Encode.object
  130. [ ( "level", Json.Encode.string "can-access" )
  131. , ( "subject", Json.Encode.string item.key )
  132. ]
  133. requestAccess : Decoders.Item -> Cmd Msg
  134. requestAccess item =
  135. let
  136. request =
  137. Http.request
  138. { method = "PUT"
  139. , headers = []
  140. , url = nodeURLFromLocation (item.location) ++ "/entitlements/requests/"
  141. , body = Http.jsonBody (entitlementRequestEncoder item)
  142. , expect = Http.expectJson Decoders.decodeEntitlement
  143. , timeout = Nothing
  144. , withCredentials = False
  145. }
  146. in
  147. Http.send RequestAccessCompleted request
  148. -- SUBSCRIPTIONS
  149. subscriptions : Model -> Sub Msg
  150. subscriptions model =
  151. Sub.none
  152. -- VIEW
  153. view : Model -> Html Msg
  154. view model =
  155. case model.all of
  156. Nothing ->
  157. drawNoMetadata
  158. Just d ->
  159. case d of
  160. [] ->
  161. drawNoMetadata
  162. _ ->
  163. div []
  164. [ div [] [ text "Metadata" ]
  165. , div [] [ drawFiltered model.filter d ]
  166. ]
  167. drawNoMetadata : Html Msg
  168. drawNoMetadata =
  169. div []
  170. [ div [] [ text "no metadata available." ]
  171. , button [ onClick RefreshMetadata ] [ text "refresh" ]
  172. ]
  173. drawFiltered : Maybe String -> Decoders.Items -> Html Msg
  174. drawFiltered tag items =
  175. case tag of
  176. Nothing ->
  177. div [] <| List.map (\x -> div [] [ a [ onClick (ShowLocations x), href "#" ] [ text (x) ] ]) (uniqueTags items)
  178. Just t ->
  179. let
  180. filtered =
  181. filterByTag t items
  182. in
  183. div []
  184. [ div [] [ text (t) ]
  185. , div [] <| List.map (\item -> div [] [ text item.key, text " ", drawViewerWidget (item) ]) filtered
  186. , div [] [ button [ onClick RefreshMetadata ] [ text "new search" ] ]
  187. ]
  188. drawViewerWidget : Decoders.Item -> Html Msg
  189. drawViewerWidget item =
  190. case item.location.right of
  191. Decoders.Unknown ->
  192. a [ onClick (ViewGraph item), href "#" ] [ text "view" ]
  193. Decoders.RequestAccess ->
  194. a [ onClick (RequestAccess item), href "#" ] [ text "request access" ]
  195. Decoders.Requesting ->
  196. a [ onClick (ViewGraph item), href "#" ] [ text "request in progress, try again" ]
  197. -- Helpers
  198. updateRight : Maybe Decoders.Items -> Decoders.Item -> Decoders.Right -> Maybe Decoders.Items
  199. updateRight items item right =
  200. case items of
  201. Nothing ->
  202. items
  203. Just all ->
  204. let
  205. location1 =
  206. item.location
  207. location2 =
  208. { location1 | right = right }
  209. in
  210. Just (List.Extra.updateIf (\n -> n.uid == item.uid) (\t -> { t | location = location2 }) all)
  211. uniqueLocations : Decoders.Items -> List String
  212. uniqueLocations items =
  213. List.map (\x -> x.location.uid) items
  214. |> List.Extra.unique
  215. uniqueTags : Decoders.Items -> List String
  216. uniqueTags items =
  217. List.concatMap (\x -> x.tags) items
  218. |> List.Extra.unique
  219. filterByTag : String -> Decoders.Items -> Decoders.Items
  220. filterByTag tag data =
  221. List.filter (\x -> List.member tag x.tags) data