diohsc-0.1.3: Command.hs
-- This file is part of Diohsc
-- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
--
-- 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", "delete"]
infoCommands = ["show", "page", "uri", "links", "mime"]
unsafeActionCommands = ["save", "view", "browse", "!", "|", "||", "||-"]
safeActionCommands = ["cat"]
actionCommands True = safeActionCommands
actionCommands False = unsafeActionCommands ++ safeActionCommands
otherCommands = ["commands", "log", "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 site as 'root"
, " / {identify} asdf : Use identity \"asdf\" for all of current site"
, "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", "log_length", "max_wrap_width", "no_confirm"
, "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} : 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 \",\"."
, " Examples: \"1,3-5,^pattern^-\" refers to links 1,3,4,5 and all links from the"
, " the first match of pattern onwards, and \"~-\" 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}"
]
"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." ]
"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 after quitting the pager"
, " example: \":3a\" adds link 3 to the uri queue"
, "There is no way to go back."
, "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" ]
"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 \"!\"" ]
"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 <mbays@sdf.org> 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."
, "Marks are saved in {~/marks}. To delete a mark, remove the corresponding file."
, ""
, "Marks '0 to '9 are special per-session marks:"
, "they are not saved, and they are listed in the output of \"inventory\"" ]
"inventory" ->
[ "{inventory}: show current queue (~N), path (<N,>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}]\"."
, "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."
, "See also: {queue}, {targets}." ]
"delete" ->
[ "TARGETS {delete}: delete specified uris from 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." ]
"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 last segment of the uri path is used as a default filename." ]
"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 '%%'." ]
"!" -> [ "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 and $MIMETYPE are set to correspond to the target." ]
"|" -> [ "TARGET {|} COMMAND: pipe body through shell command."
, "Environment variables $URI and $MIMETYPE 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 and $MIMETYPE 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}"]
"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