# -*- tcl -*-
# # ## ### ##### ######## ############# ##################### 
# (C) 2013 Andreas Kupries <andreas_kupries@users.sourceforge.net>
##
# ###

package require linenoise
package require sak::color

getpackage fileutil                 fileutil/fileutil.tcl
getpackage doctools::changelog      doctools/changelog.tcl
getpackage struct::set              struct/sets.tcl
getpackage term::ansi::send         term/ansi/send.tcl

namespace eval ::sak::review {
    namespace import ::sak::color::*
}

# ###

proc ::sak::review::usage {} {
    package require sak::help
    puts stdout \n[sak::help::on review]
    exit 1
}

proc ::sak::review::run {} {
    Scan ; Review
    return
}

# # ## ### ##### ######## ############# ##################### 
## Phase I. Determine which modules require a review.
## A derivative of the code in ::sak::readme.

proc ::sak::review::Scan {} {
    global distribution
    variable review

    Banner "Scan for modules and packages to review..."

    # Future: Consolidate with ... readme ...
    # Determine which packages are potentially changed and therefore
    # in need of review, from the set of modules touched since the
    # last release, as per the fossil repository's commit log.

    # list of modified modules.
    set modifiedm {}

    # database of commit message per changed module.
    array set cm {}

    set trunk     [Leaf trunk]            ;# rid
    set release   [YoungestOfTag release] ;# datetime
    AllParentsAfter $trunk $release -> rid {
	Next ; Progress " $rid"

	set d [Description $rid]
	Progress " D"

	FileSet $rid -> path action {
	    Progress .

	    set px [file split $path]
	    set themodule [lindex $px 1]
	    lappend modifiedm $themodule
	    lappend cm($themodule) $d

	    # ignore files in modules/
	    if {[llength $px] < 3} continue
	    lappend pt($themodule) [file join {*}[lrange $px 2 end]]
	}
    }

    Next

    # cleanup module list, may have duplicates
    set modifiedm [lsort -unique $modifiedm]

    array set review {}

    # package -> list(version)
    set old_version    [loadoldv [location_PACKAGES]]
    array set releasep [loadpkglist [location_PACKAGES]]
    array set currentp [ipackages]

    array set changed {}
    foreach p [array names currentp] {
	foreach {vlist module} $currentp($p) break
	set currentp($p) $vlist
	set changed($p) [struct::set contains $modifiedm $module]
    }

    LoadNotes

    set np 0
    # Process all packages in all modules ...
    foreach m [lsort -dict [modules]] {
	Next ; Progress " $m"
	foreach name [lsort -dict [Provided $m]] {
	    #Next ; Progress "... $m/$name"
	    # Define list of versions, if undefined so far.
	    if {![info exists currentp($name)]} {
		set currentp($name) {}
	    }

	    # Detect new packages. Ignore them.

	    if {![info exists releasep($name)]} {
		#Progress " /new"
		continue
	    }

	    # The package is not new, but possibly changed. And even
	    # if the version has not changed it may have been, this is
	    # indicated by changed(), which is based on the ChangeLog.

	    set vequal [struct::set equal $releasep($name) $currentp($name)]
	    set note   [Note $m $name]

	    # Detect packages whose versions are unchanged, and whose
	    # changelog also indicates no change. Ignore these too.

	    if {!$changed($name) && $vequal} {
		#Progress " /not changed"
		continue
	    }

	    # Now look for packages where both changelog and version
	    # number indicate a change. These we have to review.

	    if {$changed($name) && !$vequal} {
		lappend review($m) [list $name classify $note]
		#Progress " [=cya classify]"
		incr np
		continue
	    }

	    # What remains are packages which are changed according to
	    # their changelog, but their version disagrees. Or the
	    # reverse. These need a big review to see who is right.
	    # We may have to bump their version information, not just
	    # classify changes. Of course, in modules with multiple
	    # packages it is quite possible to be unchanged and the
	    # changelog refers to the siblings.

	    lappend review($m) [list $name mismatch $note]
	    #Progress " [=cya mismatch]"
	    incr np
	}
    }

    Close

    # Postprocessing phase, pull in all relevant commit messages of the module.

    foreach m [array names review] {
	# commit messages
	set     entries [lsort -unique $cm($m)]
	# and affected files
	lappend entries [join [lsort -dict [lsort -unique $pt($m)]] \n]

	set review($m) [list $review($m) [join $entries \n\n]]
    }

    set review() $np
    return
}

