package Synth::Config;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Synthesizer settings librarian

our $VERSION = '0.0063';

use Moo;
use strictures 2;
use Carp qw(croak);
use GraphViz2 ();
use List::Util qw(first);
use Mojo::JSON qw(from_json to_json);
use Mojo::SQLite ();
use YAML qw(Load LoadFile);
use namespace::clean;


has model => (
  is => 'rw',
);


has dbname => (
  is       => 'ro',
  required => 1,
  default  => sub { 'synth-config.db' },
);

has _sqlite => (is => 'lazy');

sub _build__sqlite {
  my ($self) = @_;
  my $sqlite = Mojo::SQLite->new('sqlite:' . $self->dbname);
  return $sqlite->db;
}


has verbose => (
  is      => 'ro',
  isa     => sub { croak "$_[0] is not a boolean" unless $_[0] =~ /^[01]$/ },
  default => sub { 0 },
);


sub BUILD {
  my ($self, $args) = @_;
  return unless $args->{model};
  # sanitize the model name
  (my $model = $args->{model}) =~ s/\W/_/g;
  $self->model(lc $model);
  # create the model table unless it's already there
  $self->_sqlite->query(
    'create table if not exists '
    . $self->model
    . ' (
        id integer primary key autoincrement,
        settings json not null,
        name text not null
      )'
  );
  # create the model specs table unless it's already there
  $self->_sqlite->query(
    'create table if not exists specs'
    . ' (
        id integer primary key autoincrement,
        model text not null,
        spec json not null
      )'
  );
}


sub make_setting {
  my ($self, %args) = @_;
  my $id = delete $args{id};
  my $name = delete $args{name};
  croak 'No columns given' unless keys %args;
  if ($id) {
    my $result = $self->_sqlite->select(
      $self->model,
      ['settings'],
      { id => $id },
    )->expand(json => 'settings')->hash->{settings};
    for my $arg (keys %args) {
      $args{$arg} = '' unless defined $args{$arg};
    }
    my $params = { %$result, %args };
    $self->_sqlite->update(
      $self->model,
      { settings => to_json($params) },
      { id => $id },
    );
  }
  elsif ($name) {
    $id = $self->_sqlite->insert(
      $self->model,
      {
        name     => $name,
        settings => to_json(\%args),
      },
    )->last_insert_id;
  }
  return $id;
}


sub recall_setting {
  my ($self, %args) = @_;
  my $id = $args{id};
  croak 'No id given' unless $id;
  my $result = $self->_sqlite->select(
    $self->model,
    ['name', 'settings'],
    { id => $id },
  )->expand(json => 'settings')->hash;
  my $setting = $result->{settings};
  $setting->{id} = $id;
  $setting->{name} = $result->{name};
  return $setting;
}


sub search_settings {
  my ($self, %args) = @_;
  my $name = delete $args{name};
  my @where;
  push @where, "name = '$name'" if $name;
  for my $arg (keys %args) {
    next unless $args{$arg};
    $args{$arg} =~ s/'/''/g; # escape the single-quote
    push @where, q/json_extract(settings, '$./ . $arg . q/') = / . "'$args{$arg}'";
  }
  return [] unless @where;
  my $sql = q/select id,name,settings,json_extract(settings, '$.group') as mygroup, json_extract(settings, '$.parameter') as parameter from /
    . $self->model
    . ' where ' . join(' and ', @where)
    . ' order by name,mygroup,parameter';
  print "Search SQL: $sql\n" if $self->verbose;
  my $results = $self->_sqlite->query($sql);
  my @settings;
  while (my $next = $results->hash) {
    my $set = from_json($next->{settings});
    $set->{id} = $next->{id};
    $set->{name} = $next->{name};
    push @settings, $set;
  }
  return \@settings;
}


sub recall_settings {
  my ($self) = @_;
  my $sql = q/select id,name,settings,json_extract(settings, '$.group') as mygroup from /
    . $self->model
    . ' order by name,mygroup';
  my $results = $self->_sqlite->query($sql);
  my @settings;
  while (my $next = $results->hash) {
    my $set = from_json($next->{settings});
    $set->{id} = $next->{id};
    $set->{name} = $next->{name};
    push @settings, $set;
  }
  return \@settings;
}


sub recall_models {
  my ($self) = @_;
  my @models;
  my $results = $self->_sqlite->query(
    "select name from sqlite_schema where type='table' order by name"
  );
  while (my $next = $results->array) {
    next if $next->[0] =~ /^sqlite/;
    push @models, $next->[0];
  }
  return \@models;
}


sub recall_setting_names {
  my ($self) = @_;
  my @settings;
  my $results = $self->_sqlite->query(
    'select distinct name from ' . $self->model
  );
  while (my $next = $results->array) {
    push @settings, $next->[0];
  }
  return \@settings;
}


