147 lines
		
	
	
		
			4.2 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			147 lines
		
	
	
		
			4.2 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| /* 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)
 | |
|   )
 | 
