extra/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 combinators.short-circuit
   5 formatting hashtables io io.streams.string kernel make math
   6 namespaces 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   0x08 } ! \b
  16         { CHAR: f   0x0c } ! \f
  17         { CHAR: n   CHAR: \n }
  18         { CHAR: r   CHAR: \r }
  19         { CHAR: t   CHAR: \t }
  20         { CHAR: v   0x0b } ! \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 USE: xml.entities
  42
  43 : escape-string ( str -- str' )
  44     H{
  45         { CHAR: \a   "\\a"  }
  46         { 0x08    "\\b"  }
  47         { 0x0c    "\\f"  }
  48         { CHAR: \n   "\\n"  }
  49         { CHAR: \r   "\\r"  }
  50         { CHAR: \t   "\\t"  }
  51         { 0x0b    "\\v"  }
  52         { CHAR: '    "\\'"  }
  53         { CHAR: "    "\\\"" }
  54         { CHAR: \\   "\\\\" }
  55         { CHAR: ?    "\\?"  }
  56         { CHAR: ;    "\\;"  }
  57         { CHAR: [    "\\["  }
  58         { CHAR: ]    "\\]"  }
  59         { CHAR: =    "\\="  }
  60     } escape-string-by ;
  61
  62 : space? ( ch -- ? )
  63     {
  64         [ CHAR: \s = ]
  65         [ CHAR: \t = ]
  66         [ CHAR: \n = ]
  67         [ CHAR: \r = ]
  68         [ 0x0c = ] ! \f
  69         [ 0x0b = ] ! \v
  70     } 1|| ;
  71
  72 : unspace ( str -- str' )
  73     [ space? ] trim ;
  74
  75 : unwrap ( str -- str' )
  76     1 swap [ length 1 - ] keep subseq ;
  77
  78 : uncomment ( str -- str' )
  79     ";#" [ over index [ head ] when* ] each ;
  80
  81 : cleanup-string ( str -- str' )
  82     unspace unquote unescape-string ;
  83
  84 SYMBOL: section
  85 SYMBOL: option
  86
  87 : section? ( line -- index/f )
  88     {
  89         [ length 1 > ]
  90         [ first CHAR: [ = ]
  91         [ CHAR: ] swap last-index ]
  92     } 1&& ;
  93
  94 : line-continues? ( line -- ? )
  95     { [ empty? not ] [ last CHAR: \ = ] } 1&& ;
  96
  97 : section, ( -- )
  98     section get [ , ] when* ;
  99
 100 : option, ( name value -- )
 101     section get [ second swapd set-at ] [ 2array , ] if* ;
 102
 103 : [section] ( line -- )
 104     unwrap cleanup-string H{ } clone 2array section set ;
 105
 106 : name=value ( line -- )
 107     option [
 108         [ swap [ first2 ] dip ] [
 109             "=" split1 [ cleanup-string "" ] [ "" or ] bi*
 110         ] if*
 111         dup line-continues? [
 112             dup length 1 - head cleanup-string
 113             dup last space? [ " " append ] unless append 2array
 114         ] [
 115             cleanup-string append option, f
 116         ] if
 117     ] change ;
 118
 119 : parse-line ( line -- )
 120     uncomment unspace dup section? [
 121         section, 1 + cut [ [section] ] [ unspace ] bi*
 122     ] when* [ name=value ] unless-empty ;
 123
 124 PRIVATE>
 125
 126 : read-ini ( -- assoc )
 127     section off option off
 128     [ [ parse-line ] each-line section, ] { } make
 129     >hashtable ;
 130
 131 : write-ini ( assoc -- )
 132     [
 133         dup string?
 134         [ [ escape-string ] bi@ "%s=%s\n" printf ]
 135         [
 136             [ escape-string "[%s]\n" printf ] dip
 137             [ [ escape-string ] bi@ "%s=%s\n" printf ]
 138             assoc-each nl
 139         ] if
 140     ] assoc-each ;
 141
 142 ! FIXME: escaped comments "\;" don't work
 143
 144 : string>ini ( str -- assoc )
 145     [ read-ini ] with-string-reader ;
 146
 147 : ini>string ( assoc -- str )
 148     [ write-ini ] with-string-writer ;
 149