sub remove_setting {
  my ($self, %args) = @_;
  my $id = $args{id};
  croak 'No id given' unless $id;
  $self->_sqlite->delete(
    $self->model,
    { id => $id }
  );
}


sub remove_settings {
  my ($self, %args) = @_;
  my $name = $args{name};
  my $where = $name ? { name => $name } : {};
  $self->_sqlite->delete(
    $self->model,
    $where
  );
}


sub remove_model {
  my ($self) = @_;
  $self->_sqlite->query(
    'drop table ' . $self->model
  );
}


sub make_spec {
  my ($self, %args) = @_;
  my $id = delete $args{id};
  croak 'No columns given' unless keys %args;
  if ($id) {
    my $result = $self->_sqlite->select(
      'specs',
      ['spec'],
      { id => $id },
    )->expand(json => 'spec')->hash->{spec};
    for my $arg (keys %args) {
      $args{$arg} = '' unless defined $args{$arg};
    }
    my $params = { %$result, %args };
    $self->_sqlite->update(
      'specs',
      { spec => to_json($params) },
      { id => $id },
    );
  }
  else {
    $id = $self->_sqlite->insert(
      'specs',
      {
        model => $self->model,
        spec  => to_json(\%args),
      },
    )->last_insert_id;
  }
  return $id;
}


sub recall_specs {
  my ($self) = @_;
  my $sql = q/select id,model,spec,json_extract(spec, '$.group') as mygroup from /
    . 'specs'
    . " where model = '" . $self->model . "'"
    . ' order by model,mygroup';
  my $results = $self->_sqlite->query($sql);
  my $set;
  while (my $next = $results->hash) {
    $set = from_json($next->{spec});
    $set->{id} = $next->{id};
    $set->{model} = $next->{model};
  }
  return $set;
}


sub recall_spec {
  my ($self, %args) = @_;
  my $id = delete $args{id};
  croak 'No id given' unless $id;
  my $result = $self->_sqlite->select(
    'specs',
    ['spec'],
    { id => $id },
  )->expand(json => 'spec')->hash;
  my $spec = $result->{spec};
  $spec->{id} = $id;
  return $spec;
}


sub remove_spec {
  my ($self) = @_;
  $self->_sqlite->delete(
    'specs',
    { model => $self->model }
  );
}


sub import_specs {
  my ($self, %options) = @_;

  croak 'Invalid specs file'
    if $options{file} && !-e $options{file};

  my $config = $options{file}
    ? LoadFile($options{file})
    : Load($options{string});

  my $specs = $self->recall_specs;

  if ($specs && @$specs) {
    print 'Removing spec from ', $self->model, "\n"
        if $self->verbose;
    $self->remove_spec;
  }

  my @list = @{ $config->{specs} };;

  for my $name (@list) {
      for my $spec (@{ $config->{$name} }) {
        print "Adding $name spec to ", $self->model, "\n"
          if $self->verbose;
        $self->make_spec(name => $name, %$spec);
      }
  }

  return \@list;
}


sub import_patches {
  my ($self, %options) = @_;

  croak 'Invalid settings file'
    if $options{file} && !-e $options{file};

  my $config = $options{file}
    ? LoadFile($options{file})
    : Load($options{string});

  my $list = $options{patches} && @{ $options{patches} }
    ? $options{patches}
    : [ map { $_->{patch} } @{ $config->{patches} } ];

  for my $patch_name (@$list) {
    my $settings = $self->search_settings(name => $patch_name);

    if ($settings && @$settings) {
      print "Removing $patch_name setting from ", $self->model, "\n"
          if $self->verbose;
      $self->remove_settings(name => $patch_name);
    }

    for my $patch (@{ $config->{patches} }) {
      my $name = $patch->{patch};
      next unless first { $_ eq $name } @$list;
      for my $set (@{ $patch->{settings} }) {
        my $group = $set->{group};
        print "Adding $name $group setting to ", $self->model, "\n"
          if $self->verbose;
        $self->make_setting(name => $name, %$set);
      }
    }
  }

  return $list;
}


