path: root/stdlib/source/program/aedifex/command/build.lux

(.module:
  [library
   [lux "+"
    ["[0]" ffi {"+" import:}]
    [abstract
     [order {"+" Order}]
     [monad {"+" do}]]
    [control
     ["[0]" try {"+" Try}]
     ["[0]" exception {"+" exception:}]
     ["[0]" io {"+" IO}]
     [concurrency
      ["[0]" async {"+" Async} ("[1]#[0]" monad)]]]
    [data
     ["[0]" product]
     ["[0]" text ("[1]#[0]" order)
      ["%" format {"+" format}]]
     [collection
      ["[0]" list ("[1]#[0]" functor mix)]
      ["[0]" dictionary {"+" Dictionary}]
      ["[0]" set]]]
    [math
     [number
      ["n" nat]
      ["i" int]]]
    [world
     ["[0]" program {"+" Program}]
     ["[0]" file {"+" Path}]
     ["[0]" shell {"+" Exit Process Shell}]
     ["[0]" console {"+" Console}]
     [net
      ["[0]" uri]]]]]
  ["[0]" /// "_"
   ["[1]" profile]
   ["[1][0]" action]
   ["[1][0]" command {"+" Command}]
   ["[1][0]" local]
   ["[1][0]" repository]
   ["[1][0]" runtime]
   ["[1][0]" dependency {"+" Dependency}
    ["[1]/[0]" resolution {"+" Resolution}]]
   ["[1][0]" artifact {"+" Group Name Version Artifact}
    ["[1]/[0]" type]]])

(type: Finder
  (-> Resolution (Maybe Dependency)))

