#!/bin/tclsh

namespace eval ::irc {
  proc ::irc::is {type value {cap {}}} {
    # validation helper.
    # cap is a list of negotiated capabilities.
    switch -- $type {
      command { regexp {^([a-zA-Z]+|[0-9]{3})$} $value }
      command::named { regexp {^[a-zA-Z]+$} $value }
      command::numeric { regexp {^[0-9]{3}$} $value }

      tags { regexp {^\+?([^\r\n\0 ;/]/)?[a-zA-Z0-9\-]+(=[^\r\n\0; ]*)?(;\+?([^\r\n\0 ;/]/)?[a-zA-Z0-9\-]+(=[^\r\n\0; ]*)?)*$} $value }
      tags::tag { regexp {^\+?([^\r\n\0 ;/]/)?[a-zA-Z0-9\-]+(=[^\r\n\0; ]*)?$} $value }
      tags::key { regexp {^\+?([^\r\n\0 ;/]/)?[a-zA-Z0-9\-]+$} $value }
      tags::value { regexp {^[^\r\n\0; ]*$} $value }

      misc::dict { expr {![string is list $value] || [llength $value] % 2 == 1}}

      default { return -code error "unknown subcommand \"$subcommand\": must be command(|::named|::numeric), tags(|::tag|::key|::value), or misc::dict" }
    }
  }

  proc ::irc::esc {type value} {
    # for escaping specific things
    switch -- $type {
      tags::value {
        string map {"\\"  "\\\\"
                    "\n" {\n}
                    "\r" {\r}
                    {;}  {\:}
                    { }  {\s}} $value
      }

      default { return -code error "unknown subcommand \"$subcommand\": must be tags::value" }
    }
  }

  proc ::irc::unesc {type value} {
    # for unescaping specific things
    # needs to be handled manually due to Quirkiness
    switch -- $type {
      tags::value {
        set ret ""
        set backslash false
        foreach char [split $value ""] {
          if !$backslash {
            if {$char == "\\"} {
              set backslash true
            } else {
              set ret [string cat $ret $char]
            }
          } else {
            switch $char {
              n { set ret [string cat $ret "\n"] }
              r { set ret [string cat $ret "\r"] }
              : { set ret [string cat $ret ";"] }
              s { set ret [string cat $ret " "] }

              # covers backslash too
              default { set ret [string cat $ret $char] }
            }
            set backslash false
          }
        }

        return $ret
      }

      default { return -code error "unknown subcommand \"$subcommand\": must be tags::value" }
    }
  }

  proc ::irc::connect {hostname port {usetls 1}} {
    if $usetls {
      if {[info commands ::tls::socket] == ""} { package require tls }
      ::tls::socket $hostname $port
    } else {
      socket hostname port
    }
  }

