allow dragging the selection markers (no live update)

and also a couple of libs we weren't using

README.md

@@ -104,7 +104,7 @@ _Do not look below this line_
   sessions are then presented to the rider who may approve them
   as-is - perhaps involving other data collection as well ("perceived
   effort" or "which bike setup was this" or ...) - or chop them up
-  using information thy have but the computer doesn't
+  using information they have but that the computer doesn't
 
 in theory we don't even need draft sessions and we could have the
 rider create sessions from the calendar page. However, that's a GET
@@ -119,38 +119,10 @@ we show time spent in HR zones ...
 
 ----
 
-time axis wants to show ticks which are at least (portalWidth/4)
-pixels apart, and choose the smallest of the following time intervals
-which are greater than that width
+start and end marks can be drag targets but we also need to know where
+they are when they're not being dragged
 
-1 second
-5 seconds
-15 seconds
-30 seconds
-60 seconds
-5 minutes
-15 minutes
-1 hour
-3 hours
-6 hours
-24 hours
-
-if the full width is 240 seconds, show a tick every 60 second
-if the full width is 20 seconds, show a tick every 5 seconds
-
-if the width grows past 20 seconds, the distance between points shrinks
-and therefore we put ticks less often
-
-if width <= 4 * 5, 5 second tick
-if width <= 4 * 15, 15 second tick
-etc ...
-
-to convert time to pixels, multiply by portalWidth / duration
-
-
-
-
-portalWidth / duration
+selectedRange start, duration
 
 
 

default.nix

@@ -18,6 +18,7 @@ in haskellEnv.overrideAttrs(o: {
                   elm-format
                   elm-optimize-level-2
                   elm-review
+                  elm-analyse
                   elm-test
                 ]);
 })

elm.json

@@ -17,9 +17,7 @@
             "elm/url": "1.0.0",
             "elm-community/list-extra": "8.7.0",
             "elm-explorations/test": "2.2.0",
-            "mpizenberg/elm-pointer-events": "5.0.0",
-            "rtfeldman/elm-iso8601-date-strings": "1.1.4",
-            "ymtszw/elm-xml-decode": "3.2.2"
+            "mpizenberg/elm-pointer-events": "5.0.0"
         },
         "indirect": {
             "elm/bytes": "1.0.8",

frontend/src/Lib.elm

@@ -1,22 +1,15 @@
 -- miscellaneous functions extracted from Main so
 -- we can more easily test them
 
-module Lib exposing(looseLabels)
+module Lib exposing (looseLabels)
 
 
-maybe default val =
-    case val of
-        Just v -> v
-        Nothing -> default
-
 -- https://github.com/cenfun/nice-ticks/blob/master/docs/Nice-Numbers-for-Graph-Labels.pdf
 
-log10 x = logBase 10 x
-expt b x = b^(toFloat x)
-
 niceNumber x round =
-    let exp = floor (log10 x)
-        f = x / (expt 10.0 exp)
+    let expt b ex = b^ toFloat ex
+        exp = floor (logBase 10 x)
+        f = x / expt 10.0 exp
         nfRound = if f < 1.5
                   then 1
                   else if f < 3
@@ -42,6 +35,6 @@ looseLabels ticks min max =
     let
         range = niceNumber (max-min) False
         d = niceNumber (range/(ticks - 1)) True
-        graphmin = toFloat (floor  (min/d)) * d
+        graphmin = toFloat (floor (min/d)) * d
         graphmax = toFloat (ceiling (max/d)) * d
     in (graphmin, graphmax, d)

frontend/src/Main.elm

@@ -2,7 +2,7 @@ module Main exposing (view)
 
 import Browser
 import Browser.Navigation as Nav
-import Html exposing (Html, button, div, span, text, img, pre)
+import Html exposing (Html, button, div, span, text, img)
 import Html.Attributes as H exposing (src, style, width, height)
 import Html.Events exposing (onClick, on)
 import Html.Events.Extra.Pointer as Pointer
@@ -12,24 +12,20 @@ import List.Extra exposing(find)
 import Json.Decode as D
 import Http
 import Point exposing(Point, Pos ,decoder)
-import Svg exposing (Svg, svg, rect, circle, g, polyline, line)
+import Svg exposing (Svg, svg, rect, g, polyline, line)
 import Svg.Attributes as S exposing
     ( viewBox
     , preserveAspectRatio
     , transform
     , x, y
     , x1, y1 , x2, y2
-    , r, rx, ry
-    , cx, cy
     , fill
-    , points
     , stroke, strokeWidth, strokeOpacity)
-import Time exposing(Posix)
-import Url.Parser exposing (Parser, (</>), (<?>), int, map, oneOf, s, string)
+import Time
+import Url.Parser exposing (Parser, (<?>), int, map, s, string)
 import Url.Parser.Query as Query
 import Url exposing (Url)
 
-
 type Route = Timeline (Maybe Int) (Maybe Int)
 
 routeParser : Parser (Route -> a) a
@@ -45,12 +41,10 @@ main =
       { init = init
       , update = update
       , subscriptions = subscriptions
-      , onUrlRequest = (\ ur ->  NewUrlRequest)
-      , onUrlChange = (\ u -> UrlChanged)
+      , onUrlRequest = \ _ ->  NewUrlRequest
+      , onUrlChange = \ _ -> UrlChanged
       , view = view }
 
-
-
 -- MATHS
 
 -- Coordinates in a Mercator projection
@@ -72,9 +66,6 @@ incZoom (FineZoomLevel z) delta =
 
 type alias TileNumber = { x: Int, y: Int }
 
-type alias Lat = Float
-type alias Lng = Float
-
 -- project lat/long to co-ordinates based on pseudocode at
 -- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels
 
@@ -126,7 +117,7 @@ boundingTiles centre z width height =
 
 -- MODEL
 
-type DragTarget = Map | Graph | StartMark | EndMark
+type DragTarget = Map | Graph | StartMark | EndMark | NoTarget
 
 type Drag
     = None
@@ -137,7 +128,7 @@ dragTo : Drag ->  (Int, Int) -> Drag
 dragTo d dest =
     case d of
         None -> None
-        Dragging target from to -> Dragging target from dest
+        Dragging target from _ -> Dragging target from dest
 
 dragDelta target d =
     case d of
@@ -155,20 +146,21 @@ type alias Model =
     { centre: Coord
     , zoom: FineZoomLevel
     , drag: Drag
-    , startTime : Int
-    , duration : Int
+    , startTime : Float
+    , duration : Float
+    , markedTime : (Float, Float)
     , track: TrackState }
 
 init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
 init _ url navKey =
     let (start, duration) =
             case Url.Parser.parse routeParser url of
-                Just (Timeline (Just s) (Just d)) -> (s, d)
+                Just (Timeline (Just s) (Just d)) -> (toFloat s, toFloat d)
                 _ -> (10,10)
     in
         ((Model
               (toCoord (Pos 0 0 Nothing))
-              (FineZoomLevel (1*8)) None 0 0 Empty),
+              (FineZoomLevel (1*8)) None 0 0 (0,0) Loading),
              (fetchTrack start duration))
 
 -- SUBSCRIPTIONS
