blunt-url-parser.fsx

#r "nuget: TheBlunt"

open TheBlunt

module Common =
    let RequiedMark =
      pchar
        (fun c -> c = '!')
        (fun c -> $"$%c{c} is not a valid required mark.")

    let HashMarker =
      pchar
        (fun c -> c = '#')
        (fun c -> $"$%c{c} is not a valid hash marker.")

    let QuerySeparator =
      pchar
        (fun c -> c = '&')
        (fun c -> $"$%c{c} is not a valid query separator.")

    let SegmentSeparator =
      pchar
        (fun c -> c = '/')
        (fun c -> $"$%c{c} is not a valid segment separator.")

    let ParamMarker =
      pchar
        (fun c -> c = ':')
        (fun c -> $"$%c{c} is not a valid parameter marker.")

    let QueryMarker =
      pchar
        (fun c -> c = '?')
        (fun c -> $"$%c{c} is not a valid query marker.")

module UrlTemplate =

    [<Struct>]
    type TypedParam =
        | String
        | Int
        | Float
        | Bool
        | Guid
        | Long
        | Decimal

    [<Struct>]
    type TemplateSegment =
        | Plain of string
        | ParamSegment of name: string * tipe: TypedParam

    [<Struct>]
    type QueryKey =
        | Required of reqName: string * reqTipe: TypedParam
        | Optional of name: string * tipe: TypedParam

    [<Struct>]
    type TemplateComponent =
        | Segment of segment: TemplateSegment
        | Query of query: QueryKey list
        | Hash of hash: string voption

    [<Struct>]
    type UrlTemplate = {
        Segments: TemplateSegment list
        Query: QueryKey list
        Hash: string voption
    }

    module Primitives =
        let intParam =
            pchoice [ pstr "<int>"; pstr "<integer>" ]
            |> map(fun _ -> TypedParam.Int)

        let floatParam =
            pchoice [ pstr "<float>"; pstr "<number>" ]
            |> map(fun _ -> TypedParam.Float)

        let boolParam =
            pchoice [ pstr "<bool>"; pstr "<boolean>" ]
            |> map(fun _ -> TypedParam.Bool)

        let guidParam =
            pstr "<guid>" |> map(fun _ -> TypedParam.Guid)

        let longParam =
            pstr "<long>" |> map(fun _ -> TypedParam.Long)

        let decimalParam =
            pstr "<decimal>" |> map(fun _ -> TypedParam.Decimal)

        let typed =
            pchoice [
                intParam
                floatParam
                boolParam
                guidParam
                longParam
                decimalParam
            ]

    let plainSegment =
        let delimiter =
            pchoice [
                Common.SegmentSeparator
                Common.HashMarker
                Common.QueryMarker
            ]

        (pstringUntil delimiter) |> map(fun s -> Plain s)

    let paramSegment = parse {
        let delimiter =
            pchoice [
                Common.SegmentSeparator
                Common.HashMarker
                Common.QueryMarker
            ]

        let! value =
            Common.ParamMarker |> andThen(pstringUntil delimiter)

        let! tipe = ptry Primitives.typed

        match tipe.result with
        | Some tipe ->
            return
                tipe |> PVal.map(fun t -> ParamSegment(snd value.result, t))
        | None ->
            return
                value
                |> PVal.map(fun value ->ParamSegment(snd value, TypedParam.String))
    }


    let segments = parse {

        let! _ = ptry Common.SegmentSeparator

        let! segments =
            psepBy1
                Common.SegmentSeparator
                (pchoice [ paramSegment; plainSegment ])

        let! lastSegment = pchoice [ paramSegment; plainSegment ]

        let r: PVal<_> = {
            range = Range.merge [ segments.range; lastSegment.range ]
            result = [
                yield! segments.result |> List.map(fun pval -> pval.result)
                lastSegment.result
            ]
            }

        return r
    }

    let queryKey = parse {
        let! identifier = letter
        let! tipe = ptry Primitives.typed
        let! required = ptry Common.RequiedMark

        let tipe =
            match tipe.result with
            | Some tipe -> tipe.result
            | None -> TypedParam.String

        match required.result with
        | Some _ ->
            return identifier |> PVal.map(fun i -> Required(i, tipe))
        | None ->
            return identifier |> PVal.map(fun i -> Optional(i, tipe))
    }

    let Parse = parse {
        let! segments = segments

        let! query =
            ptry(
                parse {
                let! _ = Common.QueryMarker

                let! query = psepBy1 Common.QuerySeparator queryKey

                return query
                }
            )

        let! hash =
            ptry(
                Common.HashMarker
                |> andThen(pstringUntil eoi)
                |> map snd
            )

        let _segments = segments.result

        let _queryKeys =
            match query.result with
            | Some q -> q.result |> List.map(fun pval -> pval.result)
            | None -> []

        let _hash =
            match hash.result with
            | Some h -> h.result |> ValueSome
            | None -> ValueNone

        let returnValue: PVal<UrlTemplate> = {
            range = Range.merge [ segments.range; query.range; hash.range ]
            result = {
                Segments = _segments
                Query = _queryKeys
                Hash = _hash
            }
            }

        return returnValue
    }



let tpl = "/segment1/segment2/segment3/"
let tpl2 = "segment1/segment2/segment3"

match run tpl UrlTemplate.Parse with
| POk { range = range; result = result } ->
    printfn "%A" result.Segments
| PError err -> eprintfn "%s" err.message

match run tpl2 UrlTemplate.Parse with
| POk { range = range; result = result } ->
    printfn "%A" result.Segments

| PError err -> eprintfn "%s" err.message

// [Plain "segment1"; Plain "segment2"; Plain "segment3"; Plain ""]
// [Plain "segment1"; Plain "segment2"; Plain ""]
// Press any key to continue . . .