-- This file is part of Diohsc -- Copyright (C) 2020 Martin Bays -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of version 3 of the GNU General Public License as -- published by the Free Software Foundation, or any later version. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} module Command ( commands , normaliseCommand , helpText , helpOn , expandHelp , showMinPrefix ) where import Control.Monad (msum) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe, isNothing) import Safe (atMay, headMay, maximumBound, readMay) import System.FilePath (()) import qualified Data.Text.Lazy as T import ANSIColour commands :: Bool -> [String] commands restricted = metaCommands ++ navCommands ++ infoCommands ++ actionCommands restricted ++ otherCommands where metaCommands = ["help", "quit"] navCommands = ["repeat", "mark", "inventory", "identify", "add", "fetch", "delete"] infoCommands = ["show", "page", "uri", "links", "mime"] unsafeActionCommands = ["save", "view", "browse", "!", "|", "||", "||-"] safeActionCommands = ["cat"] actionCommands True = safeActionCommands actionCommands False = unsafeActionCommands ++ safeActionCommands otherCommands = ["commands", "log", "query", "repl", "alias", "set", "at"] normaliseCommand :: String -> Maybe String normaliseCommand partial = headMay . filter (isPrefixOf partial) $ commands False helpText :: [String] helpText = [ withBoldStr "Navigation" , "----------" , "Enter a URI to go to it, then enter numbers to follow links." , "" , "You can navigate to other locations as follows:" , " ../foo.gmi : Relative URI" , " < , {-back} : Back" , " > , {-forward} : Forward" , " 'foo : Marked location" , " ~ , {-next} : Next queue item" , " } : Next unvisited link" , " <} : Next unvisited link of parent" , "" , "See \"{help} {targets}\" for more." , "" , withBoldStr "Commands" , "--------" , "Meta commands:" , " {-quit} : Quit" , " {-help [TOPIC]} : This help, or help on a command or other topic" , "Navigation commands:" , " {-mark MARK} : Mark location as \"'MARK\"" , " 3-5 {-add} : Append links to queue" , " {-repeat} : Make fresh request for current location" , " {-inventory} : Show history and queue" , " {-identify [ID]} : Select/create identity (client certificate)" , " {-repl} : Enter loop making queries at current uri" , "Action commands:" , " {-show} : Print text" , " {-page} : Page text" , " {-links} : Show links" , " {-uri} : Show uri" , " {-save [FILENAME]} : Save data, by default in {~/saves/}" , " {-| CMD} : Pipe data to shell command" , " {-! CMD} : Run shell command on data" , " {-|| [CMD]} : Pipe rendered text to $PAGER or command" , " {-view} : Run mailcap command on data" , " {-browse [CMD] [ARGS]} : Run command on uri (default: $BROWSER)" , "" , "Commands and marks may be abbreviated; e.g. \"l\" is short for {links}." , "" , "Commands which act on the current location by default" , "can also be given a target before the command, e.g.:" , " 3 {|} mpv - : Request link 3 and pipe the stream to command 'mpv -'" , " << {save} blah : Save data from history item before last" , " 2 {browse} lynx : Run \"lynx [uri-of-link-2]\"" , " / {mark} root : Mark the root of the current capsule as 'root" , " / {identify} asdf : Use identity \"asdf\" for all of current capsule" , "Use \"{help} {targets}\" to get full details on this notation." , "" , "Spaces around the command can often be omitted, e.g.:" , " 2a0 : Add link 2 to start of queue" , "" , withBoldStr "Miscellaneous" , "-------------" , "Use ^C to interrupt requests and abort prompts and so forth." , "^C will never quit the program." , "" , "Use enter or 'q' to quit the pager, and space or 1-9 or 'h' to advance," , "and '>' to queue commands. See \"{help} {pager}\" for further details and commands." , "" , "There are a few more obscure commands;" , "use {commands} to show them all, and \"{help} [command]\" for information." , "" , "Use \"{help} {topics}\" for a list of further help topics." , "" #ifdef WINDOWS , withBoldStr "Windows" , "-------------" , "diohsc was written with unix-like systems in mind." , "Various commands may not work well on Windows," , "and some of the help text may be unhelpful. Sorry about that." , "Please do write to mbays@sdf.org with your complaints/bugreports." #endif ] topics :: [String] topics = ["targets", "queue", "pager", "trust", "configuration" , "default_action", "proxies", "geminators", "render_filter" , "pre_display", "link_desc_first", "log_length", "max_wrap_width", "no_confirm" , "verbose_connection", "copying", "topics"] helpOn :: String -> [String] helpOn s = fromMaybe ["Unknown command/topic; use {commands} and \"{help} {topics}\" for lists."] $ msum [ commandHelp <$> normaliseCommand s , topicHelp <$> completeTopic ] where completeTopic = headMay . filter (isPrefixOf s) $ topics ++ topicSynonyms topicSynonyms = ["geminator", "proxy"] topicHelp = \case "topics" -> ('{' :) . (++"}") <$> topics "targets" -> [ "Many commands can be given a target or targets to operate on." , "These are written before the command." , "A target consists of an optional base target optionally followed by modifiers." , "" , "Base target:" , " example.com , gemini://example.com : absolute URI" , " 3 : link from current" , " .. , ./foo , ../foo , /foo , ?foo : URI relative to current location" , " 'example , 'ex , 'e : location marked with \"mark example\"" , " '' : location last jumped away from" , " ~ : next queue item" , " $5 : log item" , " If no base target is given, the current location is used as the base." , "" , "Modifiers" , " /foo , ?foo : URI relative to base" , " _3 : link from base" , " < , {-back} : origin of base" , " > , {-forward} : location of which base is the origin (if any)" , " ] : link after \">\"" , " [ : link before \">\"" , " @ : root of base (i.e. recursive origin)" , " The \"origin\" of a location reached via a link is the link's source." , " Similarly for relative URIs. Other locations have no origin." , "" , "Example session demonstrating basic navigation:" , " 'ex?foo : Go to mark \"'example\", but with query string set to \"foo\"." , " 5 : Go to link 5 from 'ex?foo." , " < : Go back to 'ex?foo." , " ] : Go to link 6 from 'ex?foo." , " <_2 : Go to link 2 from 'ex?foo." , " <] : Go to link 3 from 'ex?foo. Call this location B." , " 7 : Go to link 7 from B. Call this location C." , " <<] : Go to link 4 from 'ex?foo. C is now set as the jump mark \"''\"." , " ''<] : Go to link 8 from B." , " @/bar : Go to 'ex/bar" , "" , "Numbered, range, and search targets:" , " The specifiers \"$\", \"~\", \"<\", \">\", \"[\" and \"]\" all accept" , " a number, or repetition of the symbol, to specify a particular item." , " e.g \"~~~\" and \"~3\" both refer to the third queue entry." , "" , " Specify ranges with \"-\"; start and/or end may be omitted." , " Specify first match of pattern with \"^pattern^\"," , " or all matches with \"^^pattern^\"." , " Specify multiple items or ranges by separating with \",\"." , " Last item is denoted by \"$\", and nth from last by \"$n\"." , " Examples: \"1,3-5,^pattern^-$2\" refers to links 1,3,4,5 and all links from" , " the first match of pattern to the penultimate item;" , " \"~-\" refers to the whole queue." , "" , " Patterns are (extended) regular expressions (see `man 7 regex`)." , " Matching is case-insensitive unless pattern contains an uppercase character." , " Space and '^' in patterns must be backslash-escaped." , " The terminating \"^\" may be omitted." , "" , "Restricting to unvisited:" , " \"}\", \"{\", and \"*\" work like \"]\", \"[\", and \"_\"," , " but consider only unvisited links. Example: \"*-a\" adds all unvisited links." , "" , "See also: {mark}, {queue}, {alias}, {query}" ] "queue" -> [ "The queue is a list of uris, which you can add to with \"add\"" , "and visit using {next} or by referring to them as \"~\", \"~3\", etc." , "" , "One way to use this: Whenever you see multiple links you would like to read," , "where in a tabbed browser you might open a new background tab for each," , "you can add them to the queue and then read each in turn." , "A queue item is deleted by {delete} or any command which requests the uri;" , "use marks and history (including \"$^pattern\") to revisit old entries." , "" , "You can use e.g. \"-a0\" to add all links to the *start* of the queue." , "The queue can be manipulated with {add}; e.g." , "\"~4-a0\" shifts queue entries ~4 onwards to the start of the queue." , "The queue can also be used to build a list of targets for batch processing;" , "e.g. you can add the desired uris to the queue then use \"~-|grep pattern\"." , "" , "Any uris written to {~/queue} (one uri per line)" , "will be added to the queue, after which that file will be deleted." , "This allows e.g. an rss reader to add to the queue of a diohsc instance." , "" , "You may also create named queues like \"foo~\" with a name argument to {add}." , "The corresponding file is e.g. {~/queues/foo}." ] "pager" -> [ "Keys for the inbuilt pager:" , " space : advance one page" , " h : advance half a page" , " 1-9 : advance by the specified number of lines" , " c : continue to end" , " q, enter : quit pager" , " :, > : enter a diohsc command to be executed immediately. Examples:" , " \":3v\" views link 3 (e.g. an image)" , " \":5a\" adds link 5 to the uri queue" , "" , "There is no way to go backwards; use your terminal's scrollback facility." , "The {||} command can be used to invoke an alternative pager." , "See also: {default_action}" ] "proxies" -> [ "{set} {proxy} SCHEME HOST:PORT : Set proxy for requests using given scheme" , "{set} {proxy} SCHEME : unset proxy" , "" , "Example:" , " set proxy gopher 127.0.0.1:1965" , "to use an Agena ({%Yellow%https://tildegit.org/solderpunk/agena}) instance" , "running locally with its default configuration." ] "proxy" -> topicHelp "proxies" "trust" -> [ "A valid certificate chain presented by a server will be trusted if the root" , "is a Certificate Authority certificate found under {~/trusted_certs/}." , "Otherwise you will be asked whether to trust the server certificate." , "If you accept, it will be saved in {~/known_hosts/}," , "and you will be warned if the server ever presents a different certificate." ] "configuration" -> [ "There are some commandline options; try \"diohsc --help\"." , "" , "There are also some options which can be set at run-time;" , "use {set} for a list and their current values. Each option is a help topic." , "" , "{~/diohscrc} may contain commands to run at startup," , "e.g. setting aliases and identities and the options mentioned above;" , "each line of the file is interpreted as a command." , "See diohscrc.sample in the source distribution for some suggestions." , "" , "The files in {~/} can be edited." , "To change the default save directory," , "make {~/saves} a symlink." , "To disable command history, make {~/commandHistory}" , "a symlink to /dev/null ; similarly for inputHistory and log." , "(Alternatively, use the --ghost commandline option.)" , "" , "The line editor can be configured:" , "see {%Yellow%https://github.com/judah/haskeline/wiki/UserPreferences}" , "" , "See also: {alias}, {identify}, {set}, {trust}" ] "default_action" -> [ "{set} {default_action} COMMAND [ARGS]: set action used on going to a new location." , "The default is \"page\". You may prefer \"||\", or e.g. \"|| less\"." , "See also: {configuration}" ] "geminator" -> topicHelp "geminators" "geminators" -> [ "{set} {geminators} MIMETYPE COMMAND: set shell command for conversion to text/gemini." , "{set} {geminators} MIMETYPE: unset geminator." , "" , "The body of a response with a matching mimetype is piped through the command," , "and the output used as gemini text for rendering (\"page\", \"||\", etc)," , "and for obtaining links." , "" , "Mimetype is a regular expression. The first matching geminator will be used." , "" , "Examples:" , " set gem text/markdown md2gemini -l paragraph" , " (see {%Yellow%https://github.com/makeworld-the-better-one/md2gemini})" , " set gem (text|application)/(html|xml|xhtml.*) html2gmi -me" , " (see {%Yellow%https://github.com/LukeEmmet/html2gmi})" , " set gem image/jpeg echo '```' && jp2a --colors - && echo '```'" , " set gem image/.* echo '```' && convert - jpeg:- | jp2a --colors - && echo '```'" , " (ascii-art preview of images)" ] "render_filter" -> [ "{set} {render_filter} COMMAND: set shell command to filter rendered text through." , "{set} {render_filter}: unset render_filter." , "" , "Whenever the rendered text of a page would be used (\"page\", \"||\", etc)," , "it will be piped through this command first." , "" , "Example:" , " set render_filter stdbuf -o0 uni2ascii -BPq" , " (best-effort substitution of utf8 with pure-ascii equivalents)" ] "pre_display" -> [ "{set} {pre_display} pre: suppress alt text of preformatted blocks" , "{set} {pre_display} alt: display only alt text of preformatted blocks" , "{set} {pre_display} both: display alt text and contents of preformatted blocks" ] "link_desc_first" -> [ "{set} {link_desc_first} true: show link description before uri" , "{set} {link_desc_first} false: show uri before link description" ] "log_length" -> [ "{set} {log_length} N: set number of items to store in log" , "{set} {log_length} 0: clear log and disable logging" , "See also: {log}" ] "max_wrap_width" -> [ "{set} {max_wrap_width} N: set maximum width for text wrapping" ] "no_confirm" -> [ "{set} {no_confirm} true: disable confirmation prompts for certain commands" , "{set} {no_confirm} false: re-enable confirmation prompts" , "" , "You are advised not to enable this until you are familiar with the behaviour of" , "the potentially dangerous commands like \"|\" and \"!\"" ] "verbose_connection" -> [ "{set} {verbose_connection} true: show extra information about connections" , "{set} {verbose_connection} false: suppress extra information about connections" ] "copying" -> [ "diohsc is free software, released under the terms of the GNU GPL v3 or later." , "You should have obtained a copy of the licence as the file COPYING." , "This version of diohsc is copyright Martin Bays 2020." ] t -> ["No help on topic \"" <> t <> "\"."] commandHelp = \case "help" -> [ "help: show general help" , "help COMMAND: show help on command" ] "quit" -> ["quit"] "repeat" -> ["TARGET repeat: request target"] "mark" -> [ "TARGET {mark} MARK: mark target, which can subsequently be specified as 'MARK." , "{mark}: list marks." , "Marks are saved in {~/marks}. To delete a mark, remove the corresponding file." , "" , "The mark '' is a special \"jump back\" mark which is automatically set when" , "navigating to a new uri without following a link." , "" , "Marks '0 to '9 are special per-session marks:" , "they are not saved, and they are listed in the output of \"inventory\"." , "" , "The marks '' and '0-'9 refer to targets with their full history;" , "they and their ancestors can be manipulated without causing network requests." ] "inventory" -> [ "{inventory}: show current queue (~N), path (N), and session marks ('N)." , "See also: {log}" ] "log" -> [ "{log}: show log." , "TARGETS {log}: add targets to log." , "" , "The \"log\" is a list of visited URIs." , "Its entries can be referenced with \"$\"." , "" , "URIs added to the log are considered \"visited\"; they are shown in a" , "different colour and can be referenced with \"*\", \"{\", and \"}\"." , "" , "The log is saved in {~/log}." , "To prevent excessive resource use and limit the privacy implications," , "the length of the log is bounded by the option {log_length}." ] "identify" -> [ "TARGET {identify} [IDENTITY]: identify (as identity) for all future" , " requests to target and to paths below target." , " If identity doesn't exist, create a new identity." , "" , "An \"identity\" is a cryptographic certificate," , "sent to the server to securely identify you to the server." , "An identity which will be used for a request is indicated as \"{%Yellow%uri}[{%Green%identity}]\"." , "" , "TARGET {identify} IDENTITY ed: create identity with an Ed25519 key pair" , "Ed25519 uses much smaller keys than the default RSA algorithm," , "but some servers may fail to accept identities created using it." , "See also: {configuration}" ] "add" -> [ "TARGETS {add}: add targets to the end of the queue." , "TARGETS {add} 0: add targets to the start of the queue." , "TARGETS {add} N: add targets to the queue after entry ~N." , "" , "TARGETS {add} foo: add targets to the named queue foo~." , "TARGETS {add} foo N: add targets to the named queue after entry foo~N." , "" , "See also: {fetch}, {queue}, {targets}." ] "fetch" -> [ "{fetch} acts like {add}, but targets are fetched and cached before being added." , "See {add} for syntax." ] "delete" -> [ "TARGETS {delete}: delete specified uris from the queue." , "e.g. \"~3-5,7d\" to delete certain entries, or \"~-d\" to clear the queue," , "or \"-d\" to delete all queue entries which are links from the current location." , "" , "TARGETS {delete} foo: delete specified uris from the named queue foo~." ] "show" -> ["TARGET {show}: show rendered text of target, without paging."] "page" -> [ "TARGET {page}: page rendered text of target." , "See also: {pager}, {default_action}" ] "uri" -> ["TARGET {uri}: show absolute uri of target."] "links" -> ["TARGET {links}: show list of links of target."] "mime" -> [ "TARGET {mime}: show mime type of target." , "Note: any request this causes will be closed after receiving the header." ] "save" -> [ "TARGET {save} [PATH]: save body." , "If path is omitted or relative, it is based on {~/saves/} ." , "The default filename is the last non-empty segment of the uri path," , "or the hostname if the path is empty." ] "view" -> [ "TARGET {view}: run \"run-mailcap --view\" on body." , "The action is determined by the mime-type; see the run-mailcap manpage." ] "browse" -> [ "TARGET {browse}: run command given by environment variable $BROWSER on uri." , "TARGET {browse} COMMAND: run given shell command on uri." , "%s is substituted with the uri" , "if no %s appears, the uri is used as an additional final argument." , "A literal '%' can be escaped as '%%'." , "" , "If an identity would be used at the target URI (if it had scheme gemini)," , "the environment variables $CLIENT_CERT and $CLIENT_KEY will be set to the paths" , "of the corresponding certificate and private key files." ] "!" -> [ "TARGET {!} COMMAND: run shell command on body." , "The line after '!' is used as a shell command after transforming as follows:" , "%s is substituted with the path to a temporary file containing the target;" , "if no %s appears, this path is appended to the end (separated by a space)." , "A literal '%' can be escaped as '%%'." , "" , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY" , "are set to correspond to the target." ] "|" -> [ "TARGET {|} COMMAND: pipe body through shell command." , "" , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY" , "are set to correspond to the target." ] "||" -> [ "TARGET {||} [COMMAND]: pipe rendered text through shell command." , "The default command is the contents of the environment variable $PAGER." , "" , "Environment variables $URI, $MIMETYPE, $CLIENT_CERT, and $CLIENT_KEY" , "are set to correspond to the target." , "" , "See {||-} for a variant which does not produce ansi escapes." , "See also: {default_action}, {||-}" ] "||-" -> [ "TARGET {||-} [COMMAND]: pipe plain rendered text through shell command." , "This is the same as {||}, but no ansi escapes are included in the text." ] "cat" -> [ "TARGET {cat}: print raw contents of location" ] "commands" -> [ "{commands}: show list of commands and aliases," , "in order of priority when expanding abbreviations," , "and show the shortest permissible abbreviations." , "See also: {alias}"] "query" -> [ "TARGET {query} QUERY: request target with query set to QUERY." , "Unlike TARGET?QUERY, this command does not require spaces to be escaped," , "and it can be aliased; e.g. if 'search is a mark set to a search engine:" , " alias S 'search query" , " S ascii art cat" , "" , "The following backslash escape sequences will be interpreted" , "(these can also be used with TARGET?QUERY by escaping the backslash):" , " \\n : newline" , " \\r : carriage return" , " \\e : escape" , " \\t : tab" , " \\xHH : byte with given hex encoding" , " \\\\ : backslash" ] "repl" -> [ "TARGET {repl}: enter read-eval-print-loop," , "in which each line of input is used as a query string at the target." , "To return to normal command mode, enter an empty query or ^C or ^D." ] "alias" -> [ "{alias} ALIAS COMMANDLINE: add an alias" , "{alias} ALIAS: delete an existing alias" , "The commandline may include targets and/or a command." , "Examples:" , " alias up .. : then \"up\" translates to \"..\", and e.g. \"u add\" to \".. add\"" , " alias Mpv |mpv --cache-secs 5 - : then \"2M\" will stream link 2 to mpv" , " with this sane caching (mpv's default cache size is 150M!)" , "You can put alias commands in {~/diohscrc};" , "see \"{help} {configuration}\"." ] "set" -> [ "{set}: show settable options and their current values" , "{set} OPTION VALUE [..]: set option" , "Try using {help} on the options." , "See also: {configuration}" ] "at" -> [ "TARGET {at} COMMANDLINE: request target then execute commandline based there." , "" , "Example: 'example at *- add: add all unvisited links from 'example to queue." ] c -> ["No help on command \"" <> c <> "\"."] showMinPrefix :: Bool -> [String] -> String -> String showMinPrefix ansi ss s = let n = maximumBound 0 $ commonPrefLen s <$> takeWhile (/= s) ss (s',s'') = splitAt (n+1) s in if n == length s then s <> applyIf ansi (withColourStr Red) " [Not typable!]" else applyIf ansi withBoldStr s' <> applyIf (not $ ansi || null s'') (('[':) . (++"]")) s'' where commonPrefLen :: Eq a => [a] -> [a] -> Int commonPrefLen bs cs = head [ n | n <- [0..] , let mb = atMay bs n , let mc = atMay cs n , isNothing mb || isNothing mc || mb /= mc ] -- indicate initial prefix of commands/aliases in string, marked as {command}, -- and topics marked as {topic}, -- and path from userdir, marked as {~/path}. -- Use {-command blah} in a table, it adds spaces as necessary. -- e.g. {%Yellow%str} prints str in yellow (when ansi). expandHelp :: Bool -> [String] -> String -> String -> String expandHelp ansi aliases userDir = expandHelp' where cs = aliases ++ commands False expandHelp' s | (pre,'{':s') <- break (== '{') s , (twixt,'}':post) <- break (== '}') s' = let sub = case twixt of '~':'/':path -> userDir path '-':cBlah | (c,blah) <- break (== ' ') cBlah , c `elem` cs -> let c' = showMinPrefix ansi cs c missing = length c + 3 - visibleLength (T.pack c') in c' <> blah <> replicate missing ' ' '%':t' | (colStr,'%':str) <- break (== '%') t' , Just col <- readMay colStr -> applyIf ansi (withColourStr col) str c | c `elem` cs -> showMinPrefix ansi cs c t | t `elem` topics -> showMinPrefix ansi (cs ++ topics) t _ -> '{' : twixt ++ "}" in pre <> sub <> expandHelp' post | otherwise = s