@@ -179,9 +171,9 @@ subscriptions model = Sub.none
 
 fetchTrack start duration = Http.get
         { url = ("http://localhost:3000/points?start=" ++
-                     String.fromInt start ++
+                     String.fromInt (floor start) ++
                      "&duration=" ++
-                     String.fromInt duration)
+                     String.fromInt (ceiling duration))
         , expect = Http.expectJson Loaded (D.list Point.decoder)
         }
 
@@ -227,14 +219,33 @@ updateModel msg model =
                           drag = None,
                           startTime =
                           let (delta, _) = subTuple start end
-                          in model.startTime + delta * model.duration // portalWidth
+                          in model.startTime + toFloat delta * model.duration / portalWidth
                     }
+                Dragging StartMark start end ->
+                    { model |
+                          drag = None,
+                          markedTime =
+                          let delta = Tuple.first (subTuple start end)
+                              deltat = toFloat delta * model.duration / portalWidth
+                              (s, d) = model.markedTime
+                          in (s - deltat, d + deltat)
+                    }
+                Dragging EndMark start end ->
+                    { model |
+                          drag = None,
+                          markedTime =
+                          let delta = Tuple.first (subTuple start end)
+                              deltat = toFloat delta * model.duration / portalWidth
+                              (s, d) = model.markedTime
+                          in (s, d - deltat)
+                    }
+
                 _ -> model
         TimeScale factor ->
             let fudge = factor
-                len = model.duration - floor(fudge)
+                len = model.duration - fudge
             in { model |
-                     startTime = model.startTime + floor(fudge / 2)
+                     startTime = model.startTime + fudge / 2
                ,     duration = len
                }
 
@@ -247,9 +258,10 @@ updateModel msg model =
                     { model
                         | track = Present trk
                         , centre = toCoord (Point.centre trk)
-                        , zoom = FineZoomLevel ( 13  * 8)
-                        , startTime = floor start
-                        , duration = ceiling duration
+                        , zoom = FineZoomLevel (13  * 8)
+                        , startTime = start
+                        , duration = duration
+                        , markedTime = (start + 300, duration - 900)
                     }
                 Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
                 Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
@@ -408,10 +420,41 @@ measureView title colour fn points =
         , xtick 5
         ]
 