  proc ::irc::tags {subcommand args} {
    switch -- $subcommand {
      exists {
        if {[llength $args] != 2} { return -code error "wrong # args: should be \"irc::tags exists tags key\"" }
        set tags [lindex $args 0]
        set key [lindex $args 1]

        foreach tag [split $tags ";"] {
          if { ![string first "$key=" $tag] || $tag == $key } { return true }
        }
        return false
      }
      remove {
        if {[llength $args] != 2} { return -code error "wrong # args: should be \"irc::tags remove tags key\"" }
        set tags [lindex $args 0]
        set ret ""
        set key [lindex $args 1]

        foreach tag [split $tags ";"] {
          if { [string first "$key=" $tag] && $tag != $key } {
            set ret [string cat $ret $tag ";"]
          }
        }

        string range $ret 0 end-1
      }
      get {
        if {[llength $args] ni {1 2}} { return -code error "wrong # args: should be \"irc::tags get tags ?key?\"" }
        set tags [lindex $args 0]
        set key [if {[llength $args] == 2} {lindex $args 1}]

        if {$key == ""} {
          set ret ""
          foreach tag [split $tags ";"] {
            set split [string first = $tag]
            set key [string range $tag 0 $split-1]
            set value [::irc::unesc tags::value [string range $tag $split+1 end]]
            lappend ret [list $key $value]
          }
          return $ret
        }

        foreach tag [split $tags ";"] {
          if {![string first "$key=" $tag]} {
            return [::irc::unesc tags::value [string range $tag [string first = $tag]+1 end]]
          } elseif { $tag == $key } { return "" }
        }

        return -code error "key \"$key\" not known in tags"
      }
      set {
        if {[llength $args] ni {2 3}} { return -code error "wrong # args: should be \"irc::tags set tags key ?value?\"" }
        set tags [lindex $args 0]
        set ret ""
        set key [lindex $args 1]
        set value [if {[llength $args] == 3} { lindex $args 2 }]
        set found false

        foreach tag [split $tags ";"] {
          if { !$found && ![string first "$key=" $tag] || $tag == $key } {
            if {$value != ""} {
              set ret [string cat $ret $key = [::irc::esc tags::value $value] ";"]
            } else {
              set ret [string cat $ret $key ";"]
            }
            set found true
          } else {
            set ret [string cat $ret $tag ";"]
          }
        }

        if !$found {
          if {$value != ""} {
            set ret [string cat $ret $key = [::irc::esc tags::value $value] ";"]
          } else {
            set ret [string cat $ret $key ";"]
          }
        }

        string range $ret 0 end-1
      }

      create {
        set ret ""
        dict for {key value} $args {
          set ret [::irc::tags set $ret $key $value]
        }
        return $ret
      }
      merge {
        set ret ""

        foreach tags $args {
          if [::irc::is tags $tags] {
            foreach tag [split $tags ";"] {
              set split [string first = $tag]
              set key [string range $tag 0 $split-1]
              set value [::irc::unesc tags::value [string range $tag $split+1 end]]
              set ret [::irc::tags set $ret $key $value]
            }
          } elseif [::irc::is misc::dict $tags] {
            dict for {key value} $tags {
              set ret [::irc::tags set $ret $key $value]
            }
          } else {
            return -code error "argument is not tags or a dict"
          }
        }
        return $ret
      }
      dict {
        if {[llength $args] != 1} { return -code error "wrong # args: should be \"irc::tags dict tags\"" }
        set tags [lindex $args 0]

        set ret ""
        foreach tag [split $tags ";"] {
          set split [string first = $tag]
          set key [string range $tag 0 $split-1]
          set value [::irc::unesc tags::value [string range $tag $split+1 end]]
          dict set ret $key $value
        }
        return $ret
      }
      default { return -code error "unknown subcommand \"$subcommand\": must be create, dict, exists, get, merge, remove, or set" }
    }
  }

  proc ::irc::cmd {subcommand args} {
    switch -- $subcommand {
      fmt {
        if [llength $args] {
          set tags ""
          if {[lindex $args 0] == "-tags"} {
            if {[llength $args] < 3} { return -code error "missing tags dictionary argument to -tags option" }
            set tags [::irc::tags merge [lindex $args 0]]
            set args [lrange $args 2 end]
          }
          # TODO: source generation/parsing, actual command formatting
          set source ""
          if {[lindex $args 0] == "-tags"} {
            if {[llength $args] < 3} { return -code error "missing tags map argument to -tags option" }
            set tags [lindex $args 0]
            set args [lrange $args 2 end]
          }

          set cmd [lindex $args 0]
          if ![::irc::is command $cmd] { return -code error "invalid irc command \"$cmd\"" }
          set cmd [string toupper $cmd]
        } else { return -code error "wrong # args: should be \"irc::cmd fmt ?-tags tags? ?-source source? command ?arg ...? \"" }
      }
      send { ... }
      default { return -code error "unknown subcommand \"$subcommand\": must be fmt or send" }
    }
  }
}