Command.hs

   1 -- This file is part of Diohsc
   2 -- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 {-# LANGUAGE CPP        #-}
  12 {-# LANGUAGE LambdaCase #-}
  13 {-# LANGUAGE Safe       #-}
  14
  15 module Command
  16     ( commands
  17     , normaliseCommand
  18     , helpText
  19     , helpOn
  20     , expandHelp
  21     , showMinPrefix
  22     ) where
  23
  24 import           Control.Monad   (msum)
  25 import           Data.List       (isPrefixOf)
  26 import           Data.Maybe      (fromMaybe, isNothing)
  27 import           Safe            (atMay, headMay, maximumBound, readMay)
  28 import           System.FilePath ((</>))
  29
  30 import qualified Data.Text.Lazy  as T
  31
  32 import           ANSIColour
  33
  34 commands :: Bool -> [String]
  35 commands restricted = metaCommands ++ navCommands ++ infoCommands ++
  36         actionCommands restricted ++ otherCommands
  37     where
  38     metaCommands = ["help", "quit"]
  39     navCommands = ["repeat", "mark", "inventory", "identify", "add", "fetch", "delete"]
  40     infoCommands = ["show", "page", "uri", "links", "mime"]
  41     unsafeActionCommands = ["save", "view", "browse", "!", "|", "||", "||-"]
  42     safeActionCommands = ["cat"]
  43     actionCommands True  = safeActionCommands
  44     actionCommands False = unsafeActionCommands ++ safeActionCommands
  45     otherCommands = ["commands", "log", "query", "repl", "alias", "set", "at"]
  46
  47 normaliseCommand :: String -> Maybe String
  48 normaliseCommand partial =
  49     headMay . filter (isPrefixOf partial) $ commands False
  50
  51 helpText :: [String]
  52 helpText =
  53     [ withBoldStr "Navigation"
  54     , "----------"
  55     , "Enter a URI to go to it, then enter numbers to follow links."
  56     , ""
  57     , "You can navigate to other locations as follows:"
  58     , "    ../foo.gmi     : Relative URI"
  59     , "    < , {-back}    : Back"
  60     , "    > , {-forward} : Forward"
  61     , "    'foo           : Marked location"
  62     , "    ~ , {-next}    : Next queue item"
  63     , "    }              : Next unvisited link"
  64     , "    <}             : Next unvisited link of parent"
  65     , ""
  66     , "See \"{help} {targets}\" for more."
  67     , ""
  68     , withBoldStr "Commands"
  69     , "--------"
  70     , "Meta commands:"
  71     , "    {-quit}         : Quit"
  72     , "    {-help [TOPIC]} : This help, or help on a command or other topic"
  73     , "Navigation commands:"
  74     , "    {-mark MARK}     : Mark location as \"'MARK\""
  75     , "    3-5 {-add}       : Append links to queue"
  76     , "    {-repeat}        : Make fresh request for current location"
  77     , "    {-inventory}     : Show history and queue"
  78     , "    {-identify [ID]} : Select/create identity (client certificate)"
  79     , "    {-repl}          : Enter loop making queries at current uri"
  80     , "Action commands:"
  81     , "    {-show}                : Print text"
  82     , "    {-page}                : Page text"
  83     , "    {-links}               : Show links"
  84     , "    {-uri}                 : Show uri"
  85     , "    {-save [FILENAME]}     : Save data, by default in {~/saves/}"
  86     , "    {-| CMD}               : Pipe data to shell command"
  87     , "    {-! CMD}               : Run shell command on data"
  88     , "    {-|| [CMD]}            : Pipe rendered text to $PAGER or command"
  89     , "    {-view}                : Run mailcap command on data"
  90     , "    {-browse [CMD] [ARGS]} : Run command on uri (default: $BROWSER)"
  91     , ""
  92     , "Commands and marks may be abbreviated; e.g. \"l\" is short for {links}."
  93     , ""
  94     , "Commands which act on the current location by default"
  95     , "can also be given a target before the command, e.g.:"
  96     , "    3 {|} mpv -       : Request link 3 and pipe the stream to command 'mpv -'"
  97     , "    << {save} blah    : Save data from history item before last"
  98     , "    2 {browse} lynx   : Run \"lynx [uri-of-link-2]\""
  99     , "    / {mark} root     : Mark the root of the current capsule as 'root"
 100     , "    / {identify} asdf : Use identity \"asdf\" for all of current capsule"
 101     , "Use \"{help} {targets}\" to get full details on this notation."
 102     , ""
 103     , "Spaces around the command can often be omitted, e.g.:"
 104     , "    2a0       : Add link 2 to start of queue"
 105     , ""
 106     , withBoldStr "Miscellaneous"
 107     , "-------------"
 108     , "Use ^C to interrupt requests and abort prompts and so forth."
 109     , "^C will never quit the program."
 110     , ""
 111     , "Use enter or 'q' to quit the pager, and space or 1-9 or 'h' to advance,"
 112     , "and '>' to queue commands. See \"{help} {pager}\" for further details and commands."
 113     , ""
 114     , "There are a few more obscure commands;"
 115     , "use {commands} to show them all, and \"{help} [command]\" for information."
 116     , ""
 117     , "Use \"{help} {topics}\" for a list of further help topics."
 118     , ""
 119 #ifdef WINDOWS
 120     , withBoldStr "Windows"
 121     , "-------------"
 122     , "diohsc was written with unix-like systems in mind."
 123     , "Various commands may not work well on Windows,"
 124     , "and some of the help text may be unhelpful. Sorry about that."
 125     , "Please do write to mbays@sdf.org with your complaints/bugreports."
 126 #endif
 127     ]
 128
 129 topics :: [String]
 130 topics = ["targets", "queue", "pager", "trust", "configuration"
 131     , "default_action", "proxies", "geminators", "render_filter"
 132     , "pre_display", "link_desc_first", "log_length", "max_wrap_width", "no_confirm"
 133     , "verbose_connection", "copying", "topics"]
 134
 135 helpOn :: String -> [String]
 136 helpOn s =
 137     fromMaybe ["Unknown command/topic; use {commands} and \"{help} {topics}\" for lists."] $ msum
 138         [ commandHelp <$> normaliseCommand s
 139         , topicHelp <$> completeTopic ]
 140     where
 141     completeTopic = headMay . filter (isPrefixOf s) $ topics ++ topicSynonyms
 142     topicSynonyms = ["geminator", "proxy"]
 143     topicHelp = \case
 144         "topics" -> ('{' :) . (++"}") <$> topics
 145         "targets" ->
 146             [ "Many commands can be given a target or targets to operate on."
 147             , "These are written before the command."
 148             , "A target consists of an optional base target optionally followed by modifiers."
 149             , ""
 150             , "Base target:"
 151             , "    example.com , gemini://example.com : absolute URI"
 152             , "    3                                  : link from current"
 153             , "    .. , ./foo , ../foo , /foo , ?foo  : URI relative to current location"
 154             , "    'example , 'ex , 'e                : location marked with \"mark example\""
 155             , "    ''                                 : location last jumped away from"
 156             , "    ~                                  : next queue item"
 157             , "    $5                                 : log item"
 158             , "  If no base target is given, the current location is used as the base."
 159             , ""
 160             , "Modifiers"
 161             , "    /foo , ?foo    : URI relative to base"
 162             , "    _3             : link from base"
 163             , "    < , {-back}    : origin of base"
 164             , "    > , {-forward} : location of which base is the origin (if any)"
 165             , "    ]              : link after \">\""
 166             , "    [              : link before \">\""
 167             , "    @              : root of base (i.e. recursive origin)"
 168             , "  The \"origin\" of a location reached via a link is the link's source."
 169             , "  Similarly for relative URIs. Other locations have no origin."
 170             , ""
 171             , "Example session demonstrating basic navigation:"
 172             , "    'ex?foo  : Go to mark \"'example\", but with query string set to \"foo\"."
 173             , "    5        : Go to link 5 from 'ex?foo."
 174             , "    <        : Go back to 'ex?foo."
 175             , "    ]        : Go to link 6 from 'ex?foo."
 176             , "    <_2      : Go to link 2 from 'ex?foo."
 177             , "    <]       : Go to link 3 from 'ex?foo. Call this location B."
 178             , "    7        : Go to link 7 from B. Call this location C."
 179             , "    <<]      : Go to link 4 from 'ex?foo. C is now set as the jump mark \"''\"."
 180             , "    ''<]     : Go to link 8 from B."
 181             , "    @/bar    : Go to 'ex/bar"
 182             , ""
 183             , "Numbered, range, and search targets:"
 184             , "  The specifiers \"$\", \"~\", \"<\", \">\", \"[\" and \"]\" all accept"
 185             , "  a number, or repetition of the symbol, to specify a particular item."
 186             , "  e.g \"~~~\" and \"~3\" both refer to the third queue entry."
 187             , ""
 188             , "  Specify ranges with \"-\"; start and/or end may be omitted."
 189             , "  Specify first match of pattern with \"^pattern^\","
 190             , "  or all matches with \"^^pattern^\"."
 191             , "  Specify multiple items or ranges by separating with \",\"."
 192             , "  Last item is denoted by \"$\", and nth from last by \"$n\"."
 193             , "  Examples: \"1,3-5,^pattern^-$2\" refers to links 1,3,4,5 and all links from"
 194             , "    the first match of pattern to the penultimate item;"
 195             , "    \"~-\" refers to the whole queue."
 196             , ""
 197             , "  Patterns are (extended) regular expressions (see `man 7 regex`)."
 198             , "  Matching is case-insensitive unless pattern contains an uppercase character."
 199             , "  Space and '^' in patterns must be backslash-escaped."
 200             , "  The terminating \"^\" may be omitted."
 201             , ""
 202             , "Restricting to unvisited:"
 203             , "  \"}\", \"{\", and \"*\" work like \"]\", \"[\", and \"_\","
 204             , "  but consider only unvisited links. Example: \"*-a\" adds all unvisited links."
 205             , ""
 206             , "See also: {mark}, {queue}, {alias}, {query}"
 207             ]
 208         "queue" ->
 209             [ "The queue is a list of uris, which you can add to with \"add\""
 210             , "and visit using {next} or by referring to them as \"~\", \"~3\", etc."
 211             , ""
 212             , "One way to use this: Whenever you see multiple links you would like to read,"
 213             , "where in a tabbed browser you might open a new background tab for each,"
 214             , "you can add them to the queue and then read each in turn."
 215             , "A queue item is deleted by {delete} or any command which requests the uri;"
 216             , "use marks and history (including \"$^pattern\") to revisit old entries."
 217             , ""
 218             , "You can use e.g. \"-a0\" to add all links to the *start* of the queue."
 219             , "The queue can be manipulated with {add}; e.g."
 220             , "\"~4-a0\" shifts queue entries ~4 onwards to the start of the queue."
 221             , "The queue can also be used to build a list of targets for batch processing;"
 222             , "e.g. you can add the desired uris to the queue then use \"~-|grep pattern\"."
 223             , ""
 224             , "Any uris written to {~/queue} (one uri per line)"
 225             , "will be added to the queue, after which that file will be deleted."
 226             , "This allows e.g. an rss reader to add to the queue of a diohsc instance."
 227             , ""
 228             , "You may also create named queues like \"foo~\" with a name argument to {add}."
 229             , "The corresponding file is e.g. {~/queues/foo}."
 230             ]
 231         "pager" ->
 232             [ "Keys for the inbuilt pager:"
 233             , "  space    : advance one page"
 234             , "  h        : advance half a page"
 235             , "  1-9      : advance by the specified number of lines"
 236             , "  c        : continue to end"
 237             , "  q, enter : quit pager"
 238             , "  :, >     : enter a diohsc command to be executed immediately. Examples:"
 239             , "             \":3v\" views link 3 (e.g. an image)"
 240             , "             \":5a\" adds link 5 to the uri queue"
 241             , ""
 242             , "There is no way to go backwards; use your terminal's scrollback facility."
 243             , "The {||} command can be used to invoke an alternative pager."
 244             , "See also: {default_action}" ]
 245         "proxies" ->
 246             [ "{set} {proxy} SCHEME HOST:PORT : Set proxy for requests using given scheme"
 247             , "{set} {proxy} SCHEME : unset proxy"
 248             , ""
 249             , "Example:"
 250             , "  set proxy gopher 127.0.0.1:1965"
 251             , "to use an Agena ({%Yellow%https://tildegit.org/solderpunk/agena}) instance"
 252             , "running locally with its default configuration." ]
 253         "proxy" -> topicHelp "proxies"
 254         "trust" ->
 255             [ "A valid certificate chain presented by a server will be trusted if the root"
 256             , "is a Certificate Authority certificate found under {~/trusted_certs/}."
 257             , "Otherwise you will be asked whether to trust the server certificate."
 258             , "If you accept, it will be saved in {~/known_hosts/},"
 259             , "and you will be warned if the server ever presents a different certificate." ]
 260         "configuration" ->
 261             [ "There are some commandline options; try \"diohsc --help\"."
 262             , ""
 263             , "There are also some options which can be set at run-time;"
 264             , "use {set} for a list and their current values. Each option is a help topic."
 265             , ""
 266             , "{~/diohscrc} may contain commands to run at startup,"
 267             , "e.g. setting aliases and identities and the options mentioned above;"
 268             , "each line of the file is interpreted as a command."
 269             , "See diohscrc.sample in the source distribution for some suggestions."
 270             , ""
 271             , "The files in {~/} can be edited."
 272             , "To change the default save directory,"
 273             , "make {~/saves} a symlink."
 274             , "To disable command history, make {~/commandHistory}"
 275             , "a symlink to /dev/null ; similarly for inputHistory and log."
 276             , "(Alternatively, use the --ghost commandline option.)"
 277             , ""
 278             , "The line editor can be configured:"
 279             , "see {%Yellow%https://github.com/judah/haskeline/wiki/UserPreferences}"
 280             , ""
 281             , "See also: {alias}, {identify}, {set}, {trust}" ]
 282         "default_action" ->
 283             [ "{set} {default_action} COMMAND [ARGS]: set action used on going to a new location."
 284             , "The default is \"page\". You may prefer \"||\", or e.g. \"|| less\"."
 285             , "See also: {configuration}" ]
 286         "geminator" -> topicHelp "geminators"
 287         "geminators" ->
 288             [ "{set} {geminators} MIMETYPE COMMAND: set shell command for conversion to text/gemini."
 289             , "{set} {geminators} MIMETYPE: unset geminator."
 290             , ""
 291             , "The body of a response with a matching mimetype is piped through the command,"
 292             , "and the output used as gemini text for rendering (\"page\", \"||\", etc),"
 293             , "and for obtaining links."
 294             , ""
 295             , "Mimetype is a regular expression. The first matching geminator will be used."
 296             , ""
 297             , "Examples:"
 298             , "  set gem text/markdown md2gemini -l paragraph"
 299             , "    (see {%Yellow%https://github.com/makeworld-the-better-one/md2gemini})"
 300             , "  set gem (text|application)/(html|xml|xhtml.*) html2gmi -me"
 301             , "    (see {%Yellow%https://github.com/LukeEmmet/html2gmi})"
 302             , "  set gem image/jpeg echo '```' && jp2a --colors - && echo '```'"
 303             , "  set gem image/.* echo '```' && convert - jpeg:- | jp2a --colors - && echo '```'"
 304             , "    (ascii-art preview of images)" ]
 305         "render_filter" ->
 306             [ "{set} {render_filter} COMMAND: set shell command to filter rendered text through."
 307             , "{set} {render_filter}: unset render_filter."
 308             , ""
 309             , "Whenever the rendered text of a page would be used (\"page\", \"||\", etc),"
 310             , "it will be piped through this command first."
 311             , ""
 312             , "Example:"
 313             , "  set render_filter stdbuf -o0 uni2ascii -BPq"
 314             , "    (best-effort substitution of utf8 with pure-ascii equivalents)" ]
 315         "pre_display" ->
 316             [ "{set} {pre_display} pre: suppress alt text of preformatted blocks"
 317             , "{set} {pre_display} alt: display only alt text of preformatted blocks"
 318             , "{set} {pre_display} both: display alt text and contents of preformatted blocks" ]
 319         "link_desc_first" ->
 320             [ "{set} {link_desc_first} true: show link description before uri"
 321             , "{set} {link_desc_first} false: show uri before link description" ]
 322         "log_length" ->
 323             [ "{set} {log_length} N: set number of items to store in log"
 324             , "{set} {log_length} 0: clear log and disable logging"
 325             , "See also: {log}" ]
 326         "max_wrap_width" ->
 327             [ "{set} {max_wrap_width} N: set maximum width for text wrapping" ]
 328         "no_confirm" ->
 329             [ "{set} {no_confirm} true: disable confirmation prompts for certain commands"
 330             , "{set} {no_confirm} false: re-enable confirmation prompts"
 331             , ""
 332             , "You are advised not to enable this until you are familiar with the behaviour of"
 333             , "the potentially dangerous commands like \"|\" and \"!\"" ]
 334         "verbose_connection" ->
 335             [ "{set} {verbose_connection} true: show extra information about connections"
 336             , "{set} {verbose_connection} false: suppress extra information about connections"
 337             ]
 338         "copying" ->
 339             [ "diohsc is free software, released under the terms of the GNU GPL v3 or later."
 340             , "You should have obtained a copy of the licence as the file COPYING."
 341             , "This version of diohsc is copyright Martin Bays <mbays@sdf.org> 2020." ]
 342         t -> ["No help on topic \"" <> t <> "\"."]
 343     commandHelp = \case
 344         "help" ->
 345             [ "help: show general help"
 346             , "help COMMAND: show help on command" ]
 347         "quit" -> ["quit"]
 348         "repeat" -> ["TARGET repeat: request target"]
 349         "mark" ->
 350             [ "TARGET {mark} MARK: mark target, which can subsequently be specified as 'MARK."
 351             , "{mark}: list marks."
 352             , "Marks are saved in {~/marks}. To delete a mark, remove the corresponding file."
 353             , ""
 354             , "The mark '' is a special \"jump back\" mark which is automatically set when"
 355             , "navigating to a new uri without following a link."
 356             , ""
 357             , "Marks '0 to '9 are special per-session marks:"
 358             , "they are not saved, and they are listed in the output of \"inventory\"."
 359             , ""
 360             , "The marks '' and '0-'9 refer to targets with their full history;"
 361             , "they and their ancestors can be manipulated without causing network requests." ]
 362         "inventory" ->
 363             [ "{inventory}: show current queue (~N), path (<N,>N), and session marks ('N)."
 364             , "See also: {log}" ]
 365         "log" ->
 366             [ "{log}: show log."
 367             , "TARGETS {log}: add targets to log."
 368             , ""
 369             , "The \"log\" is a list of visited URIs."
 370             , "Its entries can be referenced with \"$\"."
 371             , ""
 372             , "URIs added to the log are considered \"visited\"; they are shown in a"
 373             , "different colour and can be referenced with \"*\", \"{\", and \"}\"."
 374             , ""
 375             , "The log is saved in {~/log}."
 376             , "To prevent excessive resource use and limit the privacy implications,"
 377             , "the length of the log is bounded by the option {log_length}." ]
 378         "identify" ->
 379             [ "TARGET {identify} [IDENTITY]: identify (as identity) for all future"
 380             , "  requests to target and to paths below target."
 381             , "  If identity doesn't exist, create a new identity."
 382             , ""
 383             , "An \"identity\" is a cryptographic certificate,"
 384             , "sent to the server to securely identify you to the server."
 385             , "An identity which will be used for a request is indicated as \"{%Yellow%uri}[{%Green%identity}]\"."
 386             , ""
 387             , "TARGET {identify} IDENTITY ed: create identity with an Ed25519 key pair"
 388             , "Ed25519 uses much smaller keys than the default RSA algorithm,"
 389             , "but some servers may fail to accept identities created using it."
 390             , "See also: {configuration}" ]
 391         "add" ->
 392             [ "TARGETS {add}: add targets to the end of the queue."
 393             , "TARGETS {add} 0: add targets to the start of the queue."
 394             , "TARGETS {add} N: add targets to the queue after entry ~N."
 395             , ""
 396             , "TARGETS {add} foo: add targets to the named queue foo~."
 397             , "TARGETS {add} foo N: add targets to the named queue after entry foo~N."
 398             , ""
 399             , "See also: {fetch}, {queue}, {targets}." ]
 400         "fetch" ->
 401             [ "{fetch} acts like {add}, but targets are fetched and cached before being added."
 402             , "See {add} for syntax." ]
 403         "delete" ->
 404             [ "TARGETS {delete}: delete specified uris from the queue."
 405             , "e.g. \"~3-5,7d\" to delete certain entries, or \"~-d\" to clear the queue,"
 406             , "or \"-d\" to delete all queue entries which are links from the current location."
 407             , ""
 408             , "TARGETS {delete} foo: delete specified uris from the named queue foo~."
 409             ]
 410         "show" -> ["TARGET {show}: show rendered text of target, without paging."]
 411         "page" -> [ "TARGET {page}: page rendered text of target."
 412             , "See also: {pager}, {default_action}" ]
 413         "uri" -> ["TARGET {uri}: show absolute uri of target."]
 414         "links" -> ["TARGET {links}: show list of links of target."]
 415         "mime" -> [ "TARGET {mime}: show mime type of target."
 416             , "Note: any request this causes will be closed after receiving the header." ]
 417         "save" -> [ "TARGET {save} [PATH]: save body."
 418             , "If path is omitted or relative, it is based on {~/saves/} ."
 419             , "The default filename is the last non-empty segment of the uri path,"
 420             , "or the hostname if the path is empty." ]
 421         "view" -> [ "TARGET {view}: run \"run-mailcap --view\" on body."
 422             , "The action is determined by the mime-type; see the run-mailcap manpage." ]
 423         "browse" -> [ "TARGET {browse}: run command given by environment variable $BROWSER on uri."
 424             , "TARGET {browse} COMMAND: run given shell command on uri."
 425             , "%s is substituted with the uri"
 426             , "if no %s appears, the uri is used as an additional final argument."
 427             , "A literal '%' can be escaped as '%%'."
 428             , ""
 429             , "If an identity would be used at the target URI (if it had scheme gemini),"
 430             , "the environment variables $CLIENT_CERT and $CLIENT_KEY will be set to the paths"
 431             , "of the corresponding certificate and private key files." ]
 432         "!" -> [ "TARGET {!} COMMAND: run shell command on body."
 433             , "The line after '!' is used as a shell command after transforming as follows:"
 434             , "%s is substituted with the path to a temporary file containing the target;"
 435             , "if no %s appears, this path is appended to the end (separated by a space)."
 436             , "A literal '%' can be escaped as '%%'."
 437             , ""
 438             , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY"
 439             , "are set to correspond to the target." ]
 440         "|" -> [ "TARGET {|} COMMAND: pipe body through shell command."
 441             , ""
 442             , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY"
 443             , "are set to correspond to the target." ]
 444         "||" -> [ "TARGET {||} [COMMAND]: pipe rendered text through shell command."
 445             , "The default command is the contents of the environment variable $PAGER."
 446             , ""
 447             , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY"
 448             , "are set to correspond to the target."
 449             , ""
 450             , "See {||-} for a variant which does not produce ansi escapes."
 451             , "See also: {default_action}, {||-}" ]
 452         "||-" -> [ "TARGET {||-} [COMMAND]: pipe plain rendered text through shell command."
 453             , "This is the same as {||}, but no ansi escapes are included in the text." ]
 454         "cat" -> [ "TARGET {cat}: print raw contents of location" ]
 455         "commands" -> [ "{commands}: show list of commands and aliases,"
 456             , "in order of priority when expanding abbreviations,"
 457             , "and show the shortest permissible abbreviations."
 458             , "See also: {alias}"]
 459         "query" -> [ "TARGET {query} QUERY: request target with query set to QUERY."
 460             , "Unlike TARGET?QUERY, this command does not require spaces to be escaped,"
 461             , "and it can be aliased; e.g. if 'search is a mark set to a search engine:"
 462             , "  alias S 'search query"
 463             , "  S ascii art cat"
 464             , ""
 465             , "The following backslash escape sequences will be interpreted"
 466             , "(these can also be used with TARGET?QUERY by escaping the backslash):"
 467             , "  \\n   : newline"
 468             , "  \\r   : carriage return"
 469             , "  \\e   : escape"
 470             , "  \\t   : tab"
 471             , "  \\xHH : byte with given hex encoding"
 472             , "  \\\\   : backslash"
 473             ]
 474         "repl" -> [ "TARGET {repl}: enter read-eval-print-loop,"
 475             , "in which each line of input is used as a query string at the target."
 476             , "To return to normal command mode, enter an empty query or ^C or ^D." ]
 477         "alias" ->
 478             [ "{alias} ALIAS COMMANDLINE: add an alias"
 479             , "{alias} ALIAS: delete an existing alias"
 480             , "The commandline may include targets and/or a command."
 481             , "Examples:"
 482             , "  alias up .. : then \"up\" translates to \"..\", and e.g. \"u add\" to \".. add\""
 483             , "  alias Mpv |mpv --cache-secs 5 - : then \"2M\" will stream link 2 to mpv"
 484             , "      with this sane caching (mpv's default cache size is 150M!)"
 485             , "You can put alias commands in {~/diohscrc};"
 486             , "see \"{help} {configuration}\"." ]
 487         "set" -> [ "{set}: show settable options and their current values"
 488             , "{set} OPTION VALUE [..]: set option"
 489             , "Try using {help} on the options."
 490             , "See also: {configuration}"
 491             ]
 492         "at" -> [ "TARGET {at} COMMANDLINE: request target then execute commandline based there."
 493             , ""
 494             , "Example: 'example at *- add: add all unvisited links from 'example to queue." ]
 495         c -> ["No help on command \"" <> c <> "\"."]
 496
 497 showMinPrefix :: Bool -> [String] -> String -> String
 498 showMinPrefix ansi ss s =
 499     let n = maximumBound 0 $ commonPrefLen s <$> takeWhile (/= s) ss
 500         (s',s'') = splitAt (n+1) s
 501     in if n == length s
 502         then s <> applyIf ansi (withColourStr Red) " [Not typable!]"
 503         else applyIf ansi withBoldStr s' <>
 504             applyIf (not $ ansi || null s'') (('[':) . (++"]")) s''
 505     where
 506     commonPrefLen :: Eq a => [a] -> [a] -> Int
 507     commonPrefLen bs cs = head [ n
 508         | n <- [0..]
 509         , let mb = atMay bs n
 510         , let mc = atMay cs n
 511         , isNothing mb || isNothing mc || mb /= mc
 512         ]
 513
 514 -- indicate initial prefix of commands/aliases in string, marked as {command},
 515 -- and topics marked as {topic},
 516 -- and path from userdir, marked as {~/path}.
 517 -- Use {-command blah} in a table, it adds spaces as necessary.
 518 -- e.g. {%Yellow%str} prints str in yellow (when ansi).
 519 expandHelp :: Bool -> [String] -> String -> String -> String
 520 expandHelp ansi aliases userDir = expandHelp' where
 521     cs = aliases ++ commands False
 522     expandHelp' s
 523         | (pre,'{':s') <- break (== '{') s
 524         , (twixt,'}':post) <- break (== '}') s'
 525         = let sub = case twixt of
 526                 '~':'/':path -> userDir </> path
 527                 '-':cBlah | (c,blah) <- break (== ' ') cBlah
 528                         , c `elem` cs ->
 529                     let c' = showMinPrefix ansi cs c
 530                         missing = length c + 3 - visibleLength (T.pack c')
 531                     in c' <> blah <> replicate missing ' '
 532                 '%':t' | (colStr,'%':str) <- break (== '%') t'
 533                         , Just col <- readMay colStr ->
 534                     applyIf ansi (withColourStr col) str
 535                 c | c `elem` cs -> showMinPrefix ansi cs c
 536                 t | t `elem` topics -> showMinPrefix ansi (cs ++ topics) t
 537                 _ -> '{' : twixt ++ "}"
 538             in pre <> sub <> expandHelp' post
 539         | otherwise = s