-timeClickDecoder  =
-    D.map Dribble  (D.at ["target", "id"] D.string)
+type alias TargetedPointerEvent =
+    { pointerEvent : Pointer.Event
+    , targetId : String
+    }
 
-timeAxis points =
+targetedEventDecoder =
+    D.map2 TargetedPointerEvent
+        Pointer.eventDecoder
+        (D.at ["target", "id"] D.string)
+
+targetFor : String ->  DragTarget
+targetFor s =
+    case s of
+        "left-marker" -> StartMark
+        "right-marker" -> EndMark
+        _ -> NoTarget
+
+onDownWithTarget tag =
+    let
+        decoder =
+            targetedEventDecoder
+                |> D.map tag
+                |> D.map options
+
+        options message =
+            { message = message
+            , stopPropagation = True
+            , preventDefault = True
+            }
+        in
+        Html.Events.custom "pointerdown" decoder
+
+
+
+timeAxis model points =
     let graphHeight = 30
         startTime = Maybe.withDefault 0 (Point.startTime points)
         maxX = Point.duration points
@@ -467,15 +510,23 @@ timeAxis points =
                 , H.id "right-marker"
                 , strokeWidth "3"
                 ] []
+        markStartPix = case model.markedTime of
+                           (s, d) ->
+                               floor ((s - startTime) * portalWidth/maxX)
+        markEndPix = case model.markedTime of
+                           (s, d) ->
+                               ceiling ((s - startTime + d) * portalWidth/maxX)
+        epos e = Tuple.mapBoth floor floor e.pointer.clientPos
+
     in
         svg
         [ width portalWidth
         , height (graphHeight + 20)
-        , on "pointerdown" timeClickDecoder
+        , onDownWithTarget (\e -> DragStart (targetFor e.targetId) (epos e.pointerEvent))
         , viewBox ("0 -10 " ++ (String.fromInt portalWidth) ++
                        "  " ++ (String.fromInt (graphHeight + 10)))
         ]
-        (bg::(markStart 22)::(markEnd 422)::xticks)
+        (bg::(markStart markStartPix)::(markEnd markEndPix)::xticks)
 
 
 cadenceView : List Point -> Svg Msg
@@ -529,9 +580,9 @@ ifTrack model content =
     case model.track of
         Present t ->
             let (dt, _) = dragDelta Graph model.drag
-                dpix = dt * model.duration // portalWidth
-                start = toFloat (model.startTime + dpix)
-                points = Point.subseq t start (toFloat model.duration) |>
+                dpix = toFloat dt * model.duration / portalWidth
+                start = model.startTime +  dpix
+                points = Point.subseq t start model.duration |>
                          Point.downsample 300
             in  content points
         Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f])
@@ -617,10 +668,10 @@ viewDiv model =
             [ div [] [ ifTrack model cadenceView ]
             , div [] [ ifTrack model powerView ]
             , div [] [ ifTrack model eleView ]
-            , div [] [ ifTrack model timeAxis ]
+            , div [] [ ifTrack model (timeAxis model) ]
             ]
         ]
 
 view : Model -> Browser.Document Msg
 view model =
-    Browser.Document  "Souplesse elm" [  (viewDiv model) ]
+    Browser.Document  "Souplesse" [  (viewDiv model) ]

frontend/src/Point.elm

@@ -38,10 +38,9 @@ last x xs =
         [] -> x
         (x_::xs_) -> last x_ xs_
 
-tracef x = Debug.log (String.fromFloat x) x
-
 -- divide the points into n equal time buckets and return the first
 -- point in each
+downsample : Int -> List Point -> List Point
 downsample n points =
     let
         nextpoint step prev points_ =
@@ -58,14 +57,16 @@ downsample n points =
                 in nextpoint step first rest
             [] -> []
 
+duration : List Point -> Float
 duration points =
     case points of
         (p::ps) -> (last p ps).time - p.time
         _ -> 0
 
+startTime : List Point -> Maybe Float
 startTime points =
     case points of
-        (p::ps) -> Just p.time
+        (p::_) -> Just p.time
         _ -> Nothing
 
 type Bound = Bound Pos Pos | NoBound
@@ -81,9 +82,11 @@ extendBound pos b =
            NoBound ->
                Bound pos pos
 
+bounds : List Point -> Bound
 bounds points =
     List.foldr extendBound NoBound (List.map .pos points)
 
+centre : List Point -> Pos
 centre points =
     case bounds points of
         Bound min max -> Pos
@@ -92,6 +95,7 @@ centre points =
                              Nothing
         NoBound -> Pos 0 0 Nothing
 
+subseq : List Point -> Float -> Float -> List Point
 subseq points start dur =
     case points of
         [] -> []