/**
 * Serialized Dryad repositories.
 *
 * This module defines the structure of a serialized Dryad repository
 * and provides strategies to (de)serialize such a serialized repository.
 */
module dryad/model/classpath
imports
  liblib
  dryad/jls/binary/Form
  dryad/model/repository

signature
  constructors

   /**
    * Constructor for exported packages.
    *
    * @param SimpleName of this package
    * @param List of subpackages
    * @param List of top level classes
    */    
   Package : String * List(ExportedPackage) * List(ExportedClass) -> ExportedPackage
   
   /**
    * Constructor for exported classes.
    *   
    * @param SimpleName of this class
    * @param Location of this class
    * @param Member classes of this class
    */
   Class   : String * Location * List(ExportedClass) -> ExportedClass

   /**
    * Constructor for the location of source files.
    *
    * @param Path of source file
    */
   Source : String -> Location

   /**
    * Constructor for the location of a bytecode .class file.
    *
    * @param Path of .class file
    */
   ClassFile : String -> Location

   /**
    * Constructor for the location of a class file in a jar.
    *   
    * @param Path of jar file
    * @param Path of class file in jar file
    */
   Jar     : String * String -> Location

strategies

  /**
   * Defines the classes in the specified jar file in the Dryad repository.
   *
   * @type String -> ?
   */
  define-jar-entries =
    ?jar; where(
      xtc-new-ffd => (path, fd)
      ; <call(|None(), Some(fd), None())>  (<xtc-find> "jar", ["tf", jar])
      ; <fopen> (path, "r") => stream
      ; repeat(
          <fgetchars-line> stream
        ; private-define-jar-entry(|jar)
        )
      ; try(<fclose> stream)
    )
    
  /**
   * Private util for define-jar-entries. Do not invoke directly.
   *
   * This strategy does not fail if the specified file does not have
   * the .class extension.
   *
   * @param Jar file of this class file (String).
   * @type  List(Char) -> Class Object
   */
  private-define-jar-entry(|jar) =
    ?filename
    ; ( define-bytecode-class(|Jar(jar, <implode-string> filename))
       <+ if get-extension => "class" then
            log(|Error(), "Could not define jar entry in repository.", <implode-string> filename)
            ; fail
          else
            id
          end
      )

  /**
   * @type String -> Class Object
   */
  define-bytecode-class-file =
    ?path
    ; explode-string
    ; define-bytecode-class(|ClassFile(path))

  /**
   * Defines the .class file of the specified name and location in the Dryad repository.
   *
   * Example names:
   *   org/foo/Bar.class
   *   org/foo/Bar$Fred.class
   *
   * @todo Local classes are not supported
   * @todo Anonymous classes are not supported
   * @type List(Char) -> Class Object
   */
  define-bytecode-class(|location) =
    parse-class-pathname => (pkgname, simplename)
    ; <parse-binary-name> simplename => parts
    ; <lookup-or-add-package> pkgname => pkg
    ; <private-classpath-handle-toplevel-class(|pkg)> parts
    ; set-package(|pkg)    
    ; set-location(|location)

/**
 * Private helpers. These used to be nested functions, but this produced a C
 * compilation error.
 */
strategies
    
  private-classpath-get-or-add-toplevel-class(|name, pkg) =
    <get-toplevel-class(|name)> pkg
    <+ new-bytecode-class(|name) => class
       ; <add-toplevel-class(|class)> pkg
       ; !class

  private-classpath-get-or-add-member-type(|name, declaring-class) =
    <get-declared-member-type(|name)> declaring-class
    <+ new-bytecode-class(|name) => class
       ; <add-declared-member-type(|class)> declaring-class
       ; <set-declaring-class(|declaring-class)> class
       ; !class
       
  private-classpath-handle-toplevel-class(|pkg) =
    ?[TopLevel(name) | <id>]
    ; where(private-classpath-get-or-add-toplevel-class(|name, pkg) => class)
    ; private-classpath-handle-member-type(|class)
             
  private-classpath-handle-member-type(|declaring-class) =
    if ?[] then
      !declaring-class
    else
      ?[Member(name) | <id>]
      ; where(private-classpath-get-or-add-member-type(|name, declaring-class) => class)
      ; private-classpath-handle-member-type(|class)
    end

strategies

  /**
   * Imports a serialized Dryad repository by registering a package, its subpackages and 
   * all classes in the Dryad repository.
   *
   * The structure of the ExportedPackage input is specified in dryad/model/classpath.
   *
   * @type ExportedPackage -> ExportedPackage
   */
  import-repository =
    let create-package-in(|pkg) = {simplename:
          ?Package(simplename, _, _)
          ; fill-package(|<get-or-add-subpackage(|simplename)> pkg)
        }

        fill-package(|pkg) = {pkgs, classes:
          ?Package(_, pkgs, classes)
          ; <map(create-package-in(|pkg))> pkgs
          ; <set-toplevel-bytecode-classes(|classes)> pkg
        }

     in where(fill-package(|<get-root-package> ()))
    end

  /**
   * Exports the current Dryad repository by constructing an ATerm that represents its content.
   * The structure of the ExportedPackage result is specified in dryad/model/classpath.
   *
   * @type _ -> ExportedPackage
   */
  export-repository =
    let 
        /**
         * @type Package Object -> ExportedPackage
         */      
        export-package =
          !Package(
            <get-simple-name>
          , <get-subpackages; map(export-package)>        
          , <get-toplevel-classes; filter(export-class)>
          )
          
        /**
         * @type Class Object -> ExportedClass
         */  
        export-class =
          !Class(<get-simple-name>, <get-location>, <get-declared-member-types; filter(export-class)>)
          <+ /**
              * @todo Some classes have $, but are not inner classes (e.g. CUP$parser$actions). This
              *       is hack to workaround that. Is it wrong to determine of a class from its name?
              */
             if get-location then
               log(|Error(), "Could not export class", <get-simple-name>); fail          
             else
               log(|Warning(), "Class has no location", <get-simple-name>); fail
             end

     in get-root-package
        ; export-package
    end
    
/**
 * Java related utils
 */
strategies

  /**
   * @type  List(Char) -> (List(String), String)
   */
  parse-class-pathname =
    list-tokenize(?'/' + ?'.')
    ; split-last2 => (ps, name, ['c', 'l', 'a', 's', 's'])
    ; !(<map(implode-string)> ps, <implode-string> name)

  /**
   * @type  List(Char) -> Class
  parse-java-pathname =
    list-tokenize(?'/' + ?'.')
    ; split-last2 => (ps, name, ['j', 'a', 'v', 'a'])
    ; !Class(<map(implode-string)> ps, <implode-string> name)
   */    

/**
 * Generic library utils
 */
strategies

  split-last2 =
    at-suffix(?[_, _]; ?[x1, x2]; ![])
    ; !(<id>, x1, x2)

  /**
   * @param List(Char) -> a
   */
  fgetchars-lines(postlinehook, at-last) =
    ?stream
    ; rec x(
        <fgetchars-line> stream
      ; ( postlinehook
        < ![<id> | <x> ()]
        + <x> ()
        )
      <+ at-last
      )

  fgetchars-line =
    fgetchars-until(?'\n')

  /**
   * fails if there is an immediate EOF.
   */
  fgetchars-until(pred) =
    ?stream
    ; <fgetc> stream
    ; rec x(
        if not(pred) then
          ![<id> | <fgetc; x> stream]
        else
          ![]
        end
      )