let prelude = import! std.prelude
let io = import! std.effect.io
let mio @ { ? } = import! std.io
let map @ { Map, empty, singleton, find, insert, ? } = import! std.map
let { Bool } = import! std.bool
let { Option } = import! std.option
let { Result } = import! std.result
let string = import! std.string
let thread = import! std.thread
let array @ { ? } = import! std.array
let { ref, load, (<-) } = import! std.effect.reference
let rustyline @ { Editor } = import! rustyline
let { ReadlineError } = import! rustyline_types
let repl_prim @ { Color, Settings } = import! repl.prim
let { (<<), (<|) } = import! std.function
let effect @ { Eff, ? } = import! std.effect
let { Reader, ask, asks, run_reader } = import! std.effect.reader
let { State, get, modify, eval_state } = import! std.effect.state
let { Lift, lift, run_lift } = import! std.effect.lift
let { Applicative, wrap, (*>) } = import! std.applicative
let { flat_map, (>>=) } = import! std.monad
let { foldl } = import! std.foldable
let { (<>) } = import! std.prelude
rec
type ReplEffect r a = [| reader : Reader Repl, state : State Settings, lift : Lift IO | r |] a
type Repl = { commands : Commands, editor : Editor }
type ReplAction =
| Continue
| Quit
type Cmd = {
name : String,
alias : String,
info : String,
action : forall r . String -> Eff (ReplEffect r) ReplAction
}
type Commands = Map String Cmd
in
let run_interruptible_io action :
IO String
-> Eff (ReplEffect r) (Result String String)
=
do eval_thread = lift <| thread.new_thread ()
let interruptible_action = repl_prim.finish_or_interrupt eval_thread action
io.catch (mio.functor.map Ok interruptible_action) (wrap << Err)
let load_file filename : String -> Eff (ReplEffect r) String =
let last_slash =
match string.rfind filename "/" with
| None -> 0
| Some i -> i + 1
let modulename = string.slice filename last_slash (string.len filename - 3)
let action =
do expr = mio.read_file_to_string filename
do result = mio.load_script modulename expr
wrap result
do result = run_interruptible_io action
match result with
| Ok x -> wrap x
| Err x -> wrap x
let run_file filename : String -> Eff (ReplEffect r) () =
let action =
do expr = mio.read_file_to_string filename
do result = mio.run_expr expr
wrap (result.value ++ " : " ++ result.typ)
do result = run_interruptible_io action
match result with
| Ok _ -> io.println ""
| Err x -> io.println x
let commands : Eff [| lift : Lift IO |] Commands =
let print_result result =
match result with
| Ok x -> io.println x
| Err x -> io.println x
do commands = ref []
let cmds : Array Cmd =
[{
name = "quit",
alias = "q",
info = "Quit the REPL",
// FIXME a -> IO ReplAction signature should not be necessary
action =
let x : a -> Eff (ReplEffect r) ReplAction = \_ -> wrap Quit
x,
},
{
name = "type",
alias = "t",
info = "Prints the type with an expression",
action =
\arg ->
(lift (repl_prim.type_of_expr arg) >>= print_result) *> wrap Continue,
},
{
name = "info",
alias = "i",
info = "Prints information about the given name",
action
=
\arg ->
(lift (repl_prim.find_info arg) >>= print_result) *> wrap Continue,
},
{
name = "kind",
alias = "k",
info = "Prints the kind with the given type",
action
=
\arg ->
(lift (repl_prim.find_kind arg) >>= print_result) *> wrap Continue,
},
{
name = "load",
alias = "l",
info = "Loads the file at \'folder/module.ext\' and stores it at \'module\'",
action
=
\arg ->
(load_file arg >>= io.println) *> wrap Continue,
},
{
name = "script",
alias = "s",
info = "Runs the script at `FILENAME`",
action = \arg -> run_file arg *> wrap Continue,
},
{
name = "prompt",
alias = "p",
info = "Sets the prompt",
action = \prompt ->
modify
(\settings ->
// TODO Should be able infer this before the `..` splatting
let settings : Settings = settings
{
prompt,
..
settings
})
wrap Continue,
},
{
name = "color",
alias = "c",
info = "Sets whether to use color in the repl: auto, always, always-ansi, never",
action = \color ->
match repl_prim.parse_color color with
| Ok color ->
modify
(\settings ->
// TODO Should be able infer this before the `..` splatting
let settings : Settings = settings
{
color,
..
settings
})
| Err msg -> io.println msg
wrap Continue,
},
{
name = "debug",
alias = "d",
info = "Switch debug level",
action
=
\arg ->
(lift (repl_prim.switch_debug_level arg) >>= print_result) *> wrap Continue,
},
{
name = "help",
alias = "h",
info = "Print this help",
action = \_ ->
let print_header = io.println "Available commands\n"
let print_cmd cmd : Cmd -> Eff (ReplEffect r) () =
io.println (" :" ++ cmd.name ++ " (" ++ cmd.alias ++ ") " ++ cmd.info)
do commands = load commands
print_header *> array.traversable.traverse effect.applicative print_cmd commands
*> wrap Continue,
}]
commands <- cmds
let c : Commands =
foldl
(\map cmd -> singleton cmd.name cmd <> singleton cmd.alias cmd <> map)
empty
cmds
wrap c
let { Parser, parse, ? } = import! std.parser
let cmd_parser : Parser { cmd : String, arg : String } =
let {
any,
recognize,
skip_many1,
token,
spaces,
letter
} =
import! std.parser
let { (<|>) } = import! std.alternative
let word = recognize (skip_many1 letter)
let arg_parser = recognize (skip_many1 any)
token ':'
do cmd = word
do arg = (spaces *> arg_parser) <|> wrap ""
wrap { cmd, arg }
let do_command commands line : Commands -> String -> Eff (ReplEffect r) ReplAction =
match parse cmd_parser line with
| Ok { cmd, arg } ->
match find cmd commands with
| Some command -> command.action arg
| None -> io.println ("Unknown command \'" ++ cmd ++ "\'") *> wrap Continue
| Err err ->
io.println "Expected a command such as `:h`" *> wrap Continue
let loop _ : () -> Eff (ReplEffect r) () =
do repl = ask
do settings = get
let run_line line =
if string.is_empty (string.trim line) then wrap Continue
else if string.starts_with line ":" then do_command repl.commands line
else
let action =
do eval_thread = thread.new_thread ()
let eval_action = repl_prim.eval_line settings.color line
repl_prim.finish_or_interrupt eval_thread eval_action
io.catch action mio.println *> wrap Continue
do line_result = lift <| rustyline.readline repl.editor settings.prompt
match line_result with
| Err Eof -> wrap ()
| Err Interrupted -> loop ()
| Ok line ->
do continue = run_line line
match continue with
| Continue -> loop ()
| Quit ->
lift <| rustyline.save_history repl.editor
wrap ()
let run settings : Settings -> Eff [| lift : Lift IO |] () =
io.println "gluon (:h for help, :q to quit)"
do editor = lift <| rustyline.new_editor settings.color
do commands = commands
let repl = { commands, editor }
run_reader repl (eval_state settings (loop ()))
run_lift << run