# see also readme
proc ::sak::review::Provided {m} {
    set result {}
    foreach {p ___} [ppackages $m] {
	lappend result $p
    }
    return $result
}

# see also readme
proc ::sak::review::loadoldv {fname} {
    set f [open $fname r]
    foreach line [split [read $f] \n] {
	set line [string trim $line]
	if {[string match @* $line]} {
	    foreach {__ __ v} $line break
	    close $f
	    return $v
	}
    }
    close $f
    return -code error {Version not found}
}

proc ::sak::review::Progress {text} {
    puts -nonewline stdout $text
    flush stdout
    return
}

proc ::sak::review::Next {} {
    # erase to end of line, then move back to start of line.
    term::ansi::send::eeol
    puts -nonewline stdout \r
    flush stdout
    return
}

proc ::sak::review::Close {} {
    puts stdout ""
    return
}

proc ::sak::review::Clear {} {
    term::ansi::send::clear
    return
}

proc ::sak::review::Banner {text} {
    Clear
    puts stdout "\n <<SAK Tcllib: $text>>\n"
    return
}

proc ::sak::review::Note {m p} {
    # Look for a note, and present to caller, if any.
    variable notes
    #parray notes
    set k [list $m $p]
    #puts <$k>
    if {[info exists notes($k)]} {
	return $notes($k)
    }
    return ""
}

proc ::sak::review::SaveNote {at t} {
    global distribution
    set    f [open [file join $distribution .NOTE] a]
    puts  $f [list $at $t]
    close $f
    return
}

proc ::sak::review::LoadNotes {} {
    global distribution
    variable  notes
    array set notes {}

    catch {
	set f [file join $distribution .NOTE]
	set f [open $f r]
	while {![eof $f]} {
	    if {[gets $f line] < 0} continue
	    set line [string trim $line]
	    if {$line == {}} continue
	    foreach {k t} $line break
	    set notes($k) $t
	}
	close $f
    }

    return
}

proc ::sak::review::FileSet {rid _ pv av script} {
    upvar 1 $pv thepath $av theaction

    lappend map @rid@ $rid
    foreach line [split [string trim [F [string map $map {
	SELECT filename.name,
	       CASE WHEN nullif(mlink.pid,0) is null THEN 'added'
                    WHEN nullif(mlink.fid,0) is null THEN 'deleted'
                    ELSE                                  'edited'
	       END
	FROM   mlink, filename
	WHERE mlink.mid  = @rid@
	AND   mlink.fnid = filename.fnid
	ORDER BY filename.name;
    }]]] \n] {
	foreach {thepath theaction} [split $line |] break
	# ignore all changes not in modules
	if {![string match modules* $thepath]} continue
	uplevel 1 $script
    }
    return
}

proc ::sak::review::Description {rid} {
    lappend map @rid@ $rid
    string trim [F [string map $map {
	SELECT coalesce(event.ecomment,event.comment)
	FROM   event
	WHERE  event.objid = @rid@
	;
    }]]
}

proc ::sak::review::AllParentsAfter {rid cut _ rv script} {
    upvar 1 $rv therev

    array set rev {}
    set rev($rid) .
    lappend front $rid

    # Initial run, for the starting revision.
    set therev   $rid
    uplevel 1 $script

    # Standard iterative incremental transitive-closure. We have a
    # front of revisions whose parents we take, which become the new
    # front to follow, until no parents are delivered anymore due to
    # the cutoff condition (timestamp, only the revisions coming after
    # are accepted).

    while {1} {
	set new {}
	foreach cid $front {
	    foreach pid [split [Parents $cid $cut] \n] {
		foreach {pid uuid mtraw mtime} [split [string trim $pid |] |] break
		lappend new $pid $mtime $uuid

		if {$mtraw <= $cut} {
		    puts "Overshot: $rid $mtime $uuid"
		}

	    }
	}
	if {![llength $new]} break

	# record new parents, and make them the new starting points
	set front {}
	foreach {pid mtime uuid} $new {
	    if {[info exists rev($pid)]} continue
	    set rev($pid) .
	    lappend front $pid

	    set therev   $pid
	    uplevel 1 $script
	}
    }
}

proc ::sak::review::Parents {rid cut} {
    lappend map @rid@    $rid
    lappend map @cutoff@ $cut
    F [string map $map {
	SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
	FROM  plink, blob, event
	WHERE plink.cid   = @rid@
	AND   plink.pid = blob.rid
	AND   plink.pid = event.objid
	AND   event.mtime > @cutoff@
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @tag@ $tag
    puts stderr "last $tag = [F [string map $map {
	SELECT datetime (event.mtime)
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid
	AND   event.type      = 'ci'
	ORDER BY event.mtime DESC
	LIMIT 1
	;
    }]]"
    F [string map $map {
	SELECT event.mtime
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid
	AND   event.type      = 'ci'
	ORDER BY event.mtime DESC
	LIMIT 1
	;
    }]
}

proc ::sak::review::Leaf {branch} {
    lappend map @branch@ $branch
    F [string map $map {
	SELECT blob.rid
	FROM   leaf, blob, tag, tagxref
	WHERE blob.rid        = leaf.rid
	AND   tag.tagname     = 'sym-' || '@branch@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = leaf.rid
	;
    }]
}

proc ::sak::review::F {script} {
    exec fossil sqlite3 << $script
}



# # ## ### ##### ######## ############# ##################### 
## Phase II. Interactively review the changes packages.

# Namespace variables
#
# review      : array, database of all modules, keyed by name
# nm          : number of modules
# modules     : list of module names, keys to --> review
# current     : index in -> modules, current module
# np          : number of packages in current module
# packages    : list of packages in current module
# currentp    : index in --> packages
# im          : 1+current  | indices for display
# ip          : 1+currentp |
# end         : array : module (name) --> index of last package
# stop        : repl exit flag
# map         : array : text -> module/package index
# commands    : proper commands
# allcommands : commands + namesof(map)
# 

