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", "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         "pager" ->
 228             [ "Keys for the inbuilt pager:"
 229             , "  space    : advance one page"
 230             , "  h        : advance half a page"
 231             , "  1-9      : advance by the specified number of lines"
 232             , "  c        : continue to end"
 233             , "  q, enter : quit pager"
 234             , "  :, >     : enter a diohsc command to be executed after quitting the pager"
 235             , "             example: \":3a\" adds link 3 to the uri queue"
 236             , "There is no way to go back."
 237             , "The {||} command can be used to invoke an alternative pager."
 238             , "See also: {default_action}" ]
 239         "proxies" ->
 240             [ "{set} {proxy} SCHEME HOST:PORT : Set proxy for requests using given scheme"
 241             , "{set} {proxy} SCHEME : unset proxy"
 242             , ""
 243             , "Example:"
 244             , "  set proxy gopher 127.0.0.1:1965"
 245             , "to use an Agena ({%Yellow%https://tildegit.org/solderpunk/agena}) instance"
 246             , "running locally with its default configuration." ]
 247         "proxy" -> topicHelp "proxies"
 248         "trust" ->
 249             [ "A valid certificate chain presented by a server will be trusted if the root"
 250             , "is a Certificate Authority certificate found under {~/trusted_certs/}."
 251             , "Otherwise you will be asked whether to trust the server certificate."
 252             , "If you accept, it will be saved in {~/known_hosts/},"
 253             , "and you will be warned if the server ever presents a different certificate." ]
 254         "configuration" ->
 255             [ "There are some commandline options; try \"diohsc --help\"."
 256             , ""
 257             , "There are also some options which can be set at run-time;"
 258             , "use {set} for a list and their current values. Each option is a help topic."
 259             , ""
 260             , "{~/diohscrc} may contain commands to run at startup,"
 261             , "e.g. setting aliases and identities and the options mentioned above;"
 262             , "each line of the file is interpreted as a command."
 263             , "See diohscrc.sample in the source distribution for some suggestions."
 264             , ""
 265             , "The files in {~/} can be edited."
 266             , "To change the default save directory,"
 267             , "make {~/saves} a symlink."
 268             , "To disable command history, make {~/commandHistory}"
 269             , "a symlink to /dev/null ; similarly for inputHistory and log."
 270             , "(Alternatively, use the --ghost commandline option.)"
 271             , ""
 272             , "The line editor can be configured:"
 273             , "see {%Yellow%https://github.com/judah/haskeline/wiki/UserPreferences}"
 274             , ""
 275             , "See also: {alias}, {identify}, {set}, {trust}" ]
 276         "default_action" ->
 277             [ "{set} {default_action} COMMAND [ARGS]: set action used on going to a new location."
 278             , "The default is \"page\". You may prefer \"||\", or e.g. \"|| less\"."
 279             , "See also: {configuration}" ]
 280         "geminator" -> topicHelp "geminators"
 281         "geminators" ->
 282             [ "{set} {geminators} MIMETYPE COMMAND: set shell command for conversion to text/gemini."
 283             , "{set} {geminators} MIMETYPE: unset geminator."
 284             , ""
 285             , "The body of a response with a matching mimetype is piped through the command,"
 286             , "and the output used as gemini text for rendering (\"page\", \"||\", etc),"
 287             , "and for obtaining links."
 288             , ""
 289             , "Mimetype is a regular expression. The first matching geminator will be used."
 290             , ""
 291             , "Examples:"
 292             , "  set gem text/markdown md2gemini -l paragraph"
 293             , "    (see {%Yellow%https://github.com/makeworld-the-better-one/md2gemini})"
 294             , "  set gem (text|application)/(html|xml|xhtml.*) html2gmi -me"
 295             , "    (see {%Yellow%https://github.com/LukeEmmet/html2gmi})"
 296             , "  set gem image/jpeg echo '```' && jp2a --colors - && echo '```'"
 297             , "  set gem image/.* echo '```' && convert - jpeg:- | jp2a --colors - && echo '```'"
 298             , "    (ascii-art preview of images)" ]
 299         "render_filter" ->
 300             [ "{set} {render_filter} COMMAND: set shell command to filter rendered text through."
 301             , "{set} {render_filter}: unset render_filter."
 302             , ""
 303             , "Whenever the rendered text of a page would be used (\"page\", \"||\", etc),"
 304             , "it will be piped through this command first."
 305             , ""
 306             , "Example:"
 307             , "  set render_filter stdbuf -o0 uni2ascii -BPq"
 308             , "    (best-effort substitution of utf8 with pure-ascii equivalents)" ]
 309         "pre_display" ->
 310             [ "{set} {pre_display} pre: suppress alt text of preformatted blocks"
 311             , "{set} {pre_display} alt: display only alt text of preformatted blocks"
 312             , "{set} {pre_display} both: display alt text and contents of preformatted blocks" ]
 313         "link_desc_first" ->
 314             [ "{set} {link_desc_first} true: show link description before uri"
 315             , "{set} {link_desc_first} false: show uri before link description" ]
 316         "log_length" ->
 317             [ "{set} {log_length} N: set number of items to store in log"
 318             , "{set} {log_length} 0: clear log and disable logging"
 319             , "See also: {log}" ]
 320         "max_wrap_width" ->
 321             [ "{set} {max_wrap_width} N: set maximum width for text wrapping" ]
 322         "no_confirm" ->
 323             [ "{set} {no_confirm} true: disable confirmation prompts for certain commands"
 324             , "{set} {no_confirm} false: re-enable confirmation prompts"
 325             , ""
 326             , "You are advised not to enable this until you are familiar with the behaviour of"
 327             , "the potentially dangerous commands like \"|\" and \"!\"" ]
 328         "verbose_connection" ->
 329             [ "{set} {verbose_connection} true: show extra information about connections"
 330             , "{set} {verbose_connection} false: suppress extra information about connections"
 331             ]
 332         "copying" ->
 333             [ "diohsc is free software, released under the terms of the GNU GPL v3 or later."
 334             , "You should have obtained a copy of the licence as the file COPYING."
 335             , "This version of diohsc is copyright Martin Bays <mbays@sdf.org> 2020." ]
 336         t -> ["No help on topic \"" <> t <> "\"."]
 337     commandHelp = \case
 338         "help" ->
 339             [ "help: show general help"
 340             , "help COMMAND: show help on command" ]
 341         "quit" -> ["quit"]
 342         "repeat" -> ["TARGET repeat: request target"]
 343         "mark" ->
 344             [ "TARGET {mark} MARK: mark target, which can subsequently be specified as 'MARK."
 345             , "{mark}: list marks."
 346             , "Marks are saved in {~/marks}. To delete a mark, remove the corresponding file."
 347             , ""
 348             , "The mark '' is a special \"jump back\" mark which is automatically set when"
 349             , "navigating to a new uri without following a link."
 350             , ""
 351             , "Marks '0 to '9 are special per-session marks:"
 352             , "they are not saved, and they are listed in the output of \"inventory\"."
 353             , ""
 354             , "The marks '' and '0-'9 refer to targets with their full history;"
 355             , "they and their ancestors can be manipulated without causing network requests." ]
 356         "inventory" ->
 357             [ "{inventory}: show current queue (~N), path (<N,>N), and session marks ('N)."
 358             , "See also: {log}" ]
 359         "log" ->
 360             [ "{log}: show log."
 361             , "TARGETS {log}: add targets to log."
 362             , ""
 363             , "The \"log\" is a list of visited URIs."
 364             , "Its entries can be referenced with \"$\"."
 365             , ""
 366             , "URIs added to the log are considered \"visited\"; they are shown in a"
 367             , "different colour and can be referenced with \"*\", \"{\", and \"}\"."
 368             , ""
 369             , "The log is saved in {~/log}."
 370             , "To prevent excessive resource use and limit the privacy implications,"
 371             , "the length of the log is bounded by the option {log_length}." ]
 372         "identify" ->
 373             [ "TARGET {identify} [IDENTITY]: identify (as identity) for all future"
 374             , "  requests to target and to paths below target."
 375             , "  If identity doesn't exist, create a new identity."
 376             , ""
 377             , "An \"identity\" is a cryptographic certificate,"
 378             , "sent to the server to securely identify you to the server."
 379             , "An identity which will be used for a request is indicated as \"{%Yellow%uri}[{%Green%identity}]\"."
 380             , ""
 381             , "TARGET {identify} IDENTITY ed: create identity with an Ed25519 key pair"
 382             , "Ed25519 uses much smaller keys than the default RSA algorithm,"
 383             , "but some servers may fail to accept identities created using it."
 384             , "See also: {configuration}" ]
 385         "add" ->
 386             [ "TARGETS {add}: add targets to the end of the queue."
 387             , "TARGETS {add} 0: add targets to the start of the queue."
 388             , "TARGETS {add} N: add targets to the queue after entry ~N."
 389             , "See also: {queue}, {targets}." ]
 390         "delete" ->
 391             [ "TARGETS {delete}: delete specified uris from queue."
 392             , "e.g. \"~3-5,7d\" to delete certain entries, or \"~-d\" to clear the queue,"
 393             , "or \"-d\" to delete all queue entries which are links from the current location." ]
 394         "show" -> ["TARGET {show}: show rendered text of target, without paging."]
 395         "page" -> [ "TARGET {page}: page rendered text of target."
 396             , "See also: {pager}, {default_action}" ]
 397         "uri" -> ["TARGET {uri}: show absolute uri of target."]
 398         "links" -> ["TARGET {links}: show list of links of target."]
 399         "mime" -> [ "TARGET {mime}: show mime type of target."
 400             , "Note: any request this causes will be closed after receiving the header." ]
 401         "save" -> [ "TARGET {save} [PATH]: save body."
 402             , "If path is omitted or relative, it is based on {~/saves/} ."
 403             , "The default filename is the last non-empty segment of the uri path,"
 404             , "or the hostname if the path is empty." ]
 405         "view" -> [ "TARGET {view}: run \"run-mailcap --view\" on body."
 406             , "The action is determined by the mime-type; see the run-mailcap manpage." ]
 407         "browse" -> [ "TARGET {browse}: run command given by environment variable $BROWSER on uri."
 408             , "TARGET {browse} COMMAND: run given shell command on uri."
 409             , "%s is substituted with the uri"
 410             , "if no %s appears, the uri is used as an additional final argument."
 411             , "A literal '%' can be escaped as '%%'." ]
 412         "!" -> [ "TARGET {!} COMMAND: run shell command on body."
 413             , "The line after '!' is used as a shell command after transforming as follows:"
 414             , "%s is substituted with the path to a temporary file containing the target;"
 415             , "if no %s appears, this path is appended to the end (separated by a space)."
 416             , "A literal '%' can be escaped as '%%'."
 417             , "Environment variables $URI and $MIMETYPE are set to correspond to the target." ]
 418         "|" -> [ "TARGET {|} COMMAND: pipe body through shell command."
 419             , "Environment variables $URI and $MIMETYPE are set to correspond to the target." ]
 420         "||" -> [ "TARGET {||} [COMMAND]: pipe rendered text through shell command."
 421             , "The default command is the contents of the environment variable $PAGER."
 422             , "Environment variables $URI and $MIMETYPE are set to correspond to the target."
 423             , "See {||-} for a variant which does not produce ansi escapes."
 424             , "See also: {default_action}, {||-}" ]
 425         "||-" -> [ "TARGET {||-} [COMMAND]: pipe plain rendered text through shell command."
 426             , "This is the same as {||}, but no ansi escapes are included in the text." ]
 427         "cat" -> [ "TARGET {cat}: print raw contents of location" ]
 428         "commands" -> [ "{commands}: show list of commands and aliases,"
 429             , "in order of priority when expanding abbreviations,"
 430             , "and show the shortest permissible abbreviations."
 431             , "See also: {alias}"]
 432         "query" -> [ "TARGET {query} QUERY: request target with query set to QUERY."
 433             , "Unlike TARGET?QUERY, this command does not require spaces to be escaped,"
 434             , "and it can be aliased; e.g. if 'search is a mark set to a search engine:"
 435             , "  alias S 'search query"
 436             , "  S ascii art cat" ]
 437         "repl" -> [ "TARGET {repl}: enter read-eval-print-loop,"
 438             , "in which each line of input is used as a query string at the target."
 439             , "To return to normal command mode, enter an empty query or ^C or ^D." ]
 440         "alias" ->
 441             [ "{alias} ALIAS COMMANDLINE: add an alias"
 442             , "{alias} ALIAS: delete an existing alias"
 443             , "The commandline may include targets and/or a command."
 444             , "Examples:"
 445             , "  alias up .. : then \"up\" translates to \"..\", and e.g. \"u add\" to \".. add\""
 446             , "  alias Mpv |mpv --cache-secs 5 - : then \"2M\" will stream link 2 to mpv"
 447             , "      with this sane caching (mpv's default cache size is 150M!)"
 448             , "You can put alias commands in {~/diohscrc};"
 449             , "see \"{help} {configuration}\"." ]
 450         "set" -> [ "{set}: show settable options and their current values"
 451             , "{set} OPTION VALUE [..]: set option"
 452             , "Try using {help} on the options."
 453             , "See also: {configuration}"
 454             ]
 455         "at" -> [ "TARGET {at} COMMANDLINE: request target then execute commandline based there."
 456             , ""
 457             , "Example: 'example at *- add: add all unvisited links from 'example to queue." ]
 458         c -> ["No help on command \"" <> c <> "\"."]
 459
 460 showMinPrefix :: Bool -> [String] -> String -> String
 461 showMinPrefix ansi ss s =
 462     let n = maximumBound 0 $ commonPrefLen s <$> takeWhile (/= s) ss
 463         (s',s'') = splitAt (n+1) s
 464     in if n == length s
 465         then s <> applyIf ansi (withColourStr Red) " [Not typable!]"
 466         else applyIf ansi withBoldStr s' <>
 467             applyIf (not $ ansi || null s'') (('[':) . (++"]")) s''
 468     where
 469     commonPrefLen :: Eq a => [a] -> [a] -> Int
 470     commonPrefLen bs cs = head [ n
 471         | n <- [0..]
 472         , let mb = atMay bs n
 473         , let mc = atMay cs n
 474         , isNothing mb || isNothing mc || mb /= mc
 475         ]
 476
 477 -- indicate initial prefix of commands/aliases in string, marked as {command},
 478 -- and topics marked as {topic},
 479 -- and path from userdir, marked as {~/path}.
 480 -- Use {-command blah} in a table, it adds spaces as necessary.
 481 -- e.g. {%Yellow%str} prints str in yellow (when ansi).
 482 expandHelp :: Bool -> [String] -> String -> String -> String
 483 expandHelp ansi aliases userDir = expandHelp' where
 484     cs = aliases ++ commands False
 485     expandHelp' s
 486         | (pre,'{':s') <- break (== '{') s
 487         , (twixt,'}':post) <- break (== '}') s'
 488         = let sub = case twixt of
 489                 '~':'/':path -> userDir </> path
 490                 '-':cBlah | (c,blah) <- break (== ' ') cBlah
 491                         , c `elem` cs ->
 492                     let c' = showMinPrefix ansi cs c
 493                         missing = length c + 3 - visibleLength (T.pack c')
 494                     in c' <> blah <> replicate missing ' '
 495                 '%':t' | (colStr,'%':str) <- break (== '%') t'
 496                         , Just col <- readMay colStr ->
 497                     applyIf ansi (withColourStr col) str
 498                 c | c `elem` cs -> showMinPrefix ansi cs c
 499                 t | t `elem` topics -> showMinPrefix ansi (cs ++ topics) t
 500                 _ -> '{' : twixt ++ "}"
 501             in pre <> sub <> expandHelp' post
 502         | otherwise = s