a3384bf0b6a43377d06935c0a517d1020a433ad9
[scpubgit/DX.git] / 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 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 step {
48   require DX::Step::Normal;
49   DX::Step::Normal->new(@_);
50 }
51
52 sub string {
53   require DX::Value::String;
54   DX::Value::String->new(string_value => $_[0])
55 }
56
57 sub number {
58   require DX::Value::Number;
59   DX::Value::Number->new(number_value => $_[0]);
60 }
61
62 sub dict {
63   require DX::Value::Dict;
64   DX::Value::Dict->new(
65     members => { @_ },
66   );
67 }
68
69 sub proposition {
70   my ($pred, @args) = @_;
71   require DX::Proposition;
72   DX::Proposition->new(
73     predicate => $pred,
74     args => \@args,
75   );
76 }
77
78 {
79   my $dp;
80
81   sub deparse {
82     $dp ||= do {
83       require DX::Deparse;
84       DX::Deparse->new;
85     };
86     my ($thing) = @_;
87     $dp->fmt($thing);
88   }
89 }
90
91 1;