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?
Improve this question
\$\endgroup\$

0

Reset to default

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Browse other questions tagged or ask your own question.