Paste: Testing levels deployment levels (level 1: fail - level 6: ok)

USING: kernel io namespaces accessors continuations present 
  sequences math.order system io.encodings.utf8 io.files 
  words io.pathnames command-line sets debugger formatting
  combinators strings urls math fry splitting slots ;

IN: deb2packont 

: last2 ( seq -- penultimate ultimate ) 2 tail* first2 ;

TUPLE: package name version distribution cpe provides depends installs ;

TUPLE: mstring value ;

C: <mstring> mstring

M: mstring present value>> present ; 

GENERIC: >ttl-object ( value -- term )

M: string >ttl-object
  "\"" dup swapd 3append ;

: contains-nl? ( string -- ? )
  [ CHAR: \n = ] find nip CHAR: \n = ;

M: mstring >ttl-object 
  present 
  dup contains-nl?
  [ "\"\"\"" ] [ "\"" ] if
  dup surround ;

GENERIC: >ttl-triples ( value -- string )

GENERIC: package-filename ( package -- string )

TUPLE: deb-package < package description priority section maintainer
    architecture installed-size package-size filename md5sum archives 
    pre-depends recommends suggests enhances breaks conflicts replaces 
    provided-by homepage tags essential ;

C: <deb-package> deb-package
    
M: url >ttl-object 
  present "<" ">" surround ;

ERROR: unknown-data value ;

M: unknown-data error.
  "No recognized data:\n\n" write
  value>> 
  dup length 100 <= 
  [ print ] [ 
    100 head write "..." print
  ] if ;

: >deb-package ( string -- deb-package )
  drop 
  T{ deb-package
     { name "a2ps" }
     { description
       T{ mstring
          { value
            "GNU a2ps - 'Anything to PostScript' converter and pretty-prin..."
          }
       }
     }
     { priority "optional" }
     { section "text" }
     { filename "pool/main/a/a2ps/a2ps_4.14-1.3_amd64.deb" }
     { md5sum "5951cb6c5aa9b01a0badd1fa473ed545" }
  } ;

M: f >ttl-object 
  present ;

M: sequence >ttl-object
  [ >ttl-object ] map ", " join ;

: p>accessor ( p -- accessor )
  ":" split last reader-word ;

: p-o-quot ( attr-name -- quot )
  '[ _ dup p>accessor swapd execute >ttl-object 
     dup empty? 
     [ 2drop ] [
       "   %s %s ;" sprintf suffix!
     ] if ] ;
                 
M: deb-package >ttl-triples
  V{ } swap
  { "deb:name" "deb:version" "deb:priority" "deb:section" "deb:maintainer" 
    "deb:filename" "deb:md5sum" "deb:description" "deb:homepage" "deb:depends"
    "deb:pre-depends" "deb:suggests" "deb:conflicts" "deb:recommends" "deb:breaks"
    "deb:replaces" "deb:provides" "deb:provided-by" "deb:tags" "deb:enhances"
  } [ p-o-quot ] map 
  [ call( vector package -- vector ) ] with each
  "\n" join ;

M: deb-package package-filename
  [ name>> ] [ architecture>> ] [ version>> ] tri
  "%s:%s-%s.deb" sprintf ;

: main ( -- )
  "discarded-string"
  [ >deb-package
    >ttl-triples print
  ] [
    nip print-error
  ] recover ;

 
MAIN: main
Author:	roberto.lopez
Mode:	factor
Date:	Thu, 11 Dec 2014 10:19:03