sub graphviz {
  my ($self, %options) = @_;

  croak 'No settings given' unless $options{settings};

  $options{render}    ||= 0;
  $options{path}      ||= '.';
  $options{extension} ||= 'png';
  $options{shape}     ||= 'oval';
  $options{color}     ||= 'grey';

  my $g = GraphViz2->new(
    global => { directed => 1 },
    node   => { shape => $options{shape} },
    edge   => { color => $options{color} },
  );
  my (%edges, %sets, %labels, %seen, $patch_name);

  # collect settings by group
  for my $set (@{ $options{settings} }) {
    $patch_name = $set->{name};
    my $from = $set->{group};
    push @{ $sets{$from} }, $_ for @{ $set->{parameters} };
  }

  # accumulate non-patch parameter = value labels
  for my $from (keys %sets) {
    my @labels;
    for my $parameter (@{ $sets{$from} }) {
      next if $parameter->{control} eq 'patch';
      my $label = "$parameter->{param} = $parameter->{value}$parameter->{unit}";
      my $key   = "$from $label";
      push @labels, $label unless $seen{$key}++;
    }
    $labels{$from} = join "\n", $from, @labels;
  }

  # add patch edges
  for my $from (keys %sets) {
    for my $parameter (@{ $sets{$from} }) {
      next if $parameter->{control} ne 'patch';
      my $to         = $parameter->{group_to};
      my $param      = $parameter->{param};
      my $param_to   = $parameter->{param_to};
      my $key        = "$from $param to $to $param_to";
      my $label      = "$param to $param_to";
      my $from_label = $labels{$from};
      my $to_label   = exists $labels{$to}
        ? $labels{$to}
        : ucfirst lc $to;
      $g->add_node(name => $to_label);
      $g->add_edge(
        from  => $from_label,
        to    => $to_label,
        label => $label,
      ) unless $edges{$key}++;
    }
  }

  # save a file
  if ($options{render}) {
    my $model = $self->model;
    (my $patch = $patch_name) =~ s/\W/_/g;
    my $filename = "$options{path}/$model-$patch.$options{extension}";
    $g->run(format => $options{extension}, output_file => $filename);
  }

  return $g;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Synth::Config - Synthesizer settings librarian

=head1 VERSION

version 0.0063

=head1 SYNOPSIS

  use Synth::Config ();

  my $model = 'Modular';
  my $synth = Synth::Config->new(model => $model, verbose => 1);

  # populate the database with patch settings
  my $patches = $synth->import_patches(
      file    => "$model.yaml", # or string => '...' # one or the other is required
      patches => ['Simple 001', 'Simple 002'],       # optional
  );

  # populate the database with individual settings
  my $patch = 'My favorite setting';
  my $id1 = $synth->make_setting(name => $patch, group => 'filter', etc => '...');
  my $id2 = $synth->make_setting(name => $patch, group => 'sequencer', etc => '...');

  # update the group key
  $synth->make_setting(id => $id1, group => 'envelope');

  my $settings = $synth->recall_settings;
  # [ { id => 1, group => 'envelope', etc => '...' }, { id => 2, group => 'sequencer', etc => '...' } ]

  $settings = $synth->search_settings(name => $patch);
  # [ { id => 1, group => 'envelope', etc => '...' }, { id => 2, group => 'sequencer', etc => '...' } ]

  $settings = $synth->search_settings(group => 'sequencer');
  # [ { id => 2, group => 'sequencer', etc => '...' } ]

  my $setting = $synth->recall_setting(id => $id1);
  # { id => 1, group => 'envelope', etc => '...' }

  my $g = $synth->graphviz(settings => $setting);
  # or
  $synth->graphviz(
    settings => $setting,
    render   => 1,
  );

  my $models = $synth->recall_models;
  # [ 'moog_matriarch' ]

  my $setting_names = $synth->recall_setting_names;
  # [ 'My favorite setting' ]

  # populate the database with the model specification
  my $specs = $synth->import_specs(
      file => "$model.yaml",
      # or string => '...' # one or the other is required
  );

  # declare the possible setting specifications
  my %spec = (
    order      => [qw(group parameter control group_to param_to bottom top value unit is_default)],
    group      => [],
    parameter  => {},
    control    => [qw(knob switch slider patch)],
    group_to   => [],
    param_to   => [],
    bottom     => [qw(off 0 1 7AM 20)],
    top        => [qw(on 3 4 6 7 5PM 20_000 100%)],
    value      => [],
    unit       => [qw(Hz o'clock)],
    is_default => [0, 1],
  );
  my $spec_id = $synth->make_spec(%spec);
  my $spec = $synth->recall_spec(id => $spec_id);
  $specs = $synth->recall_specs;
  # { order => [ ... ], etc => ... }

  # remove stuff!
  $synth->remove_spec;                     # remove the current model specification
  $synth->remove_setting(id => $id1);      # remove a particular setting
  $synth->remove_settings(name => $patch); # remove all settings sharing the same name
  $synth->remove_model(model => $model);   # remove the entire model

=head1 DESCRIPTION

C<Synth::Config> provides a way to import, save, recall, and visualize
synthesizer control settings in a database, and with L<GraphViz2>.

This does B<not> control the synth. It is simply a way to manually
record the parameters defined by knob, slider, switch, or patch
settings in an SQLite database. It is a "librarian", if you will.

=head1 ATTRIBUTES

=head2 model

  $model = $synth->model;

The model name of the synthesizer.

This is turned into lowercase and all non-alpha-num characters are
converted to an underline character (C<_>).

=head2 dbname

  $dbname = $synth->dbname;

Database name

Default: C<synth-config.db>

=head2 verbose

  $verbose = $synth->verbose;

Show progress.

=head1 METHODS

=head2 new

  $synth = Synth::Config->new(model => $model);

Create a new C<Synth::Config> object.

This automatically makes an SQLite database with a table named for the
given B<model>.

=for Pod::Coverage BUILD

=head2 make_setting

  my $id = $synth->make_setting(%args);

Save a named setting and return the record id.

The B<name> is required to perform an insert. If an B<id> is given, an
update is performed.

The setting is a single JSON field that can contain any key/value
pairs. These pairs B<must> include at least a C<group> to be
searchable.

Example:

  name: 'My Best Setting!'
  settings:
    group   parameter control bottom top   value unit is_default
    filters cutoff    knob    20     20000 200   Hz   1

  name: 'My Other Best Setting!'
  settings:
    group parameter control group_to param_to is_default
    mixer output    patch   filters  vcf-in   0

=head2 recall_setting

  my $setting = $synth->recall_setting(id => $id);

Return the parameters of a setting for the given B<id>.

=head2 search_settings

  my $settings = $synth->search_settings(
    some_setting    => $val1,
    another_setting => $val2,
  );

Return all the settings given a search query.

=head2 recall_settings

  my $settings = $synth->recall_settings;

Return all the settings for the synth model.

=head2 recall_models

  my $models = $synth->recall_models;

Return all the know models. This method can be called without having
specified a synth B<model> in the constructor.

=head2 recall_setting_names

  my $setting_names = $synth->recall_setting_names;

Return all the setting names for the current model.

=head2 remove_setting

  $synth->remove_setting(id => $id);

Remove a setting given an B<id>.

=head2 remove_settings

  $synth->remove_settings; # all model settings
  $synth->remove_settings(name => $name);

Remove all settings of the current model, or for given B<name>d
setting.

=head2 remove_model

  $synth->remove_model;

Remove the database table for the current object model.

=head2 make_spec

  my $id = $synth->make_spec(%args);

Save a model specification and return the record id.

If an B<id> is given, an update is performed.

The spec is a single JSON field that can contain any key/value
pairs that define the configuration - groups, parameters, values, etc.
of a model.

=head2 recall_specs

  my $specs = $synth->recall_specs;

Return the specs for the model.

=head2 recall_spec

  my $spec = $synth->recall_spec(id => $id);

Return the model configuration specification for the given B<id>.

=head2 remove_spec

  $synth->remove_spec;

Remove the database table for the current object model configuration
specification.

=head2 import_specs

Add the specifications defined in a L<YAML> file or string, to the
database and return the spec name.

Option defaults:

  file   = undef
  string = undef

=head2 import_patches

Add the settings defined in a L<YAML> file or string, to the database
and return the setting (patch) name.

A specific subset of B<patches> can be imported, by providing their
names in the B<options>.

YAML format:

  model: "Model name"
  patches:
    - patch: "Setting name"
      settings:
        - group: "Group name"
          parameters:
            - param: "Patch parameter name"
              control: 'patch'
              group_to: "Connect to group"
              param_to: "Connected group parameter"
            - param: "Control parameter name"
              control: "Named physical control"
              value: "Parameter value"
              unit: "Parameter unit of measure"
    - patch: "Another parameter name"
      ...

Please see the L</"SEE ALSO"> section for examples of configuration
files.

Option defaults:

  file    = undef
  string  = undef
  patches = undef

=head2 graphviz

  $g = $synth->graphviz(%options);

Visualize a patch of B<settings> with the L<GraphViz2> module.

Option defaults:

  settings  = undef (required)
  render    = 0
  path      = .
  extension = png
  shape     = oval
  color     = grey

  model => 'Modular',
  patches => [
    {
      patch => 'Simple 000',
      settings => [
        {
          group => 'oscillator',
          parameters => [
            { control => 'patch', group_to => 'mixer', param => 'out', param_to => 'in' },
            { control => 'knob', param => 'range', unit => "'", value => 8 },
            { control => 'switch', param => 'waveform', unit => '', value => 'square' },
          ],
        }, {
          group => 'mixer',
          parameters => [ { control => 'patch', group_to => 'audio', param => 'stereo-out', param_to => 'stereo-in' } ],
        },
      ],
    }

=head1 SEE ALSO

The F<t/01-methods.t> and the F<eg/*.pl> files in this distribution

L<GraphViz2>

L<List::Util>

L<Moo>

L<Mojo::JSON>

L<Mojo::SQLite>

L<YAML>

=head1 AUTHOR

Gene Boggs <gene@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2023-2024 by Gene Boggs.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut
