### ----------------------------------------------------
### -- App::pack.raku
### -- Licenses: GPL-3.0-or-later
### -- Authors: Francis Grizzly Smit <grizzly@smit.id.au>
### -- File: rakulib/Pack.rakumod
### ----------------------------------------------------
### -- Chunk 4 of 4
our ~ %r«perms» ~ ' ' ~ $highlight-fg-colour ~ $name;
            } elsif $cnt %% 2 {
                return $bg-colour0          ~ %r«perms» ~ ' ' ~ $fg-colour0          ~ $name;
            } else {
                return $bg-colour1          ~ %r«perms» ~ ' ' ~ $fg-colour1          ~ $name;
            }
        } else {
            if %r«value» eq 'cancel' {
                return %r«name» if %r«name»:exists;
                return %r«value»;
            } 
            my Str:D $name = %r«perms» ~ ' ' ~ %r«size» ~ ' ' ~ %r«user» ~ ' ' ~ %r«group» ~ ' ' ~ %r«modified» ~ ' ' ~ %r«backup»;
            return $name;
        }
    }
    my Str $file = menu(@Backups, $message, :&row, :$colour, :$syntax, :$highlight-bg-colour, :$highlight-fg-colour, :wrap-around);
    return False without $file;
    return False if $file eq '';
    return False if $file eq 'cancel';
    return restore-db-file($file.IO);
} # sub backups-menu-restore-db(Bool:D $colour, Bool:D $syntax, Str:D $message = "" --> Bool:D) is export #

