basis/ini-file/ini-file.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: arrays assocs combinators.short-circuit formatting
   5 hashtables io io.streams.string kernel make math namespaces
   6 quoting sequences splitting strings strings.parser ;
   7
   8 IN: ini-file
   9
  10 <PRIVATE
  11
  12 : escape ( ch -- ch' )
  13     H{
  14         { CHAR: a   CHAR: \a }
  15         { CHAR: b   CHAR: \b }
  16         { CHAR: f   CHAR: \f }
  17         { CHAR: n   CHAR: \n }
  18         { CHAR: r   CHAR: \r }
  19         { CHAR: t   CHAR: \t }
  20         { CHAR: v   CHAR: \v }
  21         { CHAR: '   CHAR: ' }
  22         { CHAR: \"  CHAR: \" }
  23         { CHAR: \\  CHAR: \\ }
  24         { CHAR: ?   CHAR: ? }
  25         { CHAR: ;   CHAR: ; }
  26         { CHAR: [   CHAR: [ }
  27         { CHAR: ]   CHAR: ] }
  28         { CHAR: =   CHAR: = }
  29     } ?at [ bad-escape ] unless ;
  30
  31 : (unescape-string) ( str -- )
  32     CHAR: \\ over index [
  33         cut-slice [ % ] dip rest-slice
  34         dup empty? [ "Missing escape code" throw ] when
  35         unclip-slice escape , (unescape-string)
  36     ] [ % ] if* ;
  37
  38 : unescape-string ( str -- str' )
  39     [ (unescape-string) ] "" make ;
  40
  41 : escape-string ( str -- str' )
  42     [
  43         [
  44             H{
  45                 { CHAR: \a   "\\a"  }
  46                 { CHAR: \b   "\\b"  }
  47                 { CHAR: \f   "\\f"  }
  48                 { CHAR: \n   "\\n"  }
  49                 { CHAR: \r   "\\r"  }
  50                 { CHAR: \t   "\\t"  }
  51                 { CHAR: \b   "\\v"  }
  52                 { CHAR: '    "\\'"  }
  53                 { CHAR: \"   "\\\"" }
  54                 { CHAR: \\   "\\\\" }
  55                 { CHAR: ?    "\\?"  }
  56                 { CHAR: ;    "\\;"  }
  57                 { CHAR: [    "\\["  }
  58                 { CHAR: ]    "\\]"  }
  59                 { CHAR: =    "\\="  }
  60             } ?at [ % ] [ , ] if
  61         ] each
  62     ] "" make ;
  63
  64 : space? ( ch -- ? )
  65     "\s\t\n\r\f\v" member-eq? ;
  66
  67 : unspace ( str -- str' )
  68     [ space? ] trim ;
  69
  70 : unwrap ( str -- str' )
  71     1 swap index-of-last subseq ;
  72
  73 : uncomment ( str -- str' )
  74     ";#" [ over index [ head ] when* ] each ;
  75
  76 : cleanup-string ( str -- str' )
  77     unspace unquote unescape-string ;
  78
  79 SYMBOL: section
  80 SYMBOL: option
  81
  82 : section? ( line -- index/f )
  83     {
  84         [ length 1 > ]
  85         [ first CHAR: [ = ]
  86         [ CHAR: ] swap last-index ]
  87     } 1&& ;
  88
  89 : line-continues? ( line -- ? )
  90     ?last CHAR: \ = ;
  91
  92 : section, ( -- )
  93     section get [ , ] when* ;
  94
  95 : option, ( name value -- )
  96     section get [ second swapd set-at ] [ 2array , ] if* ;
  97
  98 : [section] ( line -- )
  99     unwrap cleanup-string H{ } clone 2array section set ;
 100
 101 : name=value ( line -- )
 102     option [
 103         [ swap [ first2 ] dip ] [
 104             "=" split1 [ cleanup-string "" ] [ "" or ] bi*
 105         ] if*
 106         dup line-continues? [
 107             dup length 1 - head cleanup-string
 108             dup last space? [ " " append ] unless append 2array
 109         ] [
 110             cleanup-string append option, f
 111         ] if
 112     ] change ;
 113
 114 : parse-line ( line -- )
 115     uncomment unspace dup section? [
 116         section, 1 + cut [ [section] ] [ unspace ] bi*
 117     ] when* [ name=value ] unless-empty ;
 118
 119 PRIVATE>
 120
 121 : read-ini ( -- assoc )
 122     section off option off
 123     [ [ parse-line ] each-line section, ] { } make
 124     >hashtable ;
 125
 126 : write-ini ( assoc -- )
 127     [
 128         dup string? [
 129             [ escape-string ] bi@ "%s=%s\n" printf
 130         ] [
 131             [ escape-string "[%s]\n" printf ] dip
 132             [ [ escape-string ] bi@ "%s=%s\n" printf ]
 133             assoc-each nl
 134         ] if
 135     ] assoc-each ;
 136
 137 ! FIXME: escaped comments "\;" don't work
 138
 139 : string>ini ( str -- assoc )
 140     [ read-ini ] with-string-reader ;
 141
 142 : ini>string ( assoc -- str )
 143     [ write-ini ] with-string-writer ;