Skip to content

Instantly share code, notes, and snippets.

@AngelMunoz
Created November 15, 2023 15:16
Show Gist options
  • Save AngelMunoz/0a5e38c96efa2102ac63b990878ac9c4 to your computer and use it in GitHub Desktop.
Save AngelMunoz/0a5e38c96efa2102ac63b990878ac9c4 to your computer and use it in GitHub Desktop.
#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 . . .
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment