Paste: start of multipart [ first try ] (erg plz take a look)

IN: multipart-upload

USING: io.pathnames io.files sequences arrays math.parser kernel combinators accessors 
       io.encodings.binary io.encodings.string ;

! This is just re-creating a captured example, so it's a specific use case, and should be generalized, according to the spec.

! Things I'm not sure about: 1) if length should be part of it.
!                            2) how to combine text with binary. 
! right now I convert the text to binary and append the file to it.
! I prefer to have data passed until the last moment, but will use write if the file gets corrupted otherwise.

! EXAMPLE:
! { } "HI I'm the content" "here's the field name!" <text-part> suffix
! "C:/video/2009/01-January-2009/01/SINGLE NEWS wmv and PHOTOS gif/20090101-01-China_Stocks_Biggest_Loser_in_2008.wmv"
! "file name field" <file-part> suffix
! "----------l3PMNll8CXjZ5BC7GGnaMo" build-multi-part
! "E:/mimetest2.txt" utf8 set-file-contents


TUPLE: text-part { content-disposition initial: "form-data" } field-name content ;
TUPLE: file-part file { content-disposition initial: "form-data" } field-name filename mimetype raw ;


: content-type-from-ext ( filename -- type )
    file-extension
    {
        {        [ "wmv" = ] [ "video/x-ms-wmv" ] }
        [ "sorry I don't know this type, please add the correct mimetype" throw  ]
    } cond ;

: content-type-by-data ( file -- type )
    ! a 'magic number' guesser. binding to 'file' or tap into its magic file. 
    "UNIMPLEMENTED. FUTURE WORK" throw ;

: content-type ( file -- type )
    content-type-from-ext ;
    

: <text-part> ( content field-name -- tuple )
    text-part new
    swap >>field-name
    swap >>content ;
    
: <file-part> ( file field-name -- tuple )
    file-part new
    swap >>field-name
    swap [ >>file ] [    
        [ file-name >>filename ] [ content-type >>mimetype ] [ binary file-contents >>raw ] tri 
                    ] bi ;
    
: nl+ ( str -- str ) "\r\n" prepend ;
: +nl ( str -- str ) "\r\n" append ;
: +2nl ( str -- str ) +nl +nl ;

: quote-me ( str -- str ) "\"" dup surround ;
: crlf-me ( str -- str ) "\r\n" dup surround ;

: dispo+name ( tuple -- dispo name )
    [ content-disposition>> "Content-Disposition: " prepend ]
    [ field-name>> quote-me "name=" prepend ] bi  ;


: build-file-part ( tuple -- str ) 
    [
        [ 
            [ dispo+name ] 
            [ filename>> quote-me "filename=" prepend ] bi 3array "; " join +nl 
        ]
        [ mimetype>> "Content-Type: " prepend +nl ] bi append 
        +nl binary decode
    ]    
    [ raw>> ] bi  append ; 
    

: build-text-part ( tuple -- str )
    [ dispo+name 2array "; " join +nl ] [ content>> nl+ ] bi append ;

: build-one-part ( tuple -- str )
    {
        { [ dup file-part? ] [ build-file-part ] }
        { [ dup text-part? ] [ build-text-part ] }
        [ "ERROR: expected a text-part or a file-part tuple" throw ]
    } cond ;

: content-length-txt ( str -- length-str )
    length number>string
    "Content-Length: " prepend +nl ;
    
: content-type-txt ( boundary -- str )
    "Content-Type: multipart/form-data; boundary=" prepend +nl ;

: -over ( x y -- y x y )
    dup -rot ;    
    
: join+before ( seq chars -- str )
    [ join ] keep prepend ;
    
    
: build-multi-part ( parts-seq boundary -- string ) ! seq of tuples and a boundary.
    swap
    [ text-part? ] partition append
    [ build-one-part ] map  
    over "--" prepend crlf-me join+before         ! boundary seq -> boundary seq boundary' -> boundary str
    -over [ content-length-txt ] [ content-type-txt ] [ ] tri*
    3append ;