sub list-db-backups(Str:D $prefix,
                    Bool:D $colour is copy,
                    Bool:D $syntax,
                    Regex:D $pattern,
                    Int:D $page-length --> Bool:D) is export {
    $colour = True if $syntax;
    my IO::Path @backups = $config.IO.dir(:test(rx/ ^ 'pack.p_ck.' \d ** 4 '-' \d ** 2 '-' \d ** 2
                                                               [ 'T' \d **2 [ [ '.' || ':' ] \d ** 2 ] ** {0..2} [ [ '.' || '·' ] \d+ 
                                                                   [ [ '+' || '-' ] \d ** 2 [ '.' || ':' ] \d ** 2 || 'z' ]?  ]?
                                                               ]?
                                                           $
                                                         /
                                                       )
                                                );
    #dd @backups;
    my $actions = PathFileActions;
    @backups .=grep: -> IO::Path $fl { 
                                my @file = $fl.slurp.split("\n");
                                PathsFile.parse(@file.join("\x0A"), :enc('UTF-8'), :$actions).made;
                            };
    @backups .=sort;
    my @_backups = @backups.map: -> IO::Path $f {
          my %elt = backup => $f.basename, perms => symbolic-perms($f, :$colour, :$syntax),
                      user => $f.user, group => $f.group, size => $f.s, modified => $f.modified;
          %elt;
      };
    #dd @backups;
    my Str:D @fields = 'perms', 'size', 'user', 'group', 'modified', 'backup';
    my       %defaults;
    my Str:D %fancynames = perms => 'Permissions', size => 'Size',
                             user => 'User', group => 'Group',
                             modified => 'Date Modified', backup => 'Backup';
    sub include-row(Str:D $prefix, Regex:D $pattern, Int:D $idx, Str:D @fields, %row --> Bool:D) {
        my Str:D $value = ~(%row«backup» // '');
        return True if $value.starts-with($prefix, :ignorecase) && $value ~~ $pattern;
        return False;
    } # sub include-row(Str:D $prefix, Regex:D $pattern, Int:D $idx, Str:D @fields, %row --> Bool:D) #
    sub head-value(Int:D $indx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields --> Str:D) {
        #dd $indx, $field, $colour, $syntax, @fields;
        if $colour {
            if $syntax { 
                return t.color(0, 255, 255) ~ %fancynames{$field};
            } else {
                return t.color(0, 255, 255) ~ %fancynames{$field};
            }
        } else {
            return %fancynames{$field};
        }
    } # sub head-value(Int:D $indx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields --> Str:D) #
    sub head-between(Int:D $indx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields --> Str:D) {
        return ' ';
    } # sub head-between(Int:D $indx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields --> Str:D) #
    sub field-value(Int:D $idx, Str:D $field, $value, Bool:D $colour, Bool:D $syntax, Str:D @fields, %row --> Str:D) {
        my Str:D $val = ~($value // ''); #`««« assumming $value is a Str:D »»»
        #dd $val, $value, $field;
        if $syntax {
            given $field {
                when 'perms'    { return $val; }
                when 'size'     {
                    my Int:D $size = +$value;
                    return t.color(255, 0, 0) ~ format-bytes($size);
                }
                when 'user'     { return t.color(255, 255, 0) ~ uid2username(+$value);    }
                when 'group'    { return t.color(255, 255, 0) ~ gid2groupname(+$value);   }
                when 'modified' {
                    my Instant:D $m = +$value;
                    my DateTime:D $dt = $m.DateTime.local;
                    return t.color(0, 0, 235) ~ $dt.Str;  
                }
                when 'backup'   { return t.color(255, 0, 255) ~ $val; }
                default         { return t.color(255, 0, 0) ~ $val;   }
            } # given $field #
        } elsif $colour {
            given $field {
                when 'perms'    { return $val; }
                when 'size'     {
                    my Int:D $size = +$value;
                    return t.color(0, 0, 255) ~ format-bytes($size);
                }
                when 'user'     { return t.color(0, 0, 255) ~ uid2username(+$value);    }
                when 'group'    { return t.color(0, 0, 255) ~ gid2groupname(+$value);   }
                when 'modified' {
                    my Instant:D $m = +$value;
                    my DateTime:D $dt = $m.DateTime.local;
                    return t.color(0, 0, 255) ~ $dt.Str;  
                }
                when 'backup'   { return t.color(0, 0, 255) ~ $val;   }
                default         { return t.color(255, 0, 0) ~ $val;   }
            } # given $field #
        } else {
            given $field {
                when 'perms'    { return $val; }
                when 'size'     {
                    my Int:D $size = +$value;
                    return format-bytes($size);
                }
                when 'user'     { return uid2username(+$value);    }
                when 'group'    { return gid2groupname(+$value);   }
                when 'modified' {
                    my Instant:D $m = +$value;
                    my DateTime:D $dt = $m.DateTime.local;
                    return $dt.Str;  
                }
                when 'backup'   { return $val;   }
                default         { return $val;   }
            } # given $field #
        }
    } # sub field-value(Int:D $idx, Str:D $field, $value, Bool:D $colour, Bool:D $syntax, Str:D @fields, %row --> Str:D) #
    sub between(Int:D $idx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields, %row --> Str:D) {
        return ' ';
    } # sub between(Int:D $idx, Str:D $field, Bool:D $colour, Bool:D $syntax, Str:D @fields, %row --> Str:D) #
    sub row-formatting(Int:D $cnt, Bool:D $colour, Bool:D $syntax --> Str:D) {
        if $colour {
            if $syntax { 
                return t.bg-color(255, 0, 255) ~ t.bold ~ t.bright-blue if $cnt == -3; # three heading lines. #
                return t.bg-color(0, 0, 127) ~ t.bold ~ t.bright-blue if $cnt == -2;
                return t.bg-color(255, 0, 255) ~ t.bold ~ t.bright-blue if $cnt == -1;
                return (($cnt % 2 == 0) ?? t.bg-yellow !! t.bg-color(0,195,0)) ~ t.bold ~ t.bright-blue;
            } else {
                return t.bg-color(255, 0, 255) ~ t.bold ~ t.bright-blue if $cnt == -3;
                return t.bg-color(0, 0, 127) ~ t.bold ~ t.bright-blue if $cnt == -2;
                return t.bg-color(255, 0, 255) ~ t.bold ~ t.bright-blue if $cnt == -1;
                return (($cnt % 2 == 0) ?? t.bg-yellow !! t.bg-color(0,195,0)) ~ t.bold ~ t.bright-blue;
            }
        } else {
            return '';
        }
    } # sub row-formatting(Int:D $cnt, Bool:D $colour, Bool:D $syntax --> Str:D) #
    return list-by($prefix, $colour, $syntax, $page-length,
                  $pattern, @fields, %defaults, @_backups,
                  :!sort,
                  :&include-row, 
                  :&head-value, 
                  :&head-between,
                  :&field-value, 
                  :&between,
                  :&row-formatting);
} #`««« sub list-db-backups(Str:D $prefix,
                            Bool:D $colour is copy,
                            Bool:D $syntax,
                            Regex:D $pattern,
                            Int:D $page-length --> Bool:D) is export »»»

my Str  $schema;
my Str  $podir;
my Str  $gettext-domain;
my Str  $package-dir;
my Str  $out-dir;
my Bool $force-file;
my      @extra-sources;
my Int  $exitcode-val;

sub read-file(Str $dir --> Bool) is export {
    die "file $dir/.pack_args.json does not exist" unless "$dir/.pack_args.json".IO ~~ :f;
    my $file-cont         = "$dir/.pack_args.json".IO.slurp(:utf8);
    my $data              = from-json $file-cont;
    $schema               = %$data«schema» // Str;
    $podir                = %$data«podir» // Str;
    $gettext-domain       = %$data«gettext-domain» // Str;
    $package-dir          = %$data«package-dir» // Str;
    $out-dir              = %$data«out-dir» // Str;
    $force-file           = %$data«force» // Bool;
    my $extra             = %$data«extra-sources»;
    @extra-sources        = @$extra;
    return True;
}

sub pack(Str $dir, Bool $force is copy = False --> Bool) is export {
    $force              ||= $force-file;
    my @cmd = qqww{gnome-extensions pack};
    for @extra-sources -> $extra {
        push @cmd, "--extra-source=$extra";  
    }
    push @cmd, "--schema=$schema" with $schema;
    push @cmd, "--podir=$podir" with $podir;
    push @cmd, "--gettext-domain=$gettext-domain" with $gettext-domain;
    push @cmd, "--force" if $force;
    push @cmd, "--out-dir=$out-dir" with $out-dir;
    $package-dir = $dir without $package-dir;
    $package-dir = $dir if $dir.contains('/');
    push @cmd, "$package-dir";
    @cmd.join(' ').say;
    my Proc $res = run @cmd;
    $exitcode-val = $res.exitcode;
    return $res.exitcode == 0;
}

sub exitcode(--> int) is export {
    return $exitcode-val;
}

sub create-config(Str:D $package-dir,
                  Str $schema,
                  Str $podir,
                  Str $gettext-domain,
                  Str $out-dir,
                  Bool:D $force,
                  @extra-sources --> Bool) is export {
    my %data              = extra-sources => [ |@extra-sources ];
    %data«schema»         = $schema with $schema;
    %data«podir»          = $podir with $podir;
    %data«gettext-domain» = $gettext-domain with $gettext-domain;
    %data«package-dir»    = $package-dir.IO.basename;
    %data«out-dir»        = "$out-dir".IO.absolute.IO.resolve(:completely).Str;
    %data«force»          = $force;
    "$package-dir/.pack_args.json".IO.spurt(to-json %data);
    return True;                                                                                                                                                                                                                                    
}

sub add(Str $dir,
        Str $_schema,
        Str $_podir,
        Str $_gettext-domain,
        Str $_out-dir,
        Bool $_force is copy,
        Bool $stomp-force,
        Bool $stomp,
        @_extra-sources --> Bool) is export {
    read-file($dir);
    push @extra-sources, |@_extra-sources if @_extra-sources;
    if $stomp {
        @extra-sources     = @_extra-sources;
    }
    @extra-sources         = @extra-sources.sort.squish;
    $package-dir           = $dir.IO.absolute.IO.resolve(:completely).basename unless defined $package-dir;
    $schema                = $_schema unless $_schema eq 'Null';
    $podir                 = $_podir unless $_podir eq 'Null';
    $gettext-domain        = $_gettext-domain unless $_gettext-domain eq 'Null';
    $out-dir               = $_out-dir.IO.absolute.IO.resolve(:completely).Str unless $_out-dir eq 'Null';
    if !$stomp-force {
        $_force            = $force-file unless $_force;
    }
    my $data               = { extra-sources => [ |@extra-sources ],  };
    if defined $schema {
        %$data«schema»     = $schema;
    }
    if defined $podir {
        %$data«podir»      = $podir;
    }
    if $gettext-domain {
        %$data«gettext-domain» = $gettext-domain;
    }
    if $package-dir {
        %$data«package-dir»    = $package-dir;
    }
    if defined $out-dir {
        %$data«out-dir»        = "$out-dir".IO.absolute.IO.resolve(:completely).Str;
    }
    %$data«force»          = $_force;
    "$dir/.pack_args.json".IO.spurt(to-json $data);
    return True;                                                                                                                                                                                                                                    
}

sub set-package-dir($dir, $package-dir-value) is export {
    read-file($dir);
    $package-dir               = $package-dir-value.IO.basename;
    my $data                   = { extra-sources => [ |@extra-sources ],  };
    if defined $schema {
        %$data«schema»         = $schema;
    }
    if defined $podir {
        %$data«podir»          = $podir;
    }
    if $gettext-domain {
        %$data«gettext-domain» = $gettext-domain;
    }
    if $package-dir {
        %$data«package-dir»    = $package-dir;
    }
    if defined $out-dir {
        %$data«out-dir»        = "$out-dir".IO.absolute.IO.resolve(:completely).Str;
    }
    %$data«force»              = $force-file;
    "$dir/.pack_args.json".IO.spurt(to-json $data);
    return True;                                                                                                                                                                                                                                    
}

sub remove(Str $package-dir, Str $name --> Bool) is export {
    die "file $package-dir/.pack_args.json does not exist" unless "$package-dir/.pack_args.json".IO ~~ :f;
    my $file-cont         = "$package-dir/.pack_args.json".IO.slurp(:utf8);
    my $data              = from-json $file-cont;
    if $name ne 'extra-sources' && $name ne 'package-dir' {
        %$data{$name}:delete if %$data{$name}:exists;
    } elsif $name eq 'extra-sources' {
        %$data«extra-sources» = [];
    } else {
        "Error: deleting package-dir is not permitted!".say;
    }
    "$package-dir/.pack_args.json".IO.spurt(to-json $data);
    return True;                                                                                                                                                                                                                                    
}

sub get(Str $package-dir, Str $name --> Bool) is export {
    die "file $package-dir/.pack_args.json does not exist" unless "$package-dir/.pack_args.json".IO ~~ :f;
    my $file-cont         = "$package-dir/.pack_args.json".IO.slurp(:utf8);
    my $data              = from-json $file-cont;
    if %$data{$name}:exists { 
        %$data{$name}.say;
    } else {
        return False;
    }
    return True;                                                                                                                                                                                                                                    
}


