/* Tool to sort attribute sets. Primarily useful for keeping all-packages.nix tidy. To compile: $ strc -i ../../maintainers/scripts/sort-attrs.str -la stratego-lib Typical invocation: $ sglr -m -p ~/Dev/nix/src/libexpr/nix.tbl -i all-packages.nix \ | implode-asfix --lex \ | ../../maintainers/scripts/sort-attrs \ | asfix-yield */ module sort-attrs imports libstratego-lib libstratego-sglr strategies no-wsp = !appl(prod([], cf(opt(layout())), no-attrs()), []) rules list-sep(s): [] -> [] list-sep(s): [x | xs] -> [[x | before] | <list-sep(s)> [split | after]] where <split-fetch-keep(s)> xs => (before, split, after) list-sep(s): [x | xs] -> [[x | xs]] where <not(split-fetch-keep(s))> xs list-sep-end(s): xs -> [<conc> (before, [split]) | <list-sep-end(s)> after] where <split-fetch-keep(s)> xs => (before, split, after) list-sep-end(s): xs -> [xs] where <not(split-fetch-keep(s))> xs sort-attrs: appl(p@prod(_, _, attrs([term(cons("Attrs"))])), [ lit("{") , ws1 , appl(p2@list(cf(iter-star(sort("Bind")))), attrs) , ws2 , lit("}") ] ) -> appl(p, [lit("{"), <no-wsp>, appl(p2, <concat> attrs'), ws2, lit("}")]) where <debug> "found it"; <attach-wsp> [ws1 | attrs] => withWSP; <list-sep(starts-section)> withWSP => groups; <length; debug> groups; <map({x', x'', x''', xs', starts, starts': \[x | xs] -> [x''' | xs'] where <remove-section-start> x => (x', starts); <map(regularise-empty-lines); if !starts; debug; sortable-section; debug then qsort(compare-attrs) else id end> [x' | xs] => [x'' | xs']; <[] <+ \x -> ["\n\n\n" | x]\ > starts => starts'; <prepend-layout> (starts', x'') => x''' \ })> groups => attrs'; <debug> "did it" attach-wsp: [a, b | cs] -> [(a, b) | <attach-wsp> cs] attach-wsp: [] -> [] strategies starts-section = ?x@(appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs), attr); <implode-string; is-substring(!"###")> cs; !x rules sortable-section = ?[s]; !s; explode-string; not(fetch({x: ?x; !(x, 97); geq})) remove-section-start: (appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs), attr) -> ((appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs'), attr), starts) where !cs; list-sep-end(?10); // separate into lines, keeping the \n map(implode-string); partition(where(is-substring(!"###"))) => (starts, rest); <map(explode-string); concat> rest => cs' regularise-empty-lines: (appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs), attr) -> (appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs''), attr) where // separate into lines, keeping the \n // last whitespace is significant, keep <list-sep-end(?10); split-init-last> cs => (init, last); <regularise-empty-lines'> init => cs'; // remove whitespace-only lines <concat> [<explode-string> "\n\n", <concat> cs', last] => cs'' // add one empty line /* Dirty hack: *do* keep the first empty line following a non-empty line. !!! order matters */ regularise-empty-lines': [] -> [] regularise-empty-lines': [x, y | xs] -> [x, y | <regularise-empty-lines'> xs] where <fetch-elem(not(?10 <+ ?32))> x; <not(fetch-elem(not(?10 <+ ?32)))> y regularise-empty-lines': [x | xs] -> [x | <regularise-empty-lines'> xs] where <fetch-elem(not(?10 <+ ?32))> x regularise-empty-lines': [x | xs] -> <regularise-empty-lines'> xs where <not(fetch-elem(not(?10 <+ ?32)))> x prepend-layout: (text, (appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs), attr)) -> (appl(prod([cf(layout())], cf(opt(layout())), no-attrs()), cs''), attr) where <implode-string> cs => cs'; <conc-strings; explode-string> (<concat-strings> text, cs') => cs'' compare-attrs: x@ ( (_, appl(p1@prod(_, _, attrs([term(cons("Bind"))])), [id1 | xs1])) , (_, appl(p2@prod(_, _, attrs([term(cons("Bind"))])), [id2 | xs2])) ) -> x where <string-lt> (id1, id2) strategies main = io-wrap( oncetd(sort-attrs) )