Skip to content

Instantly share code, notes, and snippets.

@AngelMunoz
Last active October 26, 2023 21:28
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save AngelMunoz/c36746141c2801b742f7f30eefa484a0 to your computer and use it in GitHub Desktop.
Save AngelMunoz/c36746141c2801b742f7f30eefa484a0 to your computer and use it in GitHub Desktop.
Parse the segments + query + hash from a url with fparsec
namespace Routerish
type QueryValue =
| String of string option
| StringValues of string list
type RoutePart =
| Segment of segment: string
| ParamSegment of paramname: string
| Query of query: Map<string, QueryValue>
| Hash of hash: string
module UrlParser =
open FParsec
let segmentSeparator: Parser<char, unit> = pchar '/'
let paramStart: Parser<char, unit> = pchar ':'
let queryStart: Parser<char, unit> = pchar '?'
let queryDelimiter: Parser<char, unit> = pchar '&'
let hashStart: Parser<char, unit> = pchar '#'
let segment =
sepEndBy (manyChars (noneOf [ '/'; '#'; '?' ])) segmentSeparator
>>= (fun value ->
value
|> List.map (fun s ->
if s.StartsWith(':') then
ParamSegment(s.TrimStart(':'))
else
Segment(s))
|> preturn)
let hash = manyChars anyChar >>= (fun content -> Hash(content) |> preturn)
let query =
let queryKv =
let separator = pchar '='
let key = manyChars (noneOf [ '='; '&'; '#' ])
let value = manyChars (noneOf [ '='; '&'; '#' ])
key .>> opt separator .>>. opt value
let addOrUpdate (nextValue: string option) existing =
match existing with
| Some(String a) -> Some(StringValues [ nextValue |> Option.defaultValue ""; a |> Option.defaultValue "" ])
| Some(StringValues values) -> Some(StringValues((nextValue |> Option.defaultValue "") :: values))
| None -> Some(String nextValue)
let tupleListToMap current (nextKey: string, nextValue: string option) =
Map.change nextKey (addOrUpdate nextValue) current
sepEndBy queryKv queryDelimiter
>>= (fun values -> values |> List.fold tupleListToMap Map.empty |> Query |> preturn)
let urlParser =
segment .>>. opt (queryStart >>. query) .>>. opt (hashStart >>. hash) .>> eof
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment