2
\$\begingroup\$

The purpose

This code is intended to achieve the following goals:-

  1. Create a hard coded list of lifts, this is pretty static and I add some extra info so I'm ok with this being in the code but I may move it to configuration or an external store eventually
  2. Every minute (or so) hit the source data URL, grab the current lift status (open/closed etc.) and parse this into a list of statuses
  3. These are both exposed as JSON to the consuming client (not important for this question)

The Code

The types are actually defined in a different file but I've included them here for completeness

[<RequireQualifiedAccess>]
module Lift

open System
open Shared
open FSharp.Data

type LiftWaitStatus =
    | Unknown
    | Standby
    | Closed
    | OpenLight
    | OpenModerate
    | OpenBusy

type LiftId = LiftId of int
type LiftStatus = { Id: LiftId; Status: LiftWaitStatus }

type Mountain =
    | Whistler
    | Blackcomb

type Zone =
    | Alpine
    | Mid
    | Lower

type Lift =
    { Id: LiftId
      Name: string
      Description: string
      Mountain: Mountain
      Zone: Zone }

type LiftStatusData =
    {
        Updated: DateTime
        Retrieved: DateTime
        LiftStatus: LiftStatus list
    }

type private LiftsParser =
    XmlProvider<"""
        <Lifts updated="11/7/2020 3:30:02 PM" friendlyupdated="0 seconds ago">
            <Lift mountain="Blackcomb" LiftGUID="4a4157c0-f1e1-4d95-a840-cb959efcc975" name="7TH HEAVEN EXPRESS" status="CLOSED" speed="4.0 " avgspeed="0" waitstatusid="1" waitstatus="Closed"/>
            <Lift mountain="Blackcomb" LiftGUID="4a4157c0-f1e1-4d95-a840-cb959efcc975" name="7TH HEAVEN EXPRESS" status="CLOSED" speed="4.0 " avgspeed="0" waitstatusid="1" waitstatus="Closed"/>
        </Lifts>
        """>

