basis/io/encodings/iana/iana.factor

   1 ! Copyright (C) 2008 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel strings values io.files assocs
   4 splitting sequences io namespaces sets io.encodings.utf8 ;
   5 IN: io.encodings.iana
   6
   7 <PRIVATE
   8 SYMBOL: n>e-table
   9 SYMBOL: e>n-table
  10 SYMBOL: aliases
  11 PRIVATE>
  12
  13 ERROR: missing-encoding name ;
  14
  15 : name>encoding ( name -- encoding )
  16     dup n>e-table get-global at [ ] [ missing-encoding ] ?if ;
  17
  18 ERROR: missing-name encoding ;
  19
  20 : encoding>name ( encoding -- name )
  21     dup e>n-table get-global at [ ] [ missing-name ] ?if ;
  22
  23 <PRIVATE
  24 : parse-iana ( stream -- synonym-set )
  25     lines { "" } split [
  26         [ " " split ] map
  27         [ first { "Name:" "Alias:" } member? ] filter
  28         [ second ] map { "None" } diff
  29     ] map harvest ;
  30
  31 : make-aliases ( stream -- n>e )
  32     parse-iana [ [ first ] [ ] bi ] H{ } map>assoc ;
  33
  34 : initial-n>e ( -- assoc )
  35     H{
  36         { "UTF8" utf8 }
  37         { "utf8" utf8 }
  38         { "utf-8" utf8 }
  39         { "UTF-8" utf8 }
  40     } clone ;
  41
  42 : initial-e>n ( -- assoc )
  43     H{ { utf8 "UTF-8" } } clone ;
  44
  45 PRIVATE>
  46
  47 "vocab:io/encodings/iana/character-sets"
  48 utf8 <file-reader> make-aliases aliases set-global
  49
  50 n>e-table [ initial-n>e ] initialize
  51 e>n-table [ initial-e>n ] initialize
  52
  53 : register-encoding ( descriptor name -- )
  54     [
  55         aliases get at [
  56             [ n>e-table get-global set-at ] with each
  57         ] [ "Bad encoding registration" throw ] if*
  58     ] [ swap e>n-table get-global set-at ] 2bi ;