{-# LANGUAGE OverloadedStrings, DeriveFunctor, ViewPatterns #-} module ShortcutLinks.All ( Result(..), Shortcut, allShortcuts, -- * Encyclopedias wikipedia, tvtropes, -- * Social networks facebook, vk, googleplus, -- * Microblogs twitter, juick, -- * Major search engines google, duckduckgo, yandex, baidu, -- * Programming language libraries npm, jam, rubygems, pypi, metacpanPod, metacpanRelease, hackage, cargo, pub, hex, cran, swiprolog, dub, bpkg, pear, -- * Code hosting github, gitlab, bitbucket, -- * OS packages -- ** Mobile googleplay, -- ** Windows chocolatey, -- ** OS X braumeister, -- ** Linux debian, aur, mint, fedora, gentoo, opensuse, -- * Addons -- ** Text editors marmalade, melpa, elpa, packagecontrol, atomPackage, atomTheme, jedit, vim, -- ** Browsers operaExt, operaTheme, firefox, chrome, -- * Manuals ghcExt, -- * Standards and databases rfc, ecma, cve, ) where -- General import Data.Monoid import Control.Applicative import Control.Monad import Data.Maybe -- Text import qualified Data.Text as T import Data.Text (Text) import Data.Char -- shortcut-links import ShortcutLinks.Utils data Result a = Failure String | Warning [String] a | Success a deriving (Show, Functor) instance Applicative Result where pure = return (<*>) = ap instance Monad Result where fail = Failure return = Success Failure x >>= _ = Failure x Warning wa a >>= f = case f a of Success b -> Warning wa b Warning wb b -> Warning (wa ++ wb) b Failure x -> Failure x Success a >>= f = f a warn :: String -> Result () warn s = Warning [s] () type Shortcut = Maybe Text -> Text -> Result Text {- | A list of all functions included in this module, together with suggested names for them. -} allShortcuts :: [([Text], Shortcut)] allShortcuts = let (.=) names func = (T.words names, func) in [ -- encyclopedias "w wikipedia" .= wikipedia, "tvtropes" .= tvtropes, -- social networks "fb facebook" .= facebook, "vk vkontakte" .= vk, "gp gplus googleplus" .= googleplus, -- microblogs "t twitter" .= twitter, "juick" .= juick, -- search engines "google" .= google, "ddg duckduckgo" .= duckduckgo, "yandex" .= yandex, "baidu" .= baidu, -- programming language libraries "npm" .= npm, "jam" .= jam, "gem" .= rubygems, "pypi" .= pypi, "cpan" .= metacpanPod, "cpan-r" .= metacpanRelease, "hackage" .= hackage, "cargo" .= cargo, "pub" .= pub, "hex" .= hex, "cran" .= cran, "swiprolog" .= swiprolog, "dub" .= dub, "bpkg" .= bpkg, "pear" .= pear, -- code hosting "gh github" .= github, "gitlab" .= gitlab, "bitbucket" .= bitbucket, -- OS "gplay googleplay" .= googleplay, "chocolatey" .= chocolatey, "brew" .= braumeister, -- OS – Linux "debian" .= debian, "aur" .= aur, "mint" .= mint, "fedora" .= fedora, "gentoo" .= gentoo, "opensuse" .= opensuse, -- text editors "marmalade" .= marmalade, "melpa" .= melpa, "elpa" .= elpa, "sublimepc" .= packagecontrol, "atom" .= atomPackage, "atom-theme" .= atomTheme, "jedit" .= jedit, "vim" .= vim, -- browsers "opera" .= operaExt, "opera-theme" .= operaTheme, "firefox" .= firefox, "chrome" .= chrome, -- manuals "ghc-ext" .= ghcExt, -- standards and databases "rfc" .= rfc, "ecma" .= ecma, "cve" .= cve ] {- | <https://facebook.com Facebook> Link by username: @ \[green\](\@fb) <https://facebook.com/green> @ Or by profile ID (are there still people without usernames, actually?): @ \[someone something\](\@fb:164680686880529) <https://facebook.com/profile.php?id=164680686880529> @ -} facebook :: Shortcut facebook _ q | T.all isDigit q = return $ "https://facebook.com/profile.php?id=" <> q | otherwise = return $ "https://facebook.com/" <> q {- | <https://vk.com Vkontakte> (Вконтакте) Link by username: @ \[green\](\@vk) <https://vk.com/green> @ Or by ID: @ \[Durov\](\@vk:1) <https://vk.com/id1> @ -} vk :: Shortcut vk _ q | T.all isDigit q = return $ "https://vk.com/id" <> q | otherwise = return $ "https://vk.com/" <> q {- | <https://plus.google.com Google+> Link by username: @ \[SergeyBrin\](\@gp) <https://plus.google.com/+SergeyBrin> @ It's alright if the username already starts with a “+”: @ \[+SergeyBrin\](\@gp) <https://plus.google.com/+SergeyBrin> @ Since many usernames are just “your full name without spaces”, in many cases you can give a name and it's easy to make a username from it: @ \[Sergey Brin\](\@gp) <https://plus.google.com/+SergeyBrin> @ You can also link by ID: @ \[Sergey Brin\](\@gp:109813896768294978296) <https://plus.google.com/109813896768294978296> @ Finally, there are different links for hashtags: @ \[#Australia\](\@gp) <https://plus.google.com/explore/Australia> @ -} googleplus :: Shortcut googleplus _ q | T.null q = return $ url | T.head q == '#' = return $ format "{}/explore/{}" url (T.tail q) | T.head q == '+' = return $ format "{}/{}" url q | T.all isDigit q = return $ format "{}/{}" url q | otherwise = return $ format "{}/+{}" url (T.concat (T.words q)) where url = "https://plus.google.com" {- | <https://twitter.com Twitter> Link by username: @ \[Edward Kmett\](\@t:kmett) <https://twitter.com/kmett> @ It's alright if the username already starts with a “\@”: @ \[\@kmett\](\@t) <https://twitter.com/kmett> @ There are different links for hashtags: @ \[#haskell\](\@t) <https://twitter.com/hashtag/haskell> @ -} twitter :: Shortcut twitter _ q | T.null q = return $ url | T.head q == '#' = return $ format "{}/hashtag/{}" url (T.tail q) | T.head q == '@' = return $ format "{}/{}" url (T.tail q) | otherwise = return $ format "{}/{}" url q where url = "https://twitter.com" {- | <https://juick.com Juick> Link by username: @ \[thefish\](\@juick) <https://juick.com/thefish> @ It's alright if the username already starts with a “\@”: @ \[\@thefish\](\@juick) <https://juick.com/thefish> @ There are different links for tags (which start with “\*” and not with “#”, by the way): @ \[*Haskell\](\@juick) <https://juick.com/tag/Haskell> @ -} juick :: Shortcut juick _ q | T.null q = return $ url | T.head q == '*' = return $ format "{}/tag/{}" url (T.tail q) | T.head q == '@' = return $ format "{}/{}" url (T.tail q) | otherwise = return $ format "{}/{}" url q where url = "https://juick.com" {- | <https://google.com Google> Search results: @ \[random query\](\@google) <https://www.google.com/search?nfpr=1&q=random+query> @ -} google :: Shortcut google _ q = return $ "https://google.com/search?nfpr=1&q=" <> replaceSpaces '+' q {- | <https://duckduckgo.com Duckduckgo> Search results: @ \[random query\](\@ddg) <https://duckduckgo.com/?q=random+query> @ -} duckduckgo :: Shortcut duckduckgo _ q = return $ "https://duckduckgo.com/?q=" <> replaceSpaces '+' q {- | <http://yandex.ru Yandex> (Russian search engine) Search results: @ \[random query\](\@yandex) <http://yandex.ru/search/?noreask=1&text=random+query> @ -} yandex :: Shortcut yandex _ q = return $ "http://yandex.ru/search/?noreask=1&text=" <> replaceSpaces '+' q {- | <http://baidu.com Baidu> (Chinese search engine) Search results: @ \[random query\](\@baidu) <http://baidu.com/s?nojc=1&wd=random+query> @ -} baidu :: Shortcut baidu _ q = return $ "http://baidu.com/s?nojc=1&wd=" <> replaceSpaces '+' q {- | __Node.js__ – <https://npmjs.com NPM> Link to a package: @ \[markdown\](\@npm) <https://www.npmjs.com/package/markdown> @ -} npm :: Shortcut npm _ q = return $ "https://npmjs.com/package/" <> q {- | __Javascript__ – <http://jamjs.org/packages/#/ Jam> Link to a package: @ \[pagedown\](\@jam) <http://jamjs.org/packages/#/details/pagedown> @ -} jam :: Shortcut jam _ q = return $ "http://jamjs.org/packages/#/details/" <> q {- | __Ruby__ – <https://rubygems.org RubyGems.org> Link to a package: @ \[github-markdown\](\@gem) <https://rubygems.org/gems/github-markdown> @ -} rubygems :: Shortcut rubygems _ q = return $ "https://rubygems.org/gems/" <> q {- | __Python__ – <https://pypi.python.org/pypi PyPI> Link to a package: @ \[Markdown\](\@pypi) <https://pypi.python.org/pypi/Markdown> @ -} pypi :: Shortcut pypi _ q = return $ "https://pypi.python.org/pypi/" <> q {- | __Perl__ – <https://metacpan.org MetaCPAN> (by module) Link to a module: @ \[Text::Markdown\](\@cpan) <https://metacpan.org/pod/Text::Markdown> @ To link to a release, look at 'metacpanRelease'. -} metacpanPod :: Shortcut metacpanPod _ q = return $ "https://metacpan.org/pod/" <> q {- | __Perl__ – <https://metacpan.org MetaCPAN> (by release) Link to a release: @ \[Text-Markdown\](\@cpan-r) <https://metacpan.org/release/Text-Markdown> @ -} metacpanRelease :: Shortcut metacpanRelease _ q = return $ "https://metacpan.org/release/" <> q {- | __Haskell__ – <https://hackage.haskell.org Hackage> Link to a package: @ \[cmark\](\@hackage) <https://hackage.haskell.org/package/cmark> @ -} hackage :: Shortcut hackage _ q = return $ "https://hackage.haskell.org/package/" <> q {- | __Rust__ – <https://crates.io Cargo> Link to a package: @ \[hoedown\](\@cargo) <https://crates.io/crates/hoedown> @ -} cargo :: Shortcut cargo _ q = return $ "https://crates.io/crates/" <> q {- | __PHP__ – <http://pear.php.net PEAR> Link to a package: @ \[Text_Wiki_Doku\](\@pear) <http://pear.php.net/package/Text_Wiki_Doku> @ -} pear :: Shortcut pear _ q = return $ "http://pear.php.net/package/" <> q {- | __Dart__ – <https://pub.dartlang.org pub> Link to a package: @ \[md_proc\](\@pub) <https://pub.dartlang.org/packages/md_proc> @ -} pub :: Shortcut pub _ q = return $ "https://pub.dartlang.org/packages/" <> q {- | __R__ – <http://cran.r-project.org/web/packages/ CRAN> Link to a package: @ \[markdown\](\@cran) <http://cran.r-project.org/web/packages/markdown> @ -} cran :: Shortcut cran _ q = return $ "http://cran.r-project.org/web/packages/" <> q {- | __Erlang__ – <https://hex.pm Hex> Link to a package: @ \[earmark\](\@hex) <https://hex.pm/packages/earmark> @ -} hex :: Shortcut hex _ q = return $ "https://hex.pm/packages/" <> q {- | __SWI-Prolog__ – <http://www.swi-prolog.org/pack/list packages> Link to a package: @ \[markdown\](\@swiprolog) <http://www.swi-prolog.org/pack/list?p=markdown> @ -} swiprolog :: Shortcut swiprolog _ q = return $ "http://www.swi-prolog.org/pack/list?p=" <> q {- | __D__ – <http://code.dlang.org DUB> Link to a package: @ \[dmarkdown\](\@dub) <http://code.dlang.org/packages/dmarkdown> @ -} dub :: Shortcut dub _ q = return $ "http://code.dlang.org/packages/" <> q {- | __Bash__ – <http://bpkg.io bpkg> Link to a package: @ \[markdown\](\@bpkg) <http://www.bpkg.io/pkg/markdown> @ -} bpkg :: Shortcut bpkg _ q = return $ "http://bpkg.io/pkg/" <> q {- | <https://github.com Github> Link to a user: @ \[Aelve\](\@gh:aelve) <https://github.com/aelve> @ Link to a repository: @ \[aelve/shortcut-links\](\@gh) <https://github.com/aelve/shortcut-links> @ The repository owner can also be given as an option (to avoid mentioning nem in the link text): @ \[shortcut-links\](\@gh(aelve)) <https://github.com/aelve/shortcut-links> @ -} github :: Shortcut github mbOwner q = case mbOwner of Nothing -> return $ format "https://github.com/{}" q Just owner -> return $ format "https://github.com/{}/{}" owner q {- | <https://bitbucket.org Bitbucket> Link to a user: @ \[Bryan\](\@bitbucket:bos) <https://bitbucket.org/bos> @ Link to a repository: @ \[bos/text\](\@bitbucket) <https://bitbucket.org/bos/text> @ The repository owner can also be given as an option (to avoid mentioning nem in the link text): @ \[text\](\@bitbucket(bos)) <https://bitbucket.org/bos/text> @ -} bitbucket :: Shortcut bitbucket mbOwner q = case mbOwner of Nothing -> return $ format "https://bitbucket.org/{}" q Just owner -> return $ format "https://bitbucket.org/{}/{}" owner q {- | <https://gitlab.com Gitlab> Link to a user or a team (note that links like <https://gitlab.com/owner> work but are going to be automatically redirected to either <https://gitlab.com/u/owner> or <https://gitlab.com/groups/owner>, depending on whether it's a user or a team – so, it's a case when the “links have to look as authentic as possible” principle is violated, but nothing can be done with that): @ \[CyanogenMod\](\@bitbucket) <https://gitlab.com/CyanogenMod> @ Link to a repository: @ \[learnyou/lysa\](\@gitlab) <https://gitlab.com/learnyou/lysa> @ The repository owner can also be given as an option (to avoid mentioning nem in the link text): @ \[lysa\](\@gitlab(learnyou)) <https://gitlab.com/learnyou/lysa> @ -} gitlab :: Shortcut gitlab mbOwner q = case mbOwner of Nothing -> return $ format "https://gitlab.com/{}" q Just owner -> return $ format "https://gitlab.com/{}/{}" owner q {- | __Android__ – <https://play.google.com Google Play> (formerly Play Market) Link to an app: @ \[Opera Mini\](\@gplay:com.opera.mini.native) <https://play.google.com/store/apps/details?id=com.opera.mini.native> @ -} googleplay :: Shortcut googleplay _ q = return $ "https://play.google.com/store/apps/details?id=" <> q {- | <http://braumeister.org Braumeister> (Homebrew formulas) Link to a formula: @ \[multimarkdown\](\@brew) <http://braumeister.org/formula/multimarkdown> @ -} braumeister :: Shortcut braumeister _ q = return $ "http://braumeister.org/formula/" <> q {- | <https://chocolatey.org Chocolatey> Link to a package: @ \[Opera\](\@chocolatey) <https://chocolatey.org/packages/Opera> @ -} chocolatey :: Shortcut chocolatey _ q = return $ "https://chocolatey.org/packages/" <> q {- | __Debian__ – <https://debian.org/distrib/packages packages> Link to a package in stable distribution: @ \[ghc\](\@debian) <https://packages.debian.org/stable/ghc> @ Distribution can be given as an option: @ \[ghc\](\@debian(experimental)) <https://packages.debian.org/experimental/ghc> @ -} debian :: Shortcut debian mbDist q = return $ format "https://packages.debian.org/{}/{}" dist q where dist = fromMaybe "stable" mbDist {- | __Arch Linux__ – <https://aur.archlinux.org AUR> (“user repository”) Link to a package: @ \[ghc-git\](\@aur) <https://aur.archlinux.org/packages/ghc-git> @ -} aur :: Shortcut aur _ q = return $ "https://aur.archlinux.org/packages/" <> q {- | __Gentoo__ – <https://packages.gentoo.org packages> Link to a package: @ \[dev-lang/ghc\](\@gentoo) <https://packages.gentoo.org/package/dev-lang/ghc> @ Category can be given as an option, to avoid cluttering link text: @ \[ghc\](\@gentoo(dev-lang)) <https://packages.gentoo.org/package/dev-lang/ghc> @ Note that if you don't specify any category, the link would still work – but there are a lot of packages with overlapping names (like “ace”, “csv”, “http”), and such links would lead to search pages listing several packages. So, it's better to include categories. -} gentoo :: Shortcut gentoo mbCat q = return $ "https://packages.gentoo.org/package/" <> pkg where pkg = case mbCat of Nothing -> q Just cat -> cat <> "/" <> q {- | __openSUSE__ – <http://software.opensuse.org packages> Link to a package: @ \[ghc\](\@opensuse) <http://software.opensuse.org/package/ghc> @ -} opensuse :: Shortcut opensuse _ q = return $ "http://software.opensuse.org/package/" <> q {- | __Linux Mint__ – <http://community.linuxmint.com/software/browse packages> Link to a package: @ \[ghc\](\@mint) <http://community.linuxmint.com/software/view/ghc> @ -} mint :: Shortcut mint _ q = return $ "http://community.linuxmint.com/software/view/" <> q {- | __Fedora__ – <https://admin.fedoraproject.org/pkgdb packages> Link to a package: @ \[ghc\](\@fedora) <https://admin.fedoraproject.org/pkgdb/package/ghc> @ -} fedora :: Shortcut fedora _ q = return $ "https://admin.fedoraproject.org/pkgdb/package/" <> q {- | __Emacs__ – <https://marmalade-repo.org Marmalade> Link to a package: @ \[markdown-mode\](\@marmalade) <https://marmalade-repo.org/packages/markdown-mode> @ -} marmalade :: Shortcut marmalade _ q = return $ "https://marmalade-repo.org/packages/" <> q {- | __Emacs__ – <http://melpa.org MELPA> Link to a package: @ \[markdown-mode\](\@melpa) <http://melpa.org/#/markdown-mode> @ -} melpa :: Shortcut melpa _ q = return $ "http://melpa.org/#/" <> q {- | __Emacs__ – <https://elpa.gnu.org ELPA> Link to a package: @ \[undo-tree\](\@elpa) <https://elpa.gnu.org/packages/undo-tree.html> @ -} elpa :: Shortcut elpa _ q = return $ format "https://elpa.gnu.org/packages/{}.html" q {- | __Sublime Text__ – <https://packagecontrol.io Package Control> Link to a package: @ \[MarkdownEditing\](\@sublimepc) <https://packagecontrol.io/packages/MarkdownEditing> @ -} packagecontrol :: Shortcut packagecontrol _ q = return $ "https://packagecontrol.io/packages/" <> q {- | __Atom__ – <https://atom.io/packages packages> Link to a package: @ \[tidy-markdown\](\@atom) <https://atom.io/packages/tidy-markdown> @ -} atomPackage :: Shortcut atomPackage _ q = return $ "https://atom.io/packages/" <> q {- | __Atom__ – <https://atom.io/themes themes> Link to a theme: @ \[atom-material-ui\](\@atom-theme) <https://atom.io/themes/atom-material-ui> @ -} atomTheme :: Shortcut atomTheme _ q = return $ "https://atom.io/themes/" <> q {- | __jEdit__ – <http://plugins.jedit.org plugins> Link to a plugin: @ \[MarkdownPlugin\](\@jedit) <http://plugins.jedit.org/plugins/?MarkdownPlugin> @ -} jedit :: Shortcut jedit _ q = return $ "http://plugins.jedit.org/plugins/?" <> q {- | __Vim__ – <http://www.vim.org/scripts/ scripts> Link to a script (by ID): @ \[haskell.vim\](\@vim:2062) <http://www.vim.org/scripts/script.php?script_id=2062> @ -} vim :: Shortcut vim _ q = return $ "http://www.vim.org/scripts/script.php?script_id=" <> q {- | __Opera__ – <https://addons.opera.com/extensions/ extensions> Link to an extension: @ \[Amazon\](\@opera:amazon-for-opera) <https://addons.opera.com/extensions/details/amazon-for-opera> @ -} operaExt :: Shortcut operaExt _ q = return $ "https://addons.opera.com/extensions/details/" <> q {- | __Opera__ – <https://addons.opera.com/themes/ themes> Link to a theme: @ \[Space theme\](\@opera-theme:space-15) <https://addons.opera.com/en/themes/details/space-15> @ -} operaTheme :: Shortcut operaTheme _ q = return $ "https://addons.opera.com/themes/details/" <> q {- | __Firefox__ – <https://addons.mozilla.org/firefox add-ons> Link to an extension (or a theme): @ \[tree-style-tab](\@firefox) <https://addons.mozilla.org/firefox/addon/tree-style-tab> @ -} firefox :: Shortcut firefox _ q = return $ "https://addons.mozilla.org/firefox/addon/" <> q {- | __Chrome__ – <https://chrome.google.com/webstore Chrome Web Store> Link to an extension, app, or theme (using that weird random-looking ID): @ \[hdokiejnpimakedhajhdlcegeplioahd](\@chrome) <https://chrome.google.com/webstore/detail/hdokiejnpimakedhajhdlcegeplioahd> @ -} chrome :: Shortcut chrome _ q = return $ "https://chrome.google.com/webstore/detail/" <> q {- | <https://www.haskell.org/ghc/ GHC> (Glasgow Haskell Compiler) extensions Link to an extension's description in the user manual: @ \[ViewPatterns\](\@ghc-ext) <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/syntax-extns.html#view-patterns> @ -} ghcExt :: Shortcut ghcExt _ ext = case lookup ext ghcExtsList of Nothing -> fail (format "unknown GHC extension '{}'" ext) Just link -> return link {- | <https://www.ietf.org/rfc.html RFCs> Link to an RFC: @ \[RFC 2026\](\@rfc) <https://tools.ietf.org/html/rfc2026> @ Precise format of recognised text: optional “rfc” (case-insensitive), then arbitrary amount of spaces and punctuation (or nothing), then the number. Examples: “RFC 2026”, “RFC-2026”, “rfc2026”, “rfc #2026”, “2026”, “#2026”. -} rfc :: Shortcut rfc _ x = do let n = T.dropWhile (not . isAlphaNum) (tryStripPrefixCI "rfc" x) -- We don't use 'readMaybe' here because 'readMaybe' isn't available in GHC -- 7.4, which Pandoc has to be compatible with. unless (T.all isDigit n) $ warn "non-digits in RFC number" when (T.null n) $ warn "no RFC number" let n' = T.dropWhile (== '0') n `orElse` "0" return ("https://tools.ietf.org/html/rfc" <> n') {- | <http://ecma-international.org/publications/index.html Ecma standards and technical reports> Link to a standard: @ \[ECMA-262\](\@ecma) <http://www.ecma-international.org/publications/standards/Ecma-262.htm> @ Link to a technical report: @ \[TR/71\](\@ecma) <http://ecma-international.org/publications/techreports/E-TR-071.htm> @ Precise format of recognised text for standards: optional “ECMA” (case-insensitive), then arbitrary amount of spaces and punctuation (or nothing), then the number. Examples: “ECMA-262”, “ECMA 262”, “ecma262”, “ECMA #262”, “262”, “#262”. Format for technical reports is the same, except that “TR” (instead of “ECMA”) is not optional (so, if there's only a number given, it's considered a standard and not a technical report). -} ecma :: Shortcut ecma _ q = do -- TODO: move dropSeparators to Utils and use it in 'rfc' and 'cve' let dropSeparators = T.dropWhile (not . isAlphaNum) let (dropSeparators -> mbNum, isTR) = case stripPrefixCI "tr" q of Nothing -> (tryStripPrefixCI "ecma" q, False) Just q' -> (q', True) -- We don't use 'readMaybe' here because 'readMaybe' isn't available in GHC -- 7.4, which Pandoc has to be compatible with. unless (T.all isDigit mbNum) $ warn "non-digits in ECMA standard number" when (T.null mbNum) $ warn "no ECMA standard number" -- The number has to have at least 3 digits. let num = T.justifyRight 3 '0' mbNum url = "http://ecma-international.org/publications" :: Text return $ if isTR then format "{}/techreports/E-TR-{}.htm" url num else format "{}/standards/Ecma-{}.htm" url num {- | <http://cve.mitre.org CVEs> (Common Vulnerabilities and Exposures) Link to a CVE: @ \[CVE-2014-10001\](\@cve) <http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2014-10001> @ Precise format of recognised text: optional “cve” (case-insensitive), then arbitrary amount of spaces and punctuation (or nothing), then the year, “-”, and a number. Examples: “CVE-2014-10001”, “cve 2014-10001”, “2014-10001”. -} cve :: Shortcut cve _ x = do let n = T.dropWhile (not . isAlphaNum) (tryStripPrefixCI "cve" x) unless (T.length n >= 9) $ warn "CVE-ID is too short" let isValid = and [ T.length n >= 9, T.all isDigit (T.take 4 n), T.index n 4 == '-', T.all isDigit (T.drop 5 n) ] unless isValid $ warn "CVE-ID doesn't follow the <year>-<digits> format" return ("http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-" <> n) {- | <https://wikipedia.org/ Wikipedia> Link to an article in English Wikipedia: @ \[grey-headed flying fox\](\@w) <https://en.wikipedia.org/wiki/Grey-headed_flying_fox> @ You can link to Wikipedia-in-another-language if you give language code as an option: @ \[Haskell\](\@w(ru)) <https://ru.wikipedia.org/wiki/Haskell> @ -} wikipedia :: Shortcut wikipedia mbLang q = return $ format "https://{}.wikipedia.org/wiki/{}" lang q' where lang = fromMaybe "en" mbLang q' = titleFirst (replaceSpaces '_' q) {- | <http://tvtropes.org TV Tropes> Link to a trope: @ \[so bad, it's good\](\@tvtropes) <http://tvtropes.org/pmwiki/pmwiki.php/Main/SoBadItsGood> @ Link to anything else (a series, for example): @ \[Elementary\](\@tvtropes(series)) <http://tvtropes.org/pmwiki/pmwiki.php/Series/Elementary> @ Or something on Sugar Wiki: @ \[awesome music\](\@tvtropes(sugar wiki)) <http://tvtropes.org/pmwiki/pmwiki.php/SugarWiki/AwesomeMusic> @ -} tvtropes :: Shortcut tvtropes mbCat q = return $ format "http://tvtropes.org/pmwiki/pmwiki.php/{}/{}" cat (camel q) where isSep c = (isSpace c || isPunctuation c) && c /= '\'' -- Break into words, transform each word like “it's” → “Its”, and concat. -- Note that e.g. “man-made” is considered 2 separate words. camel = T.concat . map (titleFirst . T.filter isAlphaNum) . T.split isSep cat = maybe "Main" camel mbCat ghcExtsList :: [(Text, Text)] ghcExtsList = do let (.=) = (,) base = "https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/" prefix x = map (\(a, b) -> (a, x <> b)) prefix base $ concat [ prefix "syntax-extns.html" [ "DisambiguateRecordFields" .= "#disambiguate-fields", "EmptyCase" .= "#empty-case", "NoImplicitPrelude" .= "#rebindable-syntax", "NegativeLiterals" .= "#negative-literals", "RebindableSyntax" .= "#rebindable-syntax", "PatternGuards" .= "#pattern-guards", "ViewPatterns" .= "#view-patterns", "UnicodeSyntax" .= "#unicode-syntax", "MagicHash" .= "#magic-hash", "ParallelListComp" .= "#parallel-list-comprehensions", "TransformListComp" .= "#generalised-list-comprehensions", "MonadComprehensions" .= "#monad-comprehensions", "ExplicitNamespaces" .= "#explicit-namespaces", "RecursiveDo" .= "#recursive-do-notation", "RecordWildCards" .= "#record-wildcards", "NamedFieldPuns" .= "#record-puns", "PackageImports" .= "#package-imports", "LambdaCase" .= "#lambda-case", "MultiWayIf" .= "#multi-way-if", "NumDecimals" .= "#num-decimals", "BinaryLiterals" .= "#binary-literals", "PostfixOperators" .= "#postfix-operators", "TupleSections" .= "#tuple-sections", "PatternSynonyms" .= "#pattern-synonyms" ], prefix "data-type-extensions.html" [ "GADTs" .= "#gadt", "GADTSyntax" .= "#gadt-style", "ExistentialQuantification" .= "#existential-quantification", "LiberalTypeSynonyms" .= "#type-synonyms", "EmptyDataDecls" .= "#nullary-types", "DatatypeContexts" .= "#datatype-contexts", "TypeOperators" .= "#type-operators" ], prefix "other-type-extensions.html" [ "AllowAmbiguousTypes" .= "#ambiguity", "ImplicitParams" .= "#implicit-parameters", "NoMonomorphismRestriction" .= "#monomorphism", "RelaxedPolyRec" .= "#typing-binds", "MonoLocalBinds" .= "#mono-local-binds", "ScopedTypeVariables" .= "#scoped-type-variables", "ExplicitForAll" .= "#explicit-foralls", "PolymorphicComponents" .= "#universal-quantification", "Rank2Types" .= "#universal-quantification", "RankNTypes" .= "#universal-quantification", "ImpredicativeTypes" .= "#impredicative-polymorphism", "KindSignatures" .= "#kinding", "FlexibleContexts" .= "#flexible-contexts" ], prefix "type-class-extensions.html" [ "IncoherentInstances" .= "#instance-overlap", "OverlappingInstances" .= "#instance-overlap", "OverloadedLists" .= "#overloaded-lists", "OverloadedStrings" .= "#overloaded-strings", "UndecidableInstances" .= "#undecidable-instances", "TypeSynonymInstances" .= "#flexible-instance-head", "FlexibleInstances" .= "#instance-rules", "ConstrainedClassMethods" .= "#class-method-types", "DefaultSignatures" .= "#class-default-signatures", "MultiParamTypeClasses" .= "#multi-param-type-classes", "NullaryTypeClasses" .= "#nullary-type-classes", "InstanceSigs" .= "#instance-sigs", "FunctionalDependencies" .= "#functional-dependencies" ], prefix "deriving.html" [ "AutoDeriveTypeable" .= "#auto-derive-typeable", "DeriveDataTypeable" .= "#deriving-typeable", "DeriveGeneric" .= "#deriving-typeable", "DeriveFunctor" .= "#deriving-extra", "DeriveTraversable" .= "#deriving-extra", "DeriveFoldable" .= "#deriving-extra", "GeneralizedNewtypeDeriving" .= "#newtype-deriving", "DeriveAnyClass" .= "#derive-any-class", "StandaloneDeriving" .= "#stand-alone-deriving" ], prefix "template-haskell.html" [ "TemplateHaskell" .= "", "QuasiQuotes" .= "#th-quasiquotation" ], prefix "ffi.html" [ "ForeignFunctionInterface" .= "", "InterruptibleFFI" .= "#ffi-interruptible", "CApiFFI" .= "#ffi-capi" ], prefix "partial-type-signatures.html" [ "PartialTypeSignatures" .= "", "NamedWildCards" .= "#named-wildcards" ], map (.= "safe-haskell.html") [ "Safe", "Trustworthy", "Unsafe" ], [ "Arrows" .= "arrow-notation.html", "ConstraintKinds" .= "constraint-kind.html", "DataKinds" .= "promotion.html", "ExtendedDefaultRules" .= "interactive-evaluation.html#extended-default-rules", "TypeFamilies" .= "type-families.html", "PolyKinds" .= "kind-polymorphism.html", "BangPatterns" .= "bang-patterns.html", "CPP" .= "options-phases.html#c-pre-processor", "RoleAnnotations" .= "roles.html#role-annotations", "UnboxedTuples" .= "primitives.html#unboxed-tuples" ] ]