let private liftTupleList =
    [ ("4a4157c0-f1e1-4d95-a840-cb959efcc975",
       { Id = LiftId 1
         Name = "7TH HEAVEN EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Alpine })
      ("e8db6408-376f-4c9a-89d9-7d7cc9c500b5",
       { Id = LiftId 2
         Name = "BLACKCOMB GONDOLA LOWER"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Lower })
      ("cb82026c-e3b7-4782-b5a8-c45fbaf6f439",
       { Id = LiftId 3
         Name = "BLACKCOMB GONDOLA UPPER"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("0bc8f36c-79dd-4035-81ab-e41be4f58152",
       { Id = LiftId 4
         Name = "BUBLY TUBE PARK"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Lower })

      ("1a1e82e3-26d5-488a-a546-ed513492bf6e",
       { Id = LiftId 5
         Name = "CATSKINNER EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("6ed60572-949e-40db-8c22-a8df18c69b84",
       { Id = LiftId 6
         Name = "CRYSTAL RIDGE EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("d05ea9b3-ab0a-4d93-b5da-5aa78f43ebae",
       { Id = LiftId 7
         Name = "EXCALIBUR GONDOLA LOWER"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Lower })
      ("3a317473-b348-4ec4-b169-c8f33312ad90",
       { Id = LiftId 8
         Name = "EXCALIBUR GONDOLA UPPER"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("76500489-17d3-407f-aaf3-9087399679ca",
       { Id = LiftId 9
         Name = "EXCELERATOR EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("d0ca0064-dee3-4e37-b1b5-708620dfdd3a",
       { Id = LiftId 10
         Name = "GLACIER EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Alpine })
      ("5294ad7e-de3e-4603-85f7-b7f0278b897e",
       { Id = LiftId 11
         Name = "HORSTMAN T-BAR"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Alpine })
      ("fb90ee2a-1b16-416d-9465-e583ed08a780",
       { Id = LiftId 12
         Name = "JERSEY CREAM EXPRESS"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("5fdea1f9-5f6d-450c-89c9-f2405e836453",
       { Id = LiftId 13
         Name = "MAGIC CHAIR"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Lower })
      ("0d17ed7a-9f68-4f7e-b2e2-3ab0c00e5dae",
       { Id = LiftId 14
         Name = "PEAK 2 PEAK GONDOLA"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Mid })
      ("d6ad2cea-6c0e-46ee-b7e9-e60ecd962dd6",
       { Id = LiftId 15
         Name = "SHOWCASE T-BAR"
         Description = ""
         Mountain = Mountain.Blackcomb
         Zone = Zone.Alpine })
      ("98483412-6cc6-4f33-8d05-51f5ff6cfd2b",
       { Id = LiftId 16
         Name = "BIG RED EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("a7814da5-bf59-4a32-aad5-2e2c496e973f",
       { Id = LiftId 17
         Name = "CREEKSIDE GONDOLA"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Lower })
      ("47483edb-e1d1-4f0b-a5b8-62f5d62b5a4b",
       { Id = LiftId 18
         Name = "EMERALD 6 EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("6d5ebeaa-576c-402d-884f-714a5e81c6d2",
       { Id = LiftId 19
         Name = "FITZSIMMONS EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Lower })
      ("b5b974b1-7b0a-483b-8154-6c42c5c8037a",
       { Id = LiftId 20
         Name = "FRANZ's CHAIR"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("17057ede-86b5-4e60-b237-48fd16e35c7b",
       { Id = LiftId 21
         Name = "GARBANZO EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("c64ed3f5-d917-4539-a28c-9c362c2b333c",
       { Id = LiftId 22
         Name = "HARMONY 6 EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Alpine })
      ("fe9101f2-c027-455e-b279-4009a15f5a8d",
       { Id = LiftId 23
         Name = "OLYMPIC CHAIR"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("0d17ed7a-9f68-4f7e-b2e2-3ab0c00e5dae",
       { Id = LiftId 24
         Name = "PEAK 2 PEAK GONDOLA"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid })
      ("8c135d30-4f19-4302-af1e-6ee19b99a831",
       { Id = LiftId 25
         Name = "SYMPHONY EXPRESS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Alpine })
      ("8180cf9e-de25-46e1-84d6-211577996d7b",
       { Id = LiftId 26
         Name = "T-BARS"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Alpine })
      ("1cf82fab-2841-4d28-b37e-83e76a2c30d9",
       { Id = LiftId 27
         Name = "WHISTLER VILLAGE GONDOLA LOWER"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Lower })
      ("fae022ea-afdb-45ab-9a05-dbb7c3b74bac",
       { Id = LiftId 28
         Name = "WHISTLER VILLAGE GONDOLA UPPER"
         Description = ""
         Mountain = Mountain.Whistler
         Zone = Zone.Mid }) ]

let private liftMap = Map.ofList liftTupleList
let liftList = liftMap |> Map.toList |> List.map snd

let private parseStatus html retrieved =
    let liftsXml = LiftsParser.Parse(html)
    let lifts = liftsXml.Lifts |> Array.toList
    let updated = liftsXml.Updated

    let liftStatusList =
        lifts
        |> List.choose
            (fun l ->
                let status =
                    match l.Waitstatusid with
                    | 1 -> LiftWaitStatus.Closed
                    | 2 -> LiftWaitStatus.OpenLight
                    | 3 -> LiftWaitStatus.OpenModerate
                    | 4 -> LiftWaitStatus.OpenBusy
                    | 5 -> LiftWaitStatus.Standby
                    | _ -> LiftWaitStatus.Unknown

                let guid = l.LiftGuid.ToString()

                match liftMap.TryFind(guid) with
                | Some x -> Some { Id = x.Id; Status = status }
                | None -> None)

    { Updated = updated
      Retrieved = retrieved
      LiftStatus = liftStatusList }

let private fetchStatus =
    async {
        let url =
            "https://secure.whistlerblackcomb.com/ls/lifts.aspx"

        let result =
            Web.fetchAsync url |> Async.RunSynchronously

        let retrieved = DateTime.UtcNow
        printfn $"Grabbed {url} at {retrieved}"

        return
            match result with
            | Result.Ok html -> Ok(parseStatus html retrieved)
            | Result.Error error ->
                let msg =
                    $"Fetching URL {url} failed with {error}"

                Result.Error(msg)
    }

let mutable private liftStatusData =
    { Updated = DateTime.UtcNow
      Retrieved = DateTime.UtcNow
      LiftStatus = [] }

let liftStatus () = liftStatusData

let rec loop () =
    async {
        let! result = fetchStatus
        liftStatusData <-
            match result with
            | Result.Ok data -> data
            | Result.Error _ -> liftStatusData
        do! Async.Sleep(TimeSpan.FromSeconds(65.0))
        return! loop ()
    }

Questions

I'm learning F# so I'd love any feedback on how idiomatic this is and what I could do to improve it.

My particular areas I'm not so happy with are :-

  1. I have a mutable variable, I'd be interested in how I could avoid this
  2. The way I construct the liftTupleList, liftMap and liftList feels a little clunky
  3. I'm not super happy with my loop function, I feel like there should be a better approach to this but I'm not sure what?
\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.