links for uservoice post

ideas.fs

/// assumes that this is a 'time' html element
let time (el : IWebElement) = el |> attr "datetime" |> DateTime.Parse

/// used to find things that can be turned into markdown links
let markdownLinkRegex = Regex("(\/ideas\/(\S+))\s*")

/// attempts to rewrite all urls to uservoice to map to the matching issue document on github.
let rewriteUrls (text : string) =
    // simple match and replace
    let urls = [
        "https://fslang.uservoice.com/forums/245727-f-language/suggestions/"
        "http://fslang.uservoice.com/forums/245727-f-language/suggestions/"
    ] 
    let rewritten = urls |> List.fold (fun (s:string) url -> s.Replace(url, "/archive/suggestion-")) text
    
    // now rewrite things into markdown link syntax : [XXX](YYY)
    match markdownLinkRegex.Matches(rewritten) with
    | m when m.Count = 0 -> rewritten 
    | m -> 
        m 
        |> Seq.cast<Match>
        |> Seq.fold (fun s m' -> 
            // rewrite the /ideas/suggestion string to [name of link](/ideas/suggestion-XXXX)
            let whole = m'.Groups.[0].Value.Trim()
            let file = m'.Groups.[1].Value.Trim()
            s.Replace(whole, sprintf "[%s](%s.md)" whole file)
         ) rewritten        

/// this is a recursive call because the comments themselves are paged and so we need to be able to 
/// concat a list of comments across pages that we visit
let rec parseCommentsFromPage address = 
    let parseComment pos (el :IWebElement) : Comment =
        let submitter = el |> elementWithin "span" |> read
        let submitted = el |> elementWithin "time" |> read |> DateTime.Parse
        let content = el |> elementWithin "div.typeset" |> read
        {Submitter = submitter; Submitted = submitted; Content = content |> rewriteUrls }

    url address
    let commentBlocks = unreliableElements ".uvIdeaComments li.uvListItem" |> List.mapi parseComment
    match someElement "a.next_page" |> Option.map href with
    | None -> commentBlocks
    | Some page -> commentBlocks @ parseCommentsFromPage page

/// this is mostly just a lot of pulling out individual fields by accessor classes
let parseIdeaFromPage pos address : Choice<Idea,string> =
    url address
    printfn "parsing idea %d: %s" pos address
    try
        let voteCount = element "div.uvIdeaVoteCount" 
        let number = voteCount |> attr "data-id"
        let votes = voteCount |> elementWithin "strong" |> read |> Int32.Parse
        let title = element "h1.uvIdeaTitle" |> read
        let submitter = element "div.uvUserActionHeader span.fn" |> read 
        
        // the text of a comment can have uservoice links, so lets rewrite those to refer to relative urls so that links in 
        // the new github issues are valid still! 
        let text = defaultArg (someElement "div.uvIdeaDescription div.typeset" |> Option.map (read >> rewriteUrls)) ""
        let submitted = element "section.uvIdeaSuggestors div.uvUserAction div.uvUserActionHeader span time" |> time
        
        let comments = parseCommentsFromPage address |> List.rev
        let state = 
            someElement "span.uvStyle-status" 
            |> Option.map (fun el ->((attr "class" el)
                                        .Split([|' '|], StringSplitOptions.RemoveEmptyEntries) |> Array.last)
                                        .Substring "uvStyle-status-".Length)

        let response = 
            let responded = someElement "article.uvUserAction-admin-response time" |> Option.map time 
            // likewise, responses can have links that need rewritten
            let text = someElement "article.uvUserAction-admin-response .typeset" |> Option.map (read >> rewriteUrls)
            match responded, text with
            | Some r, Some t -> { Responded = r; Text = t; Exists = true }
            | _, _ -> {Exists = false; Responded = DateTime.MinValue; Text = ""}


        { Number = number
          Submitter = submitter
          Submitted = submitted
          Title = title
          Votes = votes
          Text = text
          Comments = comments
          Status = defaultArg state "open"
          Response = response } : Idea |> Choice1Of2
    with
    | ex -> Choice2Of2 <| sprintf "error accessing %s: %s" address (ex.Message)

links.fs

// get a link from an element
let href = attr "href"
let userVoiceItemClass = ".uvIdeaTitle a" // ideas are an anchor inside the uvIdeaTitle
// this is the link to the next page, if there is one
let nextpageClass = "a.next_page"
let discoverIdeas () = 
    let rec parseUrlsFromPage address =
        // navigate to the address 
        url address
        // all the links from the elements that match the uservoice item matcher
        let pageItemLinks = elements userVoiceItemClass |> List.map href

        // if there is a next button, traverse it and collect the links from the next page
        match someElement nextpageClass |> Option.map href with
        | None -> pageItemLinks
        | Some next -> pageItemLinks @ parseUrlsFromPage next

    let pages = 
        [
            "https://fslang.uservoice.com/forums/245727-f-language"
            "https://fslang.uservoice.com/forums/245727-f-language/status/1225913"
            "https://fslang.uservoice.com/forums/245727-f-language/status/1225914"
            "https://fslang.uservoice.com/forums/245727-f-language/status/1225915"
            "https://fslang.uservoice.com/forums/245727-f-language/status/1225916"
            "https://fslang.uservoice.com/forums/245727-f-language/status/1225917"
        ]

    pages |> List.collect parseUrlsFromPage |> List.distinct

model.fs

type Comment = 
    {   Submitter : string
        Submitted : DateTime
        Content : string }
    
type Response = 
    {   Responded : DateTime
        Text : string
        Exists : bool }

type Idea = 
    {   Number : string
        Submitter : string
        Submitted : DateTime
        Title : string
        Text : string
        Votes : int32
        Comments : Comment list
        Status : string 
        Response : Response } 

template.fs

module FslangMigration.Templating

open DotLiquid
open FSharp.Reflection
open System.IO
open System.Text.RegularExpressions
open System.Collections.Generic

// we want to store type registrations in DotLiquid so that we don't have to recompute them
let registrations = Dictionary<_,_>()

let parseTemplate<'T> template =
    // walk types and register them
    let rec registerTypeTree ty =
        if registrations.ContainsKey ty then ()
        elif FSharpType.IsRecord ty then
            // register all the fields of the record
            let fields = FSharpType.GetRecordFields ty
            Template.RegisterSafeType(ty, [| for f in fields -> f.Name |])
            registrations.[ty] <- true
            for f in fields do registerTypeTree f.PropertyType
        elif ty.IsGenericType then
            // certain generic types have to be handled differently
            let t = ty.GetGenericTypeDefinition()
            if t = typedefof<seq<_>> || t = typedefof<list<_>>  then
                // collections are supported and just need the inner items type registered
                registrations.[ty] <- true
                registerTypeTree (ty.GetGenericArguments().[0])     
            elif t = typedefof<option<_>> then
                // for option, we manually register some properties
                Template.RegisterSafeType(ty, [|"Value"; "IsSome"; "IsNone";|])
                registrations.[ty] <- true
                // and then the inner type
                registerTypeTree (ty.GetGenericArguments().[0])
            elif ty.IsArray then          
                registrations.[ty] <- true
                // arrays just have a shortcut due to the .Net reflection API
                registerTypeTree (ty.GetElementType())
        else ()
    
    // register the model type
    registerTypeTree typeof<'T>
    // parse the template
    let t = Template.Parse template
    // given an label name and an instance of the model, render the template with a dictionary made of all of the properties of the model
    fun k (v:'T) -> t.Render(Hash.FromDictionary(dict [k, box v]))


Template.NamingConvention <- NamingConventions.CSharpNamingConvention()

//host the templates from the file system
let templatedir = Path.GetFullPath "../templates/"
let fs = DotLiquid.FileSystems.LocalFileSystem templatedir
Template.FileSystem <- fs :> DotLiquid.FileSystems.IFileSystem

// this helper functions ensures that we can never use the wrong template for the wrong model type
let templateFor<'a> file variableName = parseTemplate<'a> (File.ReadAllText(Path.Combine(templatedir, file))) variableName

let archiveTemplate    = templateFor<Idea>     "_idea_archive.liquid"    "idea"
let submissionTemplate = templateFor<Idea>     "_idea_submission.liquid" "idea"