From 4ef1ac1dfe0edd1a11bb7f1fd13c8b6cb8f1bab4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Mar 2022 22:54:32 -0400 Subject: Using a fake console in Aedifex if the system console is unavailable. --- stdlib/source/program/aedifex.lux | 202 +++++++++++++++++++++----------------- 1 file changed, 111 insertions(+), 91 deletions(-) (limited to 'stdlib/source/program') diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 4145bb9c5..a92340ce3 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -7,6 +7,7 @@ [monad {"+" do}]] [control ["[0]" io {"+" IO}] + ["[0]" maybe] ["[0]" try {"+" Try} ("[1]#[0]" functor)] ["[0]" exception {"+" exception:}] [parser @@ -111,100 +112,119 @@ (def: (command action) (All (_ a) (-> (Async (Try a)) (IO Any))) - (exec (do async.monad - [outcome action] - (async.future - (case outcome - {try.#Success _} - ..succeed! - - {try.#Failure error} - (..fail! error)))) + (exec + (do async.monad + [outcome action] + (async.future + (case outcome + {try.#Success _} + ..succeed! + + {try.#Failure error} + (..fail! error)))) (# io.monad in []))) +(exception: .public invalid_operation) + +(`` (implementation: write_only + (Console IO) + + (~~ (template [] + [(def: ( _) + (io.io (exception.except ..invalid_operation [])))] + + [read] + [read_line] + [close] + )) + + (def: (write it) + (<| io.io + {try.#Success} + debug.log! + (if (text.ends_with? text.\n it) + (maybe.trusted (text.clip 0 (-- (text.size it)) it)) + it))))) + (program: [[profiles operation] /cli.command] (do [! io.monad] - [?console console.default] - (case (try#each console.async ?console) - {try.#Failure error} - (..fail! error) - - {try.#Success console} - (case operation - {/cli.#Version} - (..command - (/command/version.do! console (# /.monoid identity))) - - _ - (do ! - [?profile (/input.read io.monad file.default profiles)] - (case ?profile - {try.#Failure error} - (..fail! error) - - {try.#Success profile} - (let [program (program.async program.default)] - (case operation - {/cli.#Version} - (in []) - - {/cli.#Clean} - (..command - (/command/clean.do! console (file.async file.default) profile)) - - {/cli.#POM} - (..command - (/command/pom.do! console (file.async file.default) profile)) - - {/cli.#Install} - (..command - (let [fs (file.async file.default)] - (/command/install.do! console fs (/repository/local.repository program fs) profile))) - - {/cli.#Deploy repository identity} - (..command - (case (the /.#identity profile) - {.#Some artifact} - (case (dictionary.value repository (the /.#deploy_repositories profile)) - {.#Some repository} - (/command/deploy.do! console - (/repository.async (/repository/remote.repository http.default {.#Some identity} repository)) - (file.async file.default) - artifact - profile) - - {.#None} - (async#in (exception.except ..cannot_find_repository [repository (the /.#deploy_repositories profile)]))) + [console (# ! each (|>> (try.else ..write_only) console.async) + console.default)] + (case operation + {/cli.#Version} + (..command + (/command/version.do! console (# /.monoid identity))) + + _ + (do ! + [?profile (/input.read io.monad file.default profiles)] + (case ?profile + {try.#Failure error} + (..fail! error) + + {try.#Success profile} + (let [program (program.async program.default)] + (case operation + {/cli.#Version} + (in []) + + {/cli.#Clean} + (..command + (/command/clean.do! console (file.async file.default) profile)) + + {/cli.#POM} + (..command + (/command/pom.do! console (file.async file.default) profile)) + + {/cli.#Install} + (..command + (let [fs (file.async file.default)] + (/command/install.do! console fs (/repository/local.repository program fs) profile))) + + {/cli.#Deploy repository identity} + (..command + (case (the /.#identity profile) + {.#Some artifact} + (case (dictionary.value repository (the /.#deploy_repositories profile)) + {.#Some repository} + (/command/deploy.do! console + (/repository.async (/repository/remote.repository http.default {.#Some identity} repository)) + (file.async file.default) + artifact + profile) {.#None} - (async#in (exception.except /.no_identity [])))) - - {/cli.#Dependencies} - (..command - (/command/deps.do! console - (/repository/local.repository program (file.async file.default)) - (..repositories profile) - (|>> (/repository/remote.repository http.default {.#None}) - /repository.async) - profile)) - - {/cli.#Compilation compilation} - (case compilation - {/cli.#Build} (..command - (..with_dependencies program console /command/build.do! profile)) - {/cli.#Test} (..command - (..with_dependencies program console /command/test.do! profile))) - - {/cli.#Auto auto} - (do ! - [?watcher watch.default] - (case ?watcher - {try.#Failure error} - (..fail! error) - - {try.#Success watcher} - (..command - (case auto - {/cli.#Build} (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/build.do!) profile) - {/cli.#Test} (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/test.do!) profile))))))) - )))))) + (async#in (exception.except ..cannot_find_repository [repository (the /.#deploy_repositories profile)]))) + + {.#None} + (async#in (exception.except /.no_identity [])))) + + {/cli.#Dependencies} + (..command + (/command/deps.do! console + (/repository/local.repository program (file.async file.default)) + (..repositories profile) + (|>> (/repository/remote.repository http.default {.#None}) + /repository.async) + profile)) + + {/cli.#Compilation compilation} + (case compilation + {/cli.#Build} (..command + (..with_dependencies program console /command/build.do! profile)) + {/cli.#Test} (..command + (..with_dependencies program console /command/test.do! profile))) + + {/cli.#Auto auto} + (do ! + [?watcher watch.default] + (case ?watcher + {try.#Failure error} + (..fail! error) + + {try.#Success watcher} + (..command + (case auto + {/cli.#Build} (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/build.do!) profile) + {/cli.#Test} (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/test.do!) profile))))))) + ))))) -- cgit v1.2.3