predicate op forgot to expand constants

[scpubgit/DKit.git] / lib / DX / Lib / FS.pm

package DX::Lib::FS;

use DX::Lib::FS::Observation::PathStatus;
use DX::Lib::FS::Action::CreateDirectory;
use DX::Lib::FS::Action::CreateFile;
use File::Spec;
use DX::SetOver;
use Moo;

our @RULES = (
  [ path_status => [ qw(PS) ],
    [ member_of => 'PS', \'path_status' ] ],
  [ path => [ qw(PS P) ],
    [ prop => 'PS', \'path', 'P' ] ],
  [ info_prop => [ qw(PS N V) ],
    [ exists => [ qw(PSI) ],
      [ prop => 'PS', \'info', 'PSI' ],
      [ prop => 'PSI', 'N', 'V' ] ] ],
  [ mode => [ qw(PS M) ],
    [ info_prop => 'PS', \'mode', 'M' ] ],
  [ exists_path => [ qw(PS) ],
    [ info_prop => 'PS', \'is_directory', \1 ] ],
  [ exists_path => [ qw(PS) ],
    [ info_prop => 'PS', \'is_file', \1 ] ],
  [ is_directory => [ qw(PS) ],
    [ info_prop => 'PS', \'is_directory', \1 ] ],
  [ is_file => [ qw(PS) ],
    [ info_prop => 'PS', \'is_file', \1 ] ],
  [ path_status_at => [ 'PS', 'P' ],
    [ path_status => 'PS' ],
    [ path => qw(PS P) ],
    [ 'cut' ] ],
  [ path_status_at => [ 'PS', 'P' ],
    [ observe => [ 'P' ], sub {
        DX::Lib::FS::Observation::PathStatus->new(
          path => $_[0]
        )
      } ],
    [ path_status => 'PS' ],
    [ path => qw(PS P) ] ],
  [ directory_at => [ qw(PS P) ],
    [ path_status_at => qw(PS P) ],
    [ is_directory => 'PS' ] ],
  [ file_at => [ qw(PS P) ],
    [ path_status_at => qw(PS P) ],
    [ is_file => 'PS' ] ],
  [ is_directory => [ qw(PS) ],
    [ not => [ exists_path => 'PS' ] ],
    [ act => [ 'PS' ], sub {
        DX::Lib::FS::Action::CreateDirectory->new(
          path => $_[0]->path
        )
      } ] ],
  [ is_file => [ qw(PS) ],
    [ not => [ exists_path => 'PS' ] ],
    [ act => [ 'PS' ], sub {
        DX::Lib::FS::Action::CreateFile->new(
          path => $_[0]->path
        )
      } ] ],
  [ directory_in => [ qw(DirStatus DirName SubDirStatus) ],
    [ is_directory => qw(DirStatus) ],
    [ exists => [ qw(DirPath) ],
      [ path => qw(DirStatus DirPath) ],
      [ exists => [ qw(SubDirPath) ],
        [ catfile => qw(DirPath DirName SubDirPath) ],
        [ directory_at => qw(SubDirStatus SubDirPath) ] ] ] ],
  [ file_in => [ qw(DirStatus FileName FileStatus) ],
    [ is_directory => qw(DirStatus) ],
    [ exists => [ qw(DirPath) ],
      [ path => qw(DirStatus DirPath) ],
      [ exists => [ qw(FilePath) ],
        [ catfile => qw(DirPath FileName FilePath) ],
        [ file_at => qw(FileStatus FilePath) ] ] ] ],
);

sub load_into {
  my ($self, $solver) = @_;
  $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
  $solver->add_predicate(
    catdir => [ qw(DirPath DirName SubDirPath) ],
      [ qw(+ + -) ] => sub {
        +(SubDirPath => [
           value => File::Spec->catdir($_{DirPath}, $_{DirName})
        ])
      },
      [ qw(- - +) ] => sub {
        my @split = File::Spec->splitdir($_{SubDirPath});
        my $last = pop @split;
        my $rest = File::Spec->catdir(@split);
        +(DirPath => [ value => $rest ], DirName => [ value => $last ])
      }
  );
  $solver->add_predicate(
    catfile => [ qw(DirPath FileName FilePath) ],
      [ qw(+ + -) ] => sub {
        my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1);
        my $file_path = File::Spec->catpath($vol, $dir, $_{FilePath});
        +(FilePath => [ value => $file_path ])
      },
      [ qw(- - +) ] => sub {
        my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath});
        my $dir_path = File::Spec->catpath($vol, $dir);
        +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
      }
  );
  $solver->add_rule(@$_) for @RULES;
}

1;