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

(.require
 [library
  [lux (.except Lux)
   ["[0]" ffi (.only import)]
   [abstract
    [order (.only Order)]
    [monad (.only do)]]
   [control
    ["[0]" try (.only Try) (.use "[1]#[0]" functor)]
    ["[0]" exception]
    ["[0]" io (.only IO)]
    [concurrency
     ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]]
   [data
    ["[0]" product]
    ["[0]" text (.use "[1]#[0]" order)
     ["%" \\format (.only format)]]
    [collection
     ["[0]" list (.use "[1]#[0]" functor mix monoid)]
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" set]]]
   [math
    [number (.only hex)
     ["n" nat]
     ["i" int]]]
   [meta
    ["[0]" configuration]
    [macro
     ["^" pattern]]
    [compiler
     [meta
      [cli
       ["[0]" compiler]]
      ["[0]" packager (.only)
       ["[0]_[1]" ruby]]]]]
   [world
    ["[0]" environment (.only Environment)]
    ["[0]" file (.only Path)]
    ["[0]" shell (.only Exit Process Shell)]
    ["[0]" console (.only Console)]
    [net
     ["[0]" uri]]]]]
 ["[0]" ///
  ["[1]" profile]
  ["[1][0]" action]
  ["[1][0]" command (.only Command)]
  ["[1][0]" local]
  ["[1][0]" repository]
  ["[1][0]" runtime]
  ["[1][0]" dependency (.only Dependency)
   ["[1]/[0]" resolution (.only Resolution)]]
  ["[1][0]" artifact (.only 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 (the [///dependency.#artifact ///artifact.#group] dependency))
                            (text#= name (the [///dependency.#artifact ///artifact.#name] dependency)))
                     {.#Some dependency}
                     {.#None})))))

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

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

  ["lux-jvm" jvm_lux_name]
  ["lux-js" js_lux_name]
  ["lux-python" python_lux_name]
  ["lux-lua" lua_lux_name]
  ["lux-ruby" ruby_lux_name]
  )

(exception.def .public no_available_lux)
(exception.def .public no_specified_program)

(type .public Lux
  (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 (lux resolution lux_dependency)
  (-> Resolution Dependency (Try [Resolution Lux]))
  (let [[[lux_group lux_name lux_version] lux_type] lux_dependency]
    (when (..dependency_finder lux_group lux_name resolution)
      {.#Some dependency}
      (when lux_name
        (^.with_template [<tag> <name>]
          [<name>
           {try.#Success [(..remove_dependency dependency resolution)
                          {<tag> dependency}]}])
        ([#JVM ..jvm_lux_name]
         [#JS ..js_lux_name]
         [#Python ..python_lux_name]
         [#Lua ..lua_lux_name]
         [#Ruby ..ruby_lux_name])
        
        _
        (exception.except ..no_available_lux []))
      
      _
      (exception.except ..no_available_lux []))))

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

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

(def version_separator
  ".")

(def version_order
  (Order Version)
  (implementation
   (def equivalence
     text.equivalence)

   (def (< left right)
     (loop (again [left (text.all_split_by ..version_separator left)
                   right (text.all_split_by ..version_separator right)])
       (when [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 (|>> (the ///dependency.#type)
                       (text#= ///artifact/type.lux_library)
                       not))
       (list#mix (function (_ dependency uniques)
                   (let [artifact (the ///dependency.#artifact dependency)
                         identity [(the ///artifact.#group artifact)
                                   (the ///artifact.#name artifact)]
                         version (the ///artifact.#version artifact)]
                     (when (dictionary.value identity uniques)
                       {.#Some [current_version current_path]}
                       (if (at version_order < version current_version)
                         (dictionary.has identity [version dependency] uniques)
                         uniques)
                       
                       {.#None}
                       (dictionary.has identity [version dependency] uniques))))
                 (is (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]")

(with_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.
     ... TODO: Improve this implementation.
     (let [[read! write!] (is [(Async (Try Any))
                               (async.Resolver (Try Any))]
                              (async.async []))
           _ (|> (at process <capability> [])
                 (async.upon! (function (again ?line)
                                (when ?line
                                  {try.#Failure error}
                                  (if (exception.match? shell.no_more_output error)
                                    (write! {try.#Success []})
                                    (async.upon! write! (is (Async (Try Any))
                                                            (console.write_line error console))))
                                  
                                  {try.#Success line}
                                  (async.upon! (function (_ outcome)
                                                 (when outcome
                                                   {try.#Failure error}
                                                   (write! {try.#Failure error})

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

  [log_output! read]
  [log_error! fail]
  )

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

(def windows?
  Bit
  (|> (java/lang/System::getProperty (ffi.as_string "os.name"))
      io.run!
      (try#each (|>> ffi.of_string))
      (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)
  (when host_dependencies
    {.#End}
    runtime

    _
    (revised ///runtime.#parameters
             (|>> (list.partial "-cp" (..jvm_class_path host_dependencies)
                                "-Xss16m"
                                "--add-opens" "java.base/java.lang=ALL-UNNAMED"))
             runtime)))

(def .public (do! console environment fs shell resolution)
  (-> (Console Async) (Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit Lux Path]))
  (function (_ profile)
    (let [target (the ///.#target profile)]
      (when (the ///.#program profile)
        {.#None}
        (async#in (exception.except ..no_specified_program []))

        {.#Some [program_module program_definition]}
        (do async.monad
          [.let [home (at environment home)
                 working_directory (at environment directory)]
           environment (environment.environment async.monad environment)]
          (do ///action.monad
            [[resolution lux] (async#in (..lux resolution (the ///.#lux profile)))
             .let [host_dependencies (..host_dependencies fs home resolution)
                   [[command_environment command lux_params] output]
                   (when lux
                     {#JVM dependency}
                     [(|> (the ///.#java profile)
                          (has ///runtime.#parameters (list "program._"))
                          (with_jvm_class_path {.#Item (..path fs home dependency) host_dependencies}))
                      "program.jar"]
                     
                     (^.with_template [<tag> <runtime> <program>]
                       [{<tag> dependency}
                        [(|> dependency
                             (..path fs home)
                             (///runtime.for (the <runtime> profile)))
                         <program>]])
                     ([#JS ///.#js "program.js"]
                      [#Python ///.#java "program.py"]
                      [#Lua ///.#java "program.lua"]
                      [#Ruby ///.#java (file.rooted fs "program" ruby_packager.main_file)]))
                   / (at fs separator)
                   cache_directory (format working_directory / target)]
             _ (is (Async (Try Any))
                   (console.write_line ..start console))
             .let [full_parameters (list.together (list lux_params
                                                        (list "build")
                                                        (..plural "--library" (..libraries fs home resolution))
                                                        (..plural "--host_dependency" host_dependencies)
                                                        (..plural "--compiler" (list#each compiler.format (the ///.#compilers profile)))
                                                        (..plural "--source" (set.list (the ///.#sources profile)))
                                                        (..singular "--target" cache_directory)
                                                        (when program_module
                                                          "" (..singular "--module" program_definition)
                                                          _ (list#composite (..singular "--module" program_module)
                                                                            (..singular "--program" program_definition)))
                                                        (..singular "--configuration" (configuration.format (the ///.#configuration profile)))))]
             process (at shell execute [(dictionary.composite environment command_environment)
                                        working_directory
                                        command
                                        full_parameters])
             _ (..log_output! console process)
             _ (..log_error! console process)
             exit (at process await [])
             _ (is (Async (Try Any))
                   (console.write_line (if (i.= shell.normal exit)
                                         ..success
                                         ..failure)
                                       console))]
            (in [exit
                 lux
                 (format cache_directory / output)])))))))