{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {- | Copyright: (c) 2015-2019 Aelve (c) 2019-2020 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik -} module ShortcutLinks.All ( Result(..) , Shortcut , allShortcuts -- * Encyclopedias , wikipedia , tvtropes -- * Social networks , facebook , vk , googleplus , telegram -- * Microblogs , twitter , juick -- * Major search engines , google , duckduckgo , yandex , baidu -- * Programming language libraries -- ** Haskell , haskell , hackage , stackage , cabal -- ** Other , npm , jam , rubygems , pypi , metacpanPod , metacpanRelease , cargo , pub , hex , cran , swiprolog , dub , bpkg , pear -- * Code hosting , github , gitlab , bitbucket -- * OS packages -- ** Mobile , googleplay -- ** Windows , chocolatey -- ** OS X , brew -- ** 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 import Control.Monad (unless, when) import Data.Char (isAlphaNum, isDigit, isPunctuation, isSpace) import Data.Maybe (fromMaybe, isNothing) import Data.Semigroup ((<>)) import Data.Text (Text) import ShortcutLinks.Utils (format, formatSlash, orElse, replaceSpaces, stripPrefixCI, titleFirst, tryStripPrefixCI) import qualified Control.Monad.Fail as Fail import qualified Data.Text as T -- $setup -- >>> import ShortcutLinks -- | Resulting data type over the work of @shortcut-links@ data Result a = Failure String | Warning [String] a | Success a deriving stock (Show, Functor) instance Applicative Result where pure :: a -> Result a pure = Success (<*>) :: Result (a -> b) -> Result a -> Result b Failure x <*> _ = Failure x Warning wf f <*> s = case s of Success a -> Warning wf (f a) Warning wa a -> Warning (wf <> wa) (f a) Failure x -> Failure x Success f <*> a = f <$> a instance Monad Result where #if !(MIN_VERSION_base(4,13,0)) fail :: String -> Result a fail = Fail.fail #endif return :: a -> Result a return = pure (>>=) :: Result a -> (a -> Result b) -> Result b 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 instance Fail.MonadFail Result where fail :: String -> Result a fail = Failure -- | Create a unit 'Warning' with a single warning message warn :: String -> Result () warn s = Warning [s] () -- | Type alias for shortcut links 'Result' functions. 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 = -- When changing something here, don't forget to update the description for -- the corresponding shortcut. 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 , "tg tme telegram" .= telegram -- microblogs , "t twitter" .= twitter , "juick" .= juick -- search engines , "google" .= google , "ddg duckduckgo" .= duckduckgo , "yandex" .= yandex , "baidu" .= baidu -- programming language libraries -- Haskell , "hackage hk" .= hackage , "stackage" .= stackage , "haskell hs" .= haskell , "cabal" .= cabal -- Others , "npm" .= npm , "jam" .= jam , "gem" .= rubygems , "pypi" .= pypi , "cpan" .= metacpanPod , "cpan-r" .= metacpanRelease , "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" .= brew -- 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 ] {- | (shortcut: “fb” or “facebook”) Link by username: @ \[green\](\@fb) @ Or by profile ID (are there still people without usernames, actually?): @ \[someone something\](\@fb:164680686880529) @ -} facebook :: Shortcut facebook _ q | T.all isDigit q = return $ "https://facebook.com/profile.php?id=" <> q | otherwise = return $ "https://facebook.com/" <> q {- | (Вконтакте) (shortcut: “vk” or “vkontakte”) Link by username: @ \[green\](\@vk) @ Or by ID: @ \[Durov\](\@vk:1) @ -} vk :: Shortcut vk _ q | T.all isDigit q = return $ "https://vk.com/id" <> q | otherwise = return $ "https://vk.com/" <> q {- | (shortcut: “gp”, “gplus”, or “googleplus”) Link by username: @ \[SergeyBrin\](\@gp) @ It's alright if the username already starts with a “+”: @ \[+SergeyBrin\](\@gp) @ 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) @ You can also link by ID: @ \[Sergey Brin\](\@gp:109813896768294978296) @ Finally, there are different links for hashtags: @ \[#Australia\](\@gp) @ -} googleplus :: Shortcut googleplus _ q | T.null q = return url | T.head q == '#' = return $ format "{}/explore/{}" url (T.tail q) | T.head q == '+' = return $ formatSlash url q | T.all isDigit q = return $ formatSlash url q | otherwise = return $ format "{}/+{}" url (T.concat (T.words q)) where url = "https://plus.google.com" {- | (shortcut: "tg", "tme" or "telegram") Link by username: @ \[Kowainik telegram channel\](\@t:kowainik) @ It's alright if the username already starts with a “\@”: @ \[\@kowainik\](\@t) @ >>> useShortcut "telegram" Nothing "" Success "https://t.me" >>> useShortcut "tme" Nothing "@kowainik" Success "https://t.me/kowainik" >>> useShortcut "telegram" Nothing "kowainik" Success "https://t.me/kowainik" -} telegram :: Shortcut telegram _ q | T.null q = pure url | Just ('@', username) <- T.uncons q = pure $ formatSlash url username | otherwise = pure $ formatSlash url q where url :: Text url = "https://t.me" {- | (shortcut: “t” or “twitter”) Link by username: @ \[Edward Kmett\](\@t:kmett) @ It's alright if the username already starts with a “\@”: @ \[\@kmett\](\@t) @ There are different links for hashtags: @ \[#haskell\](\@t) @ -} twitter :: Shortcut twitter _ q | T.null q = return url | T.head q == '#' = return $ format "{}/hashtag/{}" url (T.tail q) | T.head q == '@' = return $ formatSlash url (T.tail q) | otherwise = return $ formatSlash url q where url = "https://twitter.com" {- | (shortcut: “juick”) Link by username: @ \[thefish\](\@juick) @ It's alright if the username already starts with a “\@”: @ \[\@thefish\](\@juick) @ There are different links for tags (which start with “\*” and not with “#”, by the way): @ \[*Haskell\](\@juick) @ -} juick :: Shortcut juick _ q | T.null q = return url | T.head q == '*' = return $ format "{}/tag/{}" url (T.tail q) | T.head q == '@' = return $ formatSlash url (T.tail q) | otherwise = return $ formatSlash url q where url = "https://juick.com" {- | (shortcut: “google”) Search results: @ \[random query\](\@google) @ -} google :: Shortcut google _ q = return $ "https://google.com/search?nfpr=1&q=" <> replaceSpaces '+' q {- | (shortcut: “ddg” or “duckduckgo”) Search results: @ \[random query\](\@ddg) @ -} duckduckgo :: Shortcut duckduckgo _ q = return $ "https://duckduckgo.com/?q=" <> replaceSpaces '+' q {- | (Russian search engine) (shortcut: “yandex”) Search results: @ \[random query\](\@yandex) @ -} yandex :: Shortcut yandex _ q = return $ "http://yandex.ru/search/?noreask=1&text=" <> replaceSpaces '+' q {- | (Chinese search engine) (shortcut: “baidu”) Search results: @ \[random query\](\@baidu) @ -} baidu :: Shortcut baidu _ q = return $ "http://baidu.com/s?nojc=1&wd=" <> replaceSpaces '+' q ---------------------------------------------------------------------------- -- Haskell ---------------------------------------------------------------------------- {- | __Haskell__ – (shortcut: “haskell hs”) Link to ghcup: @ \[ghcup\](\@haskell) @ >>> useShortcut "haskell" Nothing "" Success "https://haskell.org/" >>> useShortcut "hs" Nothing "ghcup" Success "https://haskell.org/ghcup" -} haskell :: Shortcut haskell _ q = pure $ "https://haskell.org/" <> replaceSpaces '_' q {- | __Haskell__ – (shortcut: “hackage hk”) Link to a package: @ \[shortcut-links\](\@hackage) @ >>> useShortcut "hackage" Nothing "" Success "https://hackage.haskell.org" >>> useShortcut "hk" Nothing "shortcut-links" Success "https://hackage.haskell.org/package/shortcut-links" -} hackage :: Shortcut hackage _ q | T.null q = pure hkUrl | otherwise = pure $ format "{}/package/{}" hkUrl (replaceSpaces '-' q) where hkUrl :: Text hkUrl = "https://hackage.haskell.org" {- | __Haskell__ – (shortcut: “stackage”) Link to a package: @ \[colourista\](\@stackage) @ >>> useShortcut "stackage" Nothing "" Success "https://stackage.org" >>> useShortcut "stackage" (Just "nightly") "" Success "https://stackage.org/nightly" >>> useShortcut "stackage" (Just "lts") "" Success "https://stackage.org/lts" >>> useShortcut "stackage" (Just "lts-15.0") "" Success "https://stackage.org/lts-15.0" >>> useShortcut "stackage" Nothing "colourista" Success "https://stackage.org/lts/package/colourista" >>> useShortcut "stackage" (Just "nightly") "colourista" Success "https://stackage.org/nightly/package/colourista" >>> useShortcut "stackage" (Just "lts-15.10") "colourista" Success "https://stackage.org/lts-15.10/package/colourista" -} stackage :: Shortcut stackage ltsNightly q | T.null q && isNothing ltsNightly = pure url | T.null q = pure $ format "{}/{}" url lts | otherwise = pure $ format "{}/{}/package/{}" url lts (replaceSpaces '-' q) where url :: Text url = "https://stackage.org" lts :: Text lts = fromMaybe "lts" ltsNightly {- | __Haskell__ – (shortcut: “cabal”) Link to the intoduction package: @ \[intro.html\](\@hackage) @ >>> useShortcut "cabal" Nothing "intro.html" Success "https://haskell.org/cabal/users-guide/intro.html" -} cabal :: Shortcut cabal _ q = pure $ format "{}/{}" url (replaceSpaces '-' q) where url :: Text url = "https://haskell.org/cabal/users-guide" {- | __Node.js__ – (shortcut: “npm”) Link to a package: @ \[markdown\](\@npm) @ -} npm :: Shortcut npm _ q = return $ "https://npmjs.com/package/" <> q {- | __Javascript__ – (shortcut: “jam”) Link to a package: @ \[pagedown\](\@jam) @ -} jam :: Shortcut jam _ q = return $ "http://jamjs.org/packages/#/details/" <> q {- | __Ruby__ – (shortcut: “gem”) Link to a package: @ \[github-markdown\](\@gem) @ -} rubygems :: Shortcut rubygems _ q = return $ "https://rubygems.org/gems/" <> q {- | __Python__ – (shortcut: “pypi”) Link to a package: @ \[Markdown\](\@pypi) @ -} pypi :: Shortcut pypi _ q = return $ "https://pypi.python.org/pypi/" <> q {- | __Perl__ – (modules) (shortcut: “cpan”) Link to a module: @ \[Text::Markdown\](\@cpan) @ To link to a release, look at 'metacpanRelease'. -} metacpanPod :: Shortcut metacpanPod _ q = return $ "https://metacpan.org/pod/" <> q {- | __Perl__ – (releases) (shortcut: “cpan-r”) Link to a release: @ \[Text-Markdown\](\@cpan-r) @ -} metacpanRelease :: Shortcut metacpanRelease _ q = return $ "https://metacpan.org/release/" <> q {- | __Rust__ – (shortcut: “cargo”) Link to a package: @ \[hoedown\](\@cargo) @ -} cargo :: Shortcut cargo _ q = return $ "https://crates.io/crates/" <> q {- | __PHP__ – (shortcut: “pear”) Link to a package: @ \[Text_Wiki_Doku\](\@pear) @ -} pear :: Shortcut pear _ q = return $ "http://pear.php.net/package/" <> q {- | __Dart__ – (shortcut: “pub”) Link to a package: @ \[md_proc\](\@pub) @ -} pub :: Shortcut pub _ q = return $ "https://pub.dartlang.org/packages/" <> q {- | __R__ – (shortcut: “cran”) Link to a package: @ \[markdown\](\@cran) @ -} cran :: Shortcut cran _ q = return $ "http://cran.r-project.org/web/packages/" <> q {- | __Erlang__ – (shortcut: “hex”) Link to a package: @ \[earmark\](\@hex) @ -} hex :: Shortcut hex _ q = return $ "https://hex.pm/packages/" <> q {- | __SWI-Prolog__ – (shortcut: “swiprolog”) Link to a package: @ \[markdown\](\@swiprolog) @ -} swiprolog :: Shortcut swiprolog _ q = return $ "http://www.swi-prolog.org/pack/list?p=" <> q {- | __D__ – (shortcut: “dub”) Link to a package: @ \[dmarkdown\](\@dub) @ -} dub :: Shortcut dub _ q = return $ "http://code.dlang.org/packages/" <> q {- | __Bash__ – (shortcut: “bpkg”) Link to a package: @ \[markdown\](\@bpkg) @ -} bpkg :: Shortcut bpkg _ q = return $ "http://bpkg.io/pkg/" <> q {- | (shortcut: “gh” or “github”) Link to a user: @ \[Aelve\](\@gh:aelve) @ Link to a repository: @ \[aelve/shortcut-links\](\@gh) @ The repository owner can also be given as an option (to avoid mentioning them in the link text): @ \[shortcut-links\](\@gh(aelve)) @ -} github :: Shortcut github mbOwner q = case mbOwner of Nothing -> return $ format "https://github.com/{}" (stripAt q) Just owner -> return $ format "https://github.com/{}/{}" (stripAt owner) q where stripAt x = if T.head x == '@' then T.tail x else x {- | (shortcut: “bitbucket”) Link to a user: @ \[Bryan\](\@bitbucket:bos) @ Link to a repository: @ \[bos/text\](\@bitbucket) @ The repository owner can also be given as an option (to avoid mentioning them in the link text): @ \[text\](\@bitbucket(bos)) @ -} bitbucket :: Shortcut bitbucket mbOwner q = case mbOwner of Nothing -> return $ format "https://bitbucket.org/{}" (stripAt q) Just owner -> return $ format "https://bitbucket.org/{}/{}" (stripAt owner) q where stripAt x = if T.head x == '@' then T.tail x else x {- | (shortcut: “gitlab”) Link to a user or a team (note that links like work but are going to be automatically redirected to either or , 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) @ Link to a repository: @ \[learnyou/lysa\](\@gitlab) @ The repository owner can also be given as an option (to avoid mentioning them in the link text): @ \[lysa\](\@gitlab(learnyou)) @ -} gitlab :: Shortcut gitlab mbOwner q = case mbOwner of Nothing -> return $ format "https://gitlab.com/{}" (stripAt q) Just owner -> return $ format "https://gitlab.com/{}/{}" (stripAt owner) q where stripAt x = if T.head x == '@' then T.tail x else x {- | __Android__ – (formerly Play Market) (shortcut: “gplay” or “googleplay”) Link to an app: @ \[Opera Mini\](\@gplay:com.opera.mini.native) @ -} googleplay :: Shortcut googleplay _ q = return $ "https://play.google.com/store/apps/details?id=" <> q {- | (Homebrew formulas) (shortcut: “brew”) Link to a formula: @ \[multimarkdown\](\@brew) @ Since all Homebrew formulas are stored in a Github repo anyway, and various sites are merely convenient ways to browse that repo, the “brew” shortcut can point to some other site in the future, depending on which site seems better. Don't use it if you need /specifically/ Braumeister. -} brew :: Shortcut brew _ q = return $ "http://braumeister.org/formula/" <> q {- | (shortcut: “chocolatey”) Link to a package: @ \[Opera\](\@chocolatey) @ -} chocolatey :: Shortcut chocolatey _ q = return $ "https://chocolatey.org/packages/" <> q {- | __Debian__ – (shortcut: “debian”) Link to a package in stable distribution: @ \[ghc\](\@debian) @ Distribution can be given as an option: @ \[ghc\](\@debian(experimental)) @ -} debian :: Shortcut debian mbDist q = return $ format "https://packages.debian.org/{}/{}" dist q where dist = fromMaybe "stable" mbDist {- | __Arch Linux__ – (“user repository”) (shortcut: “aur”) Link to a package: @ \[ghc-git\](\@aur) @ -} aur :: Shortcut aur _ q = return $ "https://aur.archlinux.org/packages/" <> q {- | __Gentoo__ – (shortcut: “gentoo”) Link to a package: @ \[dev-lang/ghc\](\@gentoo) @ Category can be given as an option, to avoid cluttering link text: @ \[ghc\](\@gentoo(dev-lang)) @ 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__ – (shortcut: “opensuse”) Link to a package: @ \[ghc\](\@opensuse) @ -} opensuse :: Shortcut opensuse _ q = return $ "http://software.opensuse.org/package/" <> q {- | __Linux Mint__ – (shortcut: “mint”) Link to a package: @ \[ghc\](\@mint) @ -} mint :: Shortcut mint _ q = return $ "http://community.linuxmint.com/software/view/" <> q {- | __Fedora__ – (shortcut: “fedora”) Link to a package: @ \[ghc\](\@fedora) @ -} fedora :: Shortcut fedora _ q = return $ "https://admin.fedoraproject.org/pkgdb/package/" <> q {- | __Emacs__ – (shortcut: “marmalade”) Link to a package: @ \[markdown-mode\](\@marmalade) @ -} marmalade :: Shortcut marmalade _ q = return $ "https://marmalade-repo.org/packages/" <> q {- | __Emacs__ – (shortcut: “melpa”) Link to a package: @ \[markdown-mode\](\@melpa) @ -} melpa :: Shortcut melpa _ q = return $ "http://melpa.org/#/" <> q {- | __Emacs__ – (shortcut: “elpa”) Link to a package: @ \[undo-tree\](\@elpa) @ -} elpa :: Shortcut elpa _ q = return $ format "https://elpa.gnu.org/packages/{}.html" q {- | __Sublime Text__ – (shortcut: “sublimepc”) Link to a package: @ \[MarkdownEditing\](\@sublimepc) @ -} packagecontrol :: Shortcut packagecontrol _ q = return $ "https://packagecontrol.io/packages/" <> q {- | __Atom__ – (shortcut: “atom”) Link to a package: @ \[tidy-markdown\](\@atom) @ -} atomPackage :: Shortcut atomPackage _ q = return $ "https://atom.io/packages/" <> q {- | __Atom__ – (shortcut: “atom-theme”) Link to a theme: @ \[atom-material-ui\](\@atom-theme) @ -} atomTheme :: Shortcut atomTheme _ q = return $ "https://atom.io/themes/" <> q {- | __jEdit__ – (shortcut: “jedit”) Link to a plugin: @ \[MarkdownPlugin\](\@jedit) @ -} jedit :: Shortcut jedit _ q = return $ "http://plugins.jedit.org/plugins/?" <> q {- | __Vim__ – (shortcut: “vim”) Link to a script (by ID): @ \[haskell.vim\](\@vim:2062) @ -} vim :: Shortcut vim _ q = return $ "http://www.vim.org/scripts/script.php?script_id=" <> q {- | __Opera__ – (shortcut: “opera”) Link to an extension: @ \[Amazon\](\@opera:amazon-for-opera) @ -} operaExt :: Shortcut operaExt _ q = return $ "https://addons.opera.com/extensions/details/" <> q {- | __Opera__ – (shortcut: “opera-theme”) Link to a theme: @ \[Space theme\](\@opera-theme:space-15) @ -} operaTheme :: Shortcut operaTheme _ q = return $ "https://addons.opera.com/themes/details/" <> q {- | __Firefox__ – (shortcut: “firefox”) Link to an extension (or a theme): @ \[tree-style-tab](\@firefox) @ -} firefox :: Shortcut firefox _ q = return $ "https://addons.mozilla.org/firefox/addon/" <> q {- | __Chrome__ – (shortcut: “chrome”) Link to an extension, app, or theme (using that weird random-looking ID): @ \[hdokiejnpimakedhajhdlcegeplioahd](\@chrome) @ -} chrome :: Shortcut chrome _ q = return $ "https://chrome.google.com/webstore/detail/" <> q {- | (Glasgow Haskell Compiler) extensions (shortcut: “ghc-ext”) Link to an extension's description in the user manual: @ \[ViewPatterns\](\@ghc-ext) @ -} ghcExt :: Shortcut ghcExt _ q = return $ "https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-" <> q {- | (shortcut: “rfc”) Link to an RFC: @ \[RFC 2026\](\@rfc) @ 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') {- | (shortcut: “ecma”) Link to a standard: @ \[ECMA-262\](\@ecma) @ Link to a technical report: @ \[TR/71\](\@ecma) @ 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 {- | (Common Vulnerabilities and Exposures) (shortcut: “cve”) Link to a CVE: @ \[CVE-2014-10001\](\@cve) @ 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 - format" return ("http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-" <> n) {- | (shortcut: “w” or “wikipedia”) Link to an article in English Wikipedia: @ \[grey-headed flying fox\](\@w) @ You can link to Wikipedia-in-another-language if you give language code as an option: @ \[Haskell\](\@w(ru)) @ >>> useShortcut "wikipedia" Nothing "" Success "https://en.wikipedia.org/wiki/" >>> useShortcut "w" (Just "ru") "" Success "https://ru.wikipedia.org/wiki/" >>> useShortcut "wikipedia" Nothing "Query" Success "https://en.wikipedia.org/wiki/Query" >>> useShortcut "w" Nothing "multiple words query" Success "https://en.wikipedia.org/wiki/Multiple_words_query" >>> useShortcut "wikipedia" Nothing "grey-headed flying fox" Success "https://en.wikipedia.org/wiki/Grey-headed_flying_fox" >>> useShortcut "w" Nothing "pattern matching#primitive patterns" Success "https://en.wikipedia.org/wiki/Pattern_matching#Primitive_patterns" -} wikipedia :: Shortcut wikipedia (fromMaybe "en" -> lang) q = pure $ format "https://{}.wikipedia.org/wiki/{}" lang replacedQ where replacedQ :: Text replacedQ = titleFirst (replaceSpaces '_' q) {- | (shortcut: “tvtropes”) Link to a trope: @ \[so bad, it's good\](\@tvtropes) @ Link to anything else (a series, for example): @ \[Elementary\](\@tvtropes(series)) @ Or something on Sugar Wiki: @ \[awesome music\](\@tvtropes(sugar wiki)) @ -} 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