open FParsec

type UserState =
{
    ArgsParsed : int
}

type Parser<'t> = Parser<'t, UserState>

let (<!>) (p: Parser<_,_>) label : Parser<_,_> =
    fun stream ->
        printfn "%A: Entering %s" stream.Position label
        let reply = p stream
        printfn "%A: Leaving %s (%A)" stream.Position label reply.Status
        reply

let pIp4Address : Parser<_> =
    regex "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"

let pIp6Address : Parser<_> =
    pipe4
        (pstring "0:0:0:0:0:")
        (pstring "0" <|> pstring "FFFF")
        (pstring ":")
        pIp4Address
        (fun a b c d -> a + b + c + d)
    <|> regex @"[0-9A-F]+(?:\:[0-9A-F]+){7}"

let pShortName : Parser<_> =
    regex @"[A-z0-9](?:[A-z0-9\-]+(?<!-))?"

let pHostAddr =
    pIp4Address <|> pIp6Address

let pHostName : Parser<_> =
    stringsSepBy1 pShortName (pstring ".")

let pHost : Parser<_> =
    pHostName <|> pHostAddr

let pServerName : Parser<_> = pHostName

let pUser : Parser<_> =
    many1Chars (noneOf ['\000'; '\r'; '\n'; ' '; '@']) <!> "pUser"

let pConnection : Parser<_> =
    pchar '%'
    >>. pHost <!> "pConnection"

let pDestination : Parser<_> =
    pchar '@'
    >>. pServerName <!> "pDestination"

let pUserConnectionAndDestination : Parser<_> =
    pipe3
        pUser
        pConnection
        pDestination
        (fun user connectedFrom server ->
            (user, Some connectedFrom, Some server))

(*
  The below fails with:
  (Ln: 1, Col: 1): Entering pUser
  (Ln: 1, Col: 28): Leaving pUser (Ok)
  (Ln: 1, Col: 28): Entering pConnection
  (Ln: 1, Col: 28): Leaving pConnection (Error)
  val it : ParserResult<Destination,UserState> =
    Failure:
  Error in Ln: 1 Col: 28
  kalt%millennium.stealth.net@irc.stealth.net
                             ^
  Expecting: any char not in ‘  @’ or '%'
*)
runParserOnString pUserConnectionAndDestination { ArgsParsed = 0 } "" @"kalt%millennium.stealth.net@irc.stealth.net"