(def: (dependency_finder group name)
  (-> Group Name Finder)
  (|>> dictionary.entries
       (list.one (function (_ [dependency package])
                   (if (and (text#= group (value@ [///dependency.#artifact ///artifact.#group] dependency))
                            (text#= name (value@ [///dependency.#artifact ///artifact.#name] dependency)))
                     {.#Some dependency}
                     {.#None})))))

(def: .public lux_group
  Group
  "com.github.luxlang")

(template [<dependency> <definition>]
  [(def: .public <definition>
     Name
     <dependency>)]

  ["lux-jvm" jvm_compiler_name]
  ["lux-js" js_compiler_name]
  ["lux-python" python_compiler_name]
  ["lux-lua" lua_compiler_name]
  ["lux-ruby" ruby_compiler_name]
  )

(exception: .public no_available_compiler)
(exception: .public no_specified_program)

(type: .public Compiler
  (Variant
   {#JVM Dependency}
   {#JS Dependency}
   {#Python Dependency}
   {#Lua Dependency}
   {#Ruby Dependency}))

(def: (remove_dependency dependency)
  (-> Dependency (-> Resolution Resolution))
  (|>> dictionary.entries
       (list.only (|>> product.left (same? dependency) not))
       (dictionary.of_list ///dependency.hash)))

(def: (compiler resolution compiler_dependency)
  (-> Resolution Dependency (Try [Resolution Compiler]))
  (let [[[compiler_group compiler_name compiler_version] compiler_type] compiler_dependency]
    (case (..dependency_finder compiler_group compiler_name resolution)
      {.#Some dependency}
      (case compiler_name
        (^template [<tag> <name>]
          [(^ (static <name>))
           {try.#Success [(..remove_dependency dependency resolution)
                          {<tag> dependency}]}])
        ([#JVM ..jvm_compiler_name]
         [#JS ..js_compiler_name]
         [#Python ..python_compiler_name]
         [#Lua ..lua_compiler_name]
         [#Ruby ..ruby_compiler_name])
        
        _
        (exception.except ..no_available_compiler []))
      
      _
      (exception.except ..no_available_compiler []))))

(def: (path fs home dependency)
  (All (_ !) (-> (file.System !) Path Dependency Path))
  (let [/ (# fs separator)
        artifact (value@ ///dependency.#artifact dependency)]
    (|> artifact
        (///local.uri (value@ ///artifact.#version artifact))
        (text.replaced uri.separator /)
        (format home /)
        (text.suffix (format "." (value@ ///dependency.#type dependency))))))

(def: (libraries fs home)
  (All (_ !) (-> (file.System !) Path Resolution (List Path)))
  (|>> dictionary.keys
       (list.only (|>> (value@ ///dependency.#type)
                       (text#= ///artifact/type.lux_library)))
       (list#each (..path fs home))))

(def: version_separator
  ".")

(implementation: version_order
  (Order Version)

  (def: &equivalence
    text.equivalence)

  (def: (< left right)
    (loop [left (text.all_split_by ..version_separator left)
           right (text.all_split_by ..version_separator right)]
      (case [left right]
        [{.#Item leftH leftT} {.#Item rightH rightT}]
        (if (text#= leftH rightH)
          (again leftT rightT)
          (or (n.< (text.size leftH) (text.size rightH))
              (text#< leftH rightH)))

        [{.#Item leftH leftT} {.#End}]
        false

        [{.#End} {.#Item rightH rightT}]
        true

        [{.#End} {.#End}]
        false))))

(def: .public (host_dependencies fs home)
  (All (_ !) (-> (file.System !) Path Resolution (List Path)))
  (|>> dictionary.keys
       (list.only (|>> (value@ ///dependency.#type)
                       (text#= ///artifact/type.lux_library)
                       not))
       (list#mix (function (_ dependency uniques)
                   (let [artifact (value@ ///dependency.#artifact dependency)
                         identity [(value@ ///artifact.#group artifact)
                                   (value@ ///artifact.#name artifact)]
                         version (value@ ///artifact.#version artifact)]
                     (case (dictionary.value identity uniques)
                       {.#Some [current_version current_path]}
                       (if (# version_order < version current_version)
                         (dictionary.has identity [version dependency] uniques)
                         uniques)
                       
                       {.#None}
                       (dictionary.has identity [version dependency] uniques))))
                 (: (Dictionary [Group Name] [Version Dependency])
                    (dictionary.empty (product.hash text.hash text.hash))))
       dictionary.values
       (list#each (|>> product.right (..path fs home)))))

(def: (singular name)
  (-> Text Text (List Text))
  (|>> (list name)))

(def: (plural name)
  (-> Text (List Text) (List Text))
  (|>> (list#each (|>> (list name))) list.together))

(def: .public start "[BUILD STARTED]")
(def: .public success "[BUILD ENDED]")
(def: .public failure "[BUILD FAILED]")

(template [<name> <capability>]
  [(def: .public (<name> console process)
     (-> (Console Async) (Process Async) (Async (Try Any)))
     ... This is a very odd way of implementing this function.
     ... But it's written this way because the more straightforward way (i.e. by using (try.with async.monad))
     ... eventually led to the function hanging/freezing.
     ... I'm not sure why it happened, but I got this weirder implementation to work.
     (let [[read! write!] (: [(Async (Try Any))
                              (async.Resolver (Try Any))]
                             (async.async []))
           _ (|> (# process <capability> [])
                 (async.upon! (function (again ?line)
                                (case ?line
                                  {try.#Failure error}
                                  (if (exception.match? shell.no_more_output error)
                                    (write! {try.#Success []})
                                    (async.upon! write! (console.write_line error console)))
                                  
                                  {try.#Success line}
                                  (async.upon! (function (_ outcome)
                                                 (case outcome
                                                   {try.#Failure error}
                                                   (write! {try.#Failure error})

                                                   {try.#Success _}
                                                   (async.upon! again
                                                                (# process <capability> []))))
                                               (console.write_line line console)))))
                 io.run!)]
       read!))]

  [log_output! read]
  [log_error! error]
  )

(import: java/lang/System
  ["[1]::[0]"
   ("static" getProperty [java/lang/String] "io" "try" java/lang/String)])

(def: windows?
  Bit
  (|> (java/lang/System::getProperty "os.name")
      io.run!
      (try.else "")
      text.lower_cased
      (text.starts_with? "windows")))

(def: jvm_class_path_separator
  (if windows?
    ";"
    ":"))

(def: (jvm_class_path host_dependencies)
  (-> (List Path) Text)
  (|> host_dependencies
      {.#Item "."}
      (text.interposed ..jvm_class_path_separator)))

(def: .public (with_jvm_class_path host_dependencies runtime)
  (-> (List Path) ///runtime.Runtime ///runtime.Runtime)
  (case host_dependencies
    {.#End}
    runtime

    _
    (revised@ ///runtime.#parameters
              (|>> (list& "-cp" (..jvm_class_path host_dependencies)))
              runtime)))

(def: .public (do! console program fs shell resolution)
  (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit Compiler Path]))
  (function (_ profile)
    (let [target (value@ ///.#target profile)]
      (case (value@ ///.#program profile)
        {.#None}
        (async#in (exception.except ..no_specified_program []))

        {.#Some program_module}
        (do async.monad
          [environment (program.environment async.monad program)
           .let [home (# program home)
                 working_directory (# program directory)]]
          (do ///action.monad
            [[resolution compiler] (async#in (..compiler resolution (value@ ///.#compiler profile)))
             .let [host_dependencies (..host_dependencies fs home resolution)
                   [[command compiler_params] output] (case compiler
                                                        {#JVM dependency}
                                                        [(|> (value@ ///.#java profile)
                                                             (with@ ///runtime.#parameters (list "program._"))
                                                             (with_jvm_class_path {.#Item (..path fs home dependency) host_dependencies}))
                                                         "program.jar"]
                                                        
                                                        (^template [<tag> <runtime> <program>]
                                                          [{<tag> dependency}
                                                           [(|> dependency
                                                                (..path fs home)
                                                                (///runtime.for (value@ <runtime> profile)))
                                                            <program>]])
                                                        ([#JS ///.#js "program.js"]
                                                         [#Python ///.#java "program.py"]
                                                         [#Lua ///.#java "program.lua"]
                                                         [#Ruby ///.#java "program.rb"]))
                   / (# fs separator)
                   cache_directory (format working_directory / target)]
             _ (console.write_line ..start console)
             .let [full_parameters (list.together (list compiler_params
                                                        (list "build")
                                                        (..plural "--library" (..libraries fs home resolution))
                                                        (..plural "--host_dependency" host_dependencies)
                                                        (..plural "--source" (set.list (value@ ///.#sources profile)))
                                                        (..singular "--target" cache_directory)
                                                        (..singular "--module" program_module)))]
             process (# shell execute [environment
                                       working_directory
                                       command
                                       full_parameters])
             _ (..log_output! console process)
             _ (..log_error! console process)
             exit (# process await [])
             _ (console.write_line (if (i.= shell.normal exit)
                                     ..success
                                     ..failure)
                                   console)]
            (in [exit
                 compiler
                 (format cache_directory / output)])))))))