fun get (table: TomlValue.table, key) =
case List.find (fn (key', _) => key' = key) table of
NONE => NONE
| SOME (_, value) => SOME value
fun weakGet (SOME table : TomlValue.table option, key) =
(case List.find (fn (key', _) => key' = key) table of
NONE => NONE
| SOME (_, value) => SOME value)
| weakGet (NONE, _) = NONE
infix ?|> ??
(* Option.mapPartial, flipped *)
fun (SOME x) ?|> f = f x
| NONE ?|> _ = NONE
val op?? = Option.getOpt
(*: val checkBool : string -> TomlValue.value -> bool option *)
fun checkBool _ (TomlValue.BOOL x) = SOME x
| checkBool path _ =
(Message.warn ("Config entry " ^ path ^ " should be a boolean."); NONE)
(*: val checkString : string -> TomlValue.value -> string option *)
fun checkString _ (TomlValue.STRING x) = SOME x
| checkString path _ =
(Message.warn ("Config entry " ^ path ^ " should be a string."); NONE)
(*: val checkTable : string -> TomlValue.value -> TomlValue.table option *)
fun checkTable _ (TomlValue.TABLE x) = SOME x
| checkTable path _ =
(Message.warn ("Config entry " ^ path ^ " should be a table."); NONE)
(*: val checkColor : string -> TomlValue.value -> ANSIColor.color option *)
fun checkColor path (TomlValue.STRING x) =
(case ANSIColor.fromString x of
SOME c => SOME c
| NONE =>
( Message.warn
("Config entry " ^ path ^ " should be a valid color.")
; NONE
))
| checkColor path _ =
(Message.warn ("Config entry " ^ path ^ " should be a string."); NONE)
(*: val parseStyle : string -> TomlValue.value -> ANSIStyle.style option *)
fun parseStyle path (TomlValue.TABLE t) =
SOME
{ foreground = get (t, "fore") ?|> checkColor (path ^ ".fore")
, background = get (t, "back") ?|> checkColor (path ^ ".back")
, bold = get (t, "bold") ?|> checkBool (path ^ ".bold") ?? false
, dim = get (t, "dim") ?|> checkBool (path ^ ".dim") ?? false
, underline =
get (t, "underline") ?|> checkBool (path ^ ".underline") ?? false
, blink = get (t, "blink") ?|> checkBool (path ^ ".blink") ?? false
, reverse =
get (t, "reverse") ?|> checkBool (path ^ ".reverse") ?? false
, italic = get (t, "italic") ?|> checkBool (path ^ ".italic") ?? false
, strike = get (t, "strike") ?|> checkBool (path ^ ".strike") ?? false
}
| parseStyle path _ =
(Message.warn ("Config entry " ^ path ^ " should be a table."); NONE)
fun loadConfig path =
let
val ins = TextIO.openIn path
val ins' = ValidateUtf8.mkValidatingStream (TextIO.getInstream ins)
val table =
ParseToml.parse (ValidateUtf8.validatingReader TextIO.StreamIO.input1)
ins'
in
{ temporary_directory =
get (table, "temporary-directory")
?|> checkString "temporary-directory"
, color =
let
val color = get (table, "color") ?|> checkTable "color"
in
{ type_ = weakGet (color, "type") ?|> parseStyle "color.type"
, execute =
weakGet (color, "execute") ?|> parseStyle "color.execute"
, error = weakGet (color, "error") ?|> parseStyle "color.error"
, warning =
weakGet (color, "warning") ?|> parseStyle "color.warning"
, diagnostic =
weakGet (color, "diagnostic") ?|> parseStyle "color.diagnostic"
, information =
weakGet (color, "information")
?|> parseStyle "color.information"
}
end
}
end
end;