proc ::sak::review::Review {} {
    variable review   ;# table of everything to review
    variable nm       ;# number of modules
    variable modules  ;# list of module names, sorted
    variable stop 0   ;# repl exit flag
    variable end      ;# last module/package index.

    variable navcommands
    variable allcommands ;# list of all commands, sorted
    variable commands    ;# list of proper commands, sorted
    variable map         ;# map from package names to module/package indices.
    variable prefix

    Banner "Packages to review: $review()"
    unset   review()

    set nm [array size review]
    if {!$nm} return

    set modules [lsort -dict [array names review]]

    # Map package name --> module/package index.
    set im 0
    foreach m $modules {
	foreach {packages clog} $review($m) break
	set ip 0
	foreach p $packages {
	    set end($im) $ip
	    set end($m) $ip
	    set end() [list $im $ip]
	    foreach {name what tags} $p break
	    lappend map(@$name)    [list $im $ip]
	    lappend map(@$name/$m) [list $im $ip]
	    incr ip
	}
	incr im
    }

    # Drop amibigous mappings, and fill the list of commands.
    foreach k [array names map] {
	# Skip already dropped keys (extended forms).
	if {![info exists map($k)]} continue
	if {[llength $map($k)] < 2} {
	    set map($k) [lindex $map($k) 0]
	    # Drop extended form, not needed.
	    array unset map $k/*
	} else {
	    unset map($k)
	}
    }

    # Map module name --> module/package index
    # If not preempted by package mapping.
    set im -1
    foreach m $modules {
	incr im
	if {[info exists map(@$m)]} continue
	set map(@$m) [list $im 0]
    }

    # Map command prefix -> full command.

    array set prefix {}
    foreach c [info commands ::sak::review::C_*] {
	set c [string range [namespace tail $c] 2 end]
	lappend commands    $c
	lappend allcommands $c
	set buf {}
	foreach ch [split $c {}] {
	    append buf $ch
	    lappend prefix($buf) $c
	}
    }

    foreach c [array names map] {
	lappend allcommands $c
	set buf {}
	foreach ch [split $c {}] {
	    append buf $ch
	    lappend prefix($buf) $c
	}
    }

    set commands    [lsort -dict $commands]
    set allcommands [lsort -dict $allcommands]
    set navcommands [lsort -dict [array names map]]

    # Enter the REPL
    Goto {0 0} 1
    linenoise::cmdloop \
	-history   1 \
	-exit      ::sak::review::Exit \
	-continued ::sak::review::Continued \
	-prompt1   ::sak::review::Prompt \
	-complete  ::sak::review::Complete \
	-dispatch  ::sak::review::Dispatch
    return
}

# # ## ### ##### ######## ############# ##################### 

proc ::sak::review::RefreshDisplay {} {
    variable m
    variable im
    variable nm
    variable clog
    variable what

    Banner "\[$im/$nm\] [=cya [string totitle $what]] [=green $m]"
    puts "| [join [split $clog \n] \n|]\n"
    return
}

proc ::sak::review::Exit {} {
    variable stop
    return  $stop
}

proc ::sak::review::Continued {buffer} {
    return 0
}

proc ::sak::review::Prompt {} {
    variable ip
    variable np
    variable name
    variable tags

    return "\[$ip/$np\] $name ($tags): "
}

proc ::sak::review::Complete {line} {
    variable allcommands
    if {$line eq {}} {
	return $allcommands
    } elseif {[llength $line] == 1} {
	set r {}
	foreach c $allcommands {
	    if {![string match ${line}* $c]} continue
	    lappend r $c
	}
	return $r
    } else {
	return {}
    }
}

proc ::sak::review::Dispatch {line} {
    variable prefix
    variable map

    if {$line == ""} { set line next }

    set cmd [lindex $line 0]

    if {![info exists prefix($cmd)]} {
	return -code error "Unknown command $cmd, use help or ? to list them"
    } elseif {[llength $prefix($cmd)] > 1} {
	return -code error "Ambigous prefix \"$cmd\", expected [join $prefix($cmd) {, }]"
    }

    # Map prefix to actual command
    set line [lreplace $line 0 0 $prefix($cmd)]

    # Run command.
    if {[info exists map($cmd)]} {
	Goto $map($cmd)
	return
    }
    eval C_$line
}

proc ::sak::review::Goto {loc {skip 0}} {
    variable review
    variable modules
    variable packages
    variable clog
    variable current
    variable currentp
    variable nm
    variable np
    variable at
    variable tags
    variable what
    variable name

    variable m
    variable p
    variable ip
    variable im

    foreach {current currentp} $loc break

    puts "Goto ($current/$currentp)"

    set m [lindex $modules $current]
    foreach {packages clog} $review($m) break

    set np [llength $packages]
    set p  [lindex  $packages $currentp]

    foreach {name what tags} $p break
    set at [list $m $name]

    set im [expr {1+$current}]
    set ip [expr {1+$currentp}]

    if {$skip && ([llength $tags] ||
		  ($tags == "---"))} {
	C_next
    } else {
	RefreshDisplay
    }
    return
}

proc ::sak::review::C_exit {} { variable stop 1 }
proc ::sak::review::C_quit {} { variable stop 1 }

proc ::sak::review::C_? {} { C_help }
proc ::sak::review::C_help {} {
    variable commands
    return [join $commands {, }]
}

proc ::sak::review::C_@? {} { C_@help }
proc ::sak::review::C_@help {} {
    variable navcommands
    return [join $navcommands {, }]
}

proc ::sak::review::C_@start {} { Goto {0 0} }
proc ::sak::review::C_@0     {} { Goto {0 0} }
proc ::sak::review::C_@end   {} { variable end ; Goto $end() }

proc ::sak::review::C_next {} {
    variable tags
    variable current
    variable currentp

    C_step 0

    set stop @$current/$currentp
    while {[llength $tags] ||
	   ($tags == "---")} {
	C_step 0
	if {"@$current/$currentp" == "$stop"} break
    }

    RefreshDisplay
    return
}

proc ::sak::review::C_step {{refresh 1}} {
    variable nm
    variable np
    variable current
    variable currentp
    variable packages

    incr currentp
    if {$currentp >= $np} {
	# skip to next module, first package
	incr current
	if {$current >= $nm} {
	    # skip to first module
	    set current 0
	}
	set currentp 0

    }
    Goto [list $current $currentp]
    return
}

proc ::sak::review::C_prev {} {
    variable end
    variable nm
    variable np
    variable current
    variable currentp
    variable packages

    incr currentp -1
    if {$currentp < 0} {
	# skip to previous module, last package
	incr current -1
	if {$current < 0} {
	    # skip to back to last module
	    set current [expr {$nm - 1}]
	}
	set currentp $end($current)
    }
    Goto [list $current $currentp]
    return
}

# Commands to add/remove tags, clear set, replace set

proc ::sak::review::C_feature {} { +T EF }
proc ::sak::review::C_test    {} { +T T }
proc ::sak::review::C_doc     {} { +T D }
proc ::sak::review::C_bug     {} { +T B }
proc ::sak::review::C_perf    {} { +T P }
proc ::sak::review::C_example {} { +T EX }
proc ::sak::review::C_api     {} { +T API }
proc ::sak::review::C_impl    {} { +T I }

proc ::sak::review::C_-feature {} { -T EF }
proc ::sak::review::C_-test    {} { -T T }
proc ::sak::review::C_-doc     {} { -T D }
proc ::sak::review::C_-bug     {} { -T B }
proc ::sak::review::C_-perf    {} { -T P }
proc ::sak::review::C_-example {} { -T EX }
proc ::sak::review::C_-api     {} { -T API }
proc ::sak::review::C_-impl    {} { -T I }

proc ::sak::review::C_---   {} { =T --- }
proc ::sak::review::C_clear {} { =T --- }
#proc ::sak::review::C_cn {} { C_clear ; C_next }

proc ::sak::review::+T {tag} {
    variable tags
    if {[lsearch -exact $tags $tag] >= 0} {
	RefreshDisplay
	return
    }
    =T [linsert $tags end $tag]
    return
}

proc ::sak::review::-T {tag} {
    variable tags
    set pos [lsearch -exact $tags $tag]
    if {$pos < 0} {
	RefreshDisplay
	return
    }
    =T [lreplace $tags $pos $pos]
    return
}

proc ::sak::review::=T {newtags} {
    variable review
    variable clog
    variable packages
    variable currentp
    variable p
    variable m
    variable at
    variable name
    variable what
    variable tags

    if {([llength $newtags] > 1) &&
	([set pos [lsearch -exact $newtags ---]] >= 0)} {
	# Drop --- if there are other tags.
	set newtags [lreplace $newtags $pos $pos]
    }

    set tags       [lsort -dict $newtags]
    set p          [list $name $what $newtags]
    set packages   [lreplace $packages $currentp $currentp $p]
    set review($m) [list $packages $clog]

    SaveNote $at $tags
    RefreshDisplay
    return
}

proc ::sak::review::?T {} {
    variable tags
    return $tags
}

##
# ###

namespace eval ::sak::review {}

package provide sak::review 1.0
