#lang scheme/base
(require scheme/string
scheme/file
scheme/runtime-path
scheme/port
scheme/path
scheme/contract
scheme/list
(only-in xml xexpr->string)
"../compile-helpers.ss"
"../collects/moby/runtime/permission-struct.ss"
"../compiler/pinfo.ss"
(only-in "../compiler/helpers.ss" program?)
(prefix-in javascript: "../compiler/beginner-to-javascript.ss")
(only-in "../compiler/helpers.ss" identifier->munged-java-identifier)
"../utils.ss"
"../template.ss"
"../config.ss"
"../program-resources.ss")
(define-runtime-path phonegap-path "../../support/phonegap-fork/android-1.5")
(define-runtime-path icon-path "../../support/icons/icon.png")
(define-runtime-path javascript-support-path "../../support/js")
(define-runtime-path javascript-main-template "../../support/js/main.js.template")
(define (build-android-package program-name program/resources)
(with-temporary-directory
(lambda (dir)
(let ([dest (simplify-path (build-path dir program-name))])
(build-android-package-in-path program-name
program/resources
dest)
(get-file-bytes
(first (find-files (lambda (a-path)
(equal? (filename-extension a-path)
#"apk"))
dest)))))))
(define (build-android-package-in-path name program/resources dest)
(unless (file-exists? (current-ant-bin-path))
(error 'build-android-package-in-path
"The Apache ant binary appears to be missing from the current PATH."))
(unless (directory-exists? (current-android-sdk-path))
(error 'build-android-package-in-path
"The Android SDK could not be found."))
(make-directory* dest)
(copy-directory/files* phonegap-path dest)
(let* ([normal-name (normalize-name name)]
[classname (upper-camel-case normal-name)]
[package (string-append "plt.moby." classname)]
[compiled-program
(write-main.js&resources program/resources
name
(build-path dest "assets"))])
(make-directory* (build-path dest "res" "drawable"))
(copy-or-overwrite-file icon-path (build-path dest "res" "drawable" "icon.png"))
(copy-or-overwrite-file (build-path phonegap-path "assets" "phonegap.js")
(build-path dest "assets" "runtime" "phonegap.js"))
(write-android-manifest (build-path dest "AndroidManifest.xml")
#:name name
#:package package
#:activity-class (string-append package "." classname)
#:permissions (apply append
(map permission->android-permissions
(pinfo-permissions
(javascript:compiled-program-pinfo compiled-program)))))
(call-with-output-file (build-path dest "local.properties")
(lambda (op)
(fprintf op "sdk-location=~a~n" (path->string (current-android-sdk-path)))
(fprintf op "sdk.dir=~a~n" (path->string (current-android-sdk-path))))
#:exists 'replace)
(let* ([build-xml-bytes (get-file-bytes (build-path dest "build.xml"))]
[build-xml-bytes (regexp-replace #rx"DroidGap"
build-xml-bytes
(string->bytes/utf-8 classname))])
(call-with-output-file (build-path dest "build.xml")
(lambda (op) (write-bytes build-xml-bytes op))
#:exists 'replace))
(let* ([strings-xml-bytes (get-file-bytes (build-path dest "res" "values" "strings.xml"))]
[strings-xml-bytes (regexp-replace #rx"DroidGap"
strings-xml-bytes
(string->bytes/utf-8 (xexpr->string name)))])
(call-with-output-file (build-path dest "res" "values" "strings.xml")
(lambda (op) (write-bytes strings-xml-bytes op))
#:exists 'replace))
(make-directory* (build-path dest "src" "plt" "moby" classname))
(let* ([middleware
(get-file-bytes (build-path dest "src" "com" "phonegap" "demo" "DroidGap.java"))]
[middleware
(regexp-replace #rx"package com.phonegap.demo;\n"
middleware
(string->bytes/utf-8 (format "package plt.moby.~a;\nimport com.phonegap.demo.*;\n" classname)))]
[middleware
(regexp-replace #rx"DroidGap"
middleware
(string->bytes/utf-8 classname))])
(call-with-output-file (build-path dest "src" "plt" "moby" classname (format "~a.java" classname))
(lambda (op)
(write-bytes middleware op))
#:exists 'replace)
(delete-file (build-path dest "src" "com" "phonegap" "demo" "DroidGap.java")))
(run-ant-build.xml dest "debug")))
(define (normalize-name a-name)
(let ([a-name (regexp-replace* #px"[^\\w\\s]+" a-name "")])
(cond
[(or (= (string-length a-name) 0)
(not (char-alphabetic? (string-ref a-name 0))))
(string-append "_" a-name)]
[else
a-name])))
(define (write-main.js&resources program/resources name dest-dir)
(log-info (format "Compiling ~a to ~s" name dest-dir))
(make-javascript-directories dest-dir)
(program/resources-write-resources! program/resources dest-dir)
(let*-values ([(program)
(program/resources-program program/resources)]
[(compiled-program)
(do-compilation program)])
(call-with-output-file (build-path dest-dir "main.js")
(lambda (op)
(copy-port (open-input-string
(compiled-program->main.js compiled-program))
op))
#:exists 'replace)
(delete-file (build-path dest-dir "main.js.template"))
compiled-program))
(define (write-android-manifest path
#:name name
#:package package
#:activity-class activity-class
#:permissions (permissions '()))
(call-with-output-file path
(lambda (op)
(display (get-android-manifest #:name name
#:package package
#:activity-class activity-class
#:permissions permissions) op))
#:exists 'replace))
(define (get-android-manifest #:name name
#:package package
#:activity-class activity-class
#:permissions (permissions '()))
(let ([AndroidManifest.xml
`(manifest
((xmlns:android "http://schemas.android.com/apk/res/android")
(package ,package)
(android:versionCode "1")
(android:versionName "1.0.0"))
(uses-sdk ((android:minSdkVersion "2")))
,@(map (lambda (p)
`(uses-permission ((android:name ,p))))
permissions)
(application
((android:label "@string/app_name")
(android:icon "@drawable/icon"))
(activity ((android:name ,activity-class)
(android:label ,name)
(android:configChanges
"keyboardHidden|orientation"))
(intent-filter
()
(action ((android:name "android.intent.action.MAIN")))
(category
((android:name
"android.intent.category.LAUNCHER")))))
(activity ((android:name "plt.playlist.PickPlaylist")
(android:label "PickPlaylist")
(android:configChanges
"keyboardHidden|orientation"))
(action ((android:name "android.intent.action.PICK")))
(category ((android:name "android.intent.category.DEFAULT"))))))])
(xexpr->string AndroidManifest.xml)))
(define (subdirectory-of? parent-dir -a-dir)
(let ([parent-dir (normalize-path parent-dir)])
(let loop ([a-dir (normalize-path -a-dir)])
(cond [(string=? (path->string parent-dir)
(path->string a-dir))
#t]
[else
(let ([new-subdir (normalize-path (simplify-path (build-path a-dir 'up)))])
(cond [(string=? (path->string new-subdir)
(path->string a-dir))
#f]
[else
(loop new-subdir)]))]))))
(define (make-javascript-directories dest-dir)
(make-directory* dest-dir)
(when (subdirectory-of? javascript-support-path dest-dir)
(error 'moby "The output directory (~s) must not be a subdirectory of ~s."
(path->string (normalize-path dest-dir))
(path->string (normalize-path javascript-support-path))))
(for ([subpath (list "css" "runtime")])
(copy-directory/files* (build-path javascript-support-path subpath)
(build-path dest-dir subpath)))
(for ([file (list "index.html" "main.js.template")])
(when (file-exists? (build-path dest-dir file))
(delete-file (build-path dest-dir file)))
(copy-file (build-path javascript-support-path file)
(build-path dest-dir file))))
(define (do-compilation program)
(javascript:program->compiled-program/pinfo program (get-base-pinfo 'moby)))
(define (get-permission-js-array perms)
(string-append "["
(string-join (map (lambda (x)
(format "plt.Kernel.invokeModule('moby/runtime/permission-struct').EXPORTS['string->permission'](~s)" (permission->string x)))
perms)
", ")
"]"))
(define (compiled-program->main.js compiled-program)
(let*-values ([(defns pinfo)
(values (javascript:compiled-program-defns compiled-program)
(javascript:compiled-program-pinfo compiled-program))]
[(output-port) (open-output-string)]
[(mappings)
(build-mappings
(PROGRAM-DEFINITIONS defns)
(IMAGES (string-append "[" "]"))
(PROGRAM-TOPLEVEL-EXPRESSIONS
(javascript:compiled-program-toplevel-exprs
compiled-program))
(PERMISSIONS (get-permission-js-array (pinfo-permissions pinfo))))])
(fill-template-port (open-input-file javascript-main-template)
output-port
mappings)
(get-output-string output-port)))
(provide/contract [build-android-package
(string? program/resources? . -> . bytes?)]
[build-android-package-in-path
(string? program/resources? path-string? . -> . any)])