lib/DX/Utils.pm

   1 package DX::Utils;
   2
   3 use strictures 2;
   4 use Exporter 'import';
   5
   6 my @const = (
   7   my @dep_types = qw(EXISTENCE_OF TYPE_OF INDICES_OF CONTENTS_OF),
   8   my @ev_types = qw(VALUE_SET VALUE_EXISTS),
   9 );
  10
  11 our @EXPORT_OK = (
  12   @const,
  13   (my @builders = qw(step rspace rstrat res string number dict proposition)),
  14   'deparse', '*trace',
  15 );
  16
  17 our %EXPORT_TAGS = (
  18   all => \@EXPORT_OK,
  19   dep_types => \@dep_types,
  20   event_types => \@ev_types,
  21   builders => \@builders,
  22 );
  23
  24 require constant;
  25
  26 # use constant INDICES_OF => \*INDICES_OF;
  27
  28 constant->import(+{
  29   map {; no strict 'refs'; $_ => \*$_ } @const
  30 });
  31
  32 # $EXISTENCE_OF = 1, ...
  33
  34 do { no strict 'refs'; ${$dep_types[$_-1]} = $_ } for 1..@dep_types;
  35
  36 # VALUE_EXISTS needs to trigger indices checks on its parent
  37
  38 our $VALUE_EXISTS = 1;
  39
  40 # VALUE_EXISTS triggers all types, VALUE_SET all but EXISTENCE_OF
  41
  42 our @VALUE_EXISTS = (EXISTENCE_OF(), TYPE_OF(), INDICES_OF(), CONTENTS_OF());
  43 our @VALUE_SET = (TYPE_OF(), INDICES_OF(), CONTENTS_OF());
  44
  45 sub trace { }
  46
  47 sub _expand_dep {
  48   my ($type, @path) = @{$_[0]};
  49   my @expanded = map {
  50     ref() ? @{$_->value_path or return ()} : $_
  51   } @path;
  52   return [ $type, @expanded ];
  53 }
  54
  55 sub _expand_deps {
  56   [ map _expand_dep($_), @{$_[0]} ]
  57 }
  58
  59 sub step {
  60   require DX::Step::ResolveProposition;
  61   my %args = @_;
  62   DX::Step::ResolveProposition->new(
  63     %args,
  64     depends_on => _expand_deps($args{depends_on}),
  65   );
  66 }
  67
  68 sub rspace {
  69   require DX::ResolutionSpace;
  70   DX::ResolutionSpace->new(@_);
  71 }
  72
  73 sub rstrat {
  74   require DX::ResolutionStrategy;
  75   DX::ResolutionStrategy->new(@_);
  76 }
  77
  78 sub res {
  79   require DX::Resolution;
  80   DX::Resolution->new(@_);
  81 }
  82
  83 sub string {
  84   require DX::Value::String;
  85   DX::Value::String->new(string_value => $_[0])
  86 }
  87
  88 sub number {
  89   require DX::Value::Number;
  90   DX::Value::Number->new(number_value => $_[0]);
  91 }
  92
  93 sub dict {
  94   require DX::Value::Dict;
  95   DX::Value::Dict->new(
  96     members => { @_ },
  97   );
  98 }
  99
 100 sub proposition {
 101   my ($pred, @args) = @_;
 102   require DX::Proposition;
 103   DX::Proposition->new(
 104     predicate => $pred,
 105     args => \@args,
 106   );
 107 }
 108
 109 {
 110   my $dp;
 111
 112   sub deparse {
 113     $dp ||= do {
 114       require DX::TraceFormatter;
 115       DX::TraceFormatter->new;
 116     };
 117     my ($thing) = @_;
 118     $dp->format($thing);
 119   }
 120 }
 121
 122 1;