SuaveActivePatterns.fsx

#r "packages/Suave/lib/net40/Suave.dll"

open System
open Suave
open Suave.Filters
open Suave.Successful
open Suave.RequestErrors
open System.Text.RegularExpressions

[<AutoOpen>]
module Utils =
    let (|RegexMatch|_|) pattern input =
        let matches = Regex.Match(input, pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase)
        if matches.Success
        then Some matches.Groups
        else None

[<AutoOpen>]
module Routes =
    let (|ProjectDetail|_|) path =
        match path with
        | RegexMatch "/project/([0-9A-F]{8}[-]([0-9A-F]{4}[-]){3}[0-9A-F]{12})$" groups ->
            match Guid.TryParse(groups.[1].Value) with
            | (true, g) -> Some g
            | _ -> None
        | _ -> None

    let (|Issue|_|) path =
        match path with
        | RegexMatch "/project/([0-9A-F]{8}[-]([0-9A-F]{4}[-]){3}[0-9A-F]{12})/issue/([0-9]{1,10})$" groups ->
            printfn "Issue groups: %A" groups
            match Guid.TryParse(groups.[1].Value),Int32.TryParse(groups.[3].Value) with
            | ((true, g),(true, i)) ->
                printfn "Issue groups: %A" g
                Some (g,i)
            | _ -> None
        | _ -> None

[<AutoOpen>]
module WebParts =
    let issue projectId issueId : WebPart =
        OK(sprintf "Pid: %A, IssueId: %A" projectId issueId)

    let project projectId : WebPart =
        OK(sprintf "Pid: %A" projectId)

[<AutoOpen>]
module Routing =
    let activePatternRouting : WebPart =
        let f (r:HttpContext) =
            match r.request.url.AbsolutePath with
            | Routes.Issue (g,i) -> issue g i r
            | Routes.ProjectDetail g -> project g r
            | _ -> fail
        f

let testapp : WebPart =
  choose
    [ pathScan "/add/%d/%d" (fun (a,b) -> OK((a + b).ToString()))
      activePatternRouting
      NOT_FOUND "Found no handlers" ]

startWebServer defaultConfig testapp