{-# LANGUAGE CPP           #-}
{-# LANGUAGE DeriveFunctor #-}

{- |
Copyright:  (c) 2015-2019 Aelve
            (c) 2019-2021 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>
-}

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.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
-- >>> import ShortcutLinks.Utils

-- | Resulting data type over the work of @shortcut-links@
data Result a
    = Failure String
    | Warning [String] a
    | Success a
    deriving stock (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)

instance Applicative Result where
    pure :: a -> Result a
    pure :: a -> Result a
pure = a -> Result a
forall a. a -> Result a
Success

    (<*>) :: Result (a -> b) -> Result a -> Result b
    Failure String
x <*> :: Result (a -> b) -> Result a -> Result b
<*> Result a
_ = String -> Result b
forall a. String -> Result a
Failure String
x
    Warning [String]
wf a -> b
f <*> Result a
s = case Result a
s of
        Success a
a    -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning [String]
wf (a -> b
f a
a)
        Warning [String]
wa a
a -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning ([String]
wf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
wa) (a -> b
f a
a)
        Failure String
x    -> String -> Result b
forall a. String -> Result a
Failure String
x
    Success a -> b
f <*> Result a
a = a -> b
f (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result a
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 :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    (>>=) :: Result a -> (a -> Result b) -> Result b
    Failure String
x    >>= :: Result a -> (a -> Result b) -> Result b
>>= a -> Result b
_ = String -> Result b
forall a. String -> Result a
Failure String
x
    Warning [String]
wa a
a >>= a -> Result b
f = case a -> Result b
f a
a of
        Success    b
b -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning [String]
wa b
b
        Warning [String]
wb b
b -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning ([String]
wa [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
wb) b
b
        Failure String
x    -> String -> Result b
forall a. String -> Result a
Failure String
x
    Success    a
a >>= a -> Result b
f = a -> Result b
f a
a

instance Fail.MonadFail Result where
    fail :: String -> Result a
    fail :: String -> Result a
fail = String -> Result a
forall a. String -> Result a
Failure

-- | Create a unit 'Warning' with a single warning message
warn :: String -> Result ()
warn :: String -> Result ()
warn String
s = [String] -> () -> Result ()
forall a. [String] -> a -> Result a
Warning [String
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 :: [([Text], Shortcut)]
allShortcuts =
  -- When changing something here, don't forget to update the description for
  -- the corresponding shortcut.
  let .= :: Text -> b -> ([Text], b)
(.=) Text
names b
func = (Text -> [Text]
T.words Text
names, b
func)
  in
    [ -- encyclopedias
      Text
"w wikipedia"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
wikipedia
    , Text
"tvtropes"                Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
tvtropes
      -- social networks
    , Text
"fb facebook"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
facebook
    , Text
"vk vkontakte"            Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
vk
    , Text
"gp gplus googleplus"     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
googleplus
    , Text
"tg tme telegram"         Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
telegram
      -- microblogs
    , Text
"t twitter"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
twitter
    , Text
"juick"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
juick
      -- search engines
    , Text
"google"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
google
    , Text
"ddg duckduckgo"          Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
duckduckgo
    , Text
"yandex"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
yandex
    , Text
"baidu"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
baidu
      -- programming language libraries
        -- Haskell
    , Text
"hackage hk" Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
hackage
    , Text
"stackage"   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
stackage
    , Text
"haskell hs" Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
haskell
    , Text
"cabal"      Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cabal
        -- Others
    , Text
"npm"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
npm
    , Text
"jam"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
jam
    , Text
"gem"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
rubygems
    , Text
"pypi"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pypi
    , Text
"cpan"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
metacpanPod
    , Text
"cpan-r"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
metacpanRelease
    , Text
"cargo"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cargo
    , Text
"pub"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pub
    , Text
"hex"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
hex
    , Text
"cran"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cran
    , Text
"swiprolog"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
swiprolog
    , Text
"dub"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
dub
    , Text
"bpkg"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
bpkg
    , Text
"pear"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pear
      -- code hosting
    , Text
"gh github"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
github
    , Text
"gitlab"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
gitlab
    , Text
"bitbucket"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
bitbucket
      -- OS
    , Text
"gplay googleplay"        Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
googleplay
    , Text
"chocolatey"              Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
chocolatey
    , Text
"brew"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
brew
      -- OS – Linux
    , Text
"debian"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
debian
    , Text
"aur"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
aur
    , Text
"mint"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
mint
    , Text
"fedora"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
fedora
    , Text
"gentoo"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
gentoo
    , Text
"opensuse"                Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
opensuse
      -- text editors
    , Text
"marmalade"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
marmalade
    , Text
"melpa"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
melpa
    , Text
"elpa"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
elpa
    , Text
"sublimepc"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
packagecontrol
    , Text
"atom"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
atomPackage
    , Text
"atom-theme"              Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
atomTheme
    , Text
"jedit"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
jedit
    , Text
"vim"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
vim
      -- browsers
    , Text
"opera"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
operaExt
    , Text
"opera-theme"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
operaTheme
    , Text
"firefox"                 Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
firefox
    , Text
"chrome"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
chrome
      -- manuals
    , Text
"ghc-ext"                 Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
ghcExt
      -- standards and databases
    , Text
"rfc"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
rfc
    , Text
"ecma"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
ecma
    , Text
"cve"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cve
    ]

{- | <https://facebook.com Facebook> (shortcut: “fb” or “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 :: Shortcut
facebook Maybe Text
_ Text
q
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://facebook.com/profile.php?id=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q
  | Bool
otherwise       = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://facebook.com/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://vk.com Vkontakte> (Вконтакте) (shortcut: “vk” or “vkontakte”)

Link by username:

@
\[green\](\@vk)
<https://vk.com/green>
@

Or by ID:

@
\[Durov\](\@vk:1)
<https://vk.com/id1>
@
-}
vk :: Shortcut
vk :: Shortcut
vk Maybe Text
_ Text
q
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://vk.com/id" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q
  | Bool
otherwise       = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://vk.com/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://plus.google.com Google+> (shortcut: “gp”, “gplus”, or “googleplus”)

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 :: Shortcut
googleplus Maybe Text
_ Text
q
  | Text -> Bool
T.null Text
q        = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/explore/{}" Text
url (Text -> Text
T.tail Text
q)
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
q
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
q
  | Bool
otherwise       = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/+{}" Text
url ([Text] -> Text
T.concat (Text -> [Text]
T.words Text
q))
  where
    url :: Text
url = Text
"https://plus.google.com"

{- | <https://t.me Telegram> (shortcut: "tg", "tme" or "telegram")

Link by username:

@
\[Kowainik telegram channel\](\@t:kowainik)
<https://t.me/kowainik>
@


It's alright if the username already starts with a “\@”:

@
\[\@kowainik\](\@t)
<https://t.me/kowainik>
@

>>> 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 :: Shortcut
telegram Maybe Text
_ Text
q
    | Text -> Bool
T.null Text
q       = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
url
    | Just (Char
'@', Text
username) <- Text -> Maybe (Char, Text)
T.uncons Text
q = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
username
    | Bool
otherwise      = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
q
  where
    url :: Text
    url :: Text
url = Text
"https://t.me"

{- | <https://twitter.com Twitter> (shortcut: “t” or “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 :: Shortcut
twitter Maybe Text
_ Text
q
  | Text -> Bool
T.null Text
q        = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/hashtag/{}" Text
url (Text -> Text
T.tail Text
q)
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url (Text -> Text
T.tail Text
q)
  | Bool
otherwise       = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
q
  where url :: Text
url = Text
"https://twitter.com"

{- | <https://juick.com Juick> (shortcut: “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 :: Shortcut
juick Maybe Text
_ Text
q
  | Text -> Bool
T.null Text
q        = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/tag/{}" Text
url (Text -> Text
T.tail Text
q)
  | Text -> Char
T.head Text
q Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url (Text -> Text
T.tail Text
q)
  | Bool
otherwise       = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => r
formatSlash Text
url Text
q
  where url :: Text
url = Text
"https://juick.com"

{- | <https://google.com Google> (shortcut: “google”)

Search results:

@
\[random query\](\@google)
<https://www.google.com/search?nfpr=1&q=random+query>
@
-}
google :: Shortcut
google :: Shortcut
google Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$
  Text
"https://google.com/search?nfpr=1&q=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces Char
'+' Text
q

{- | <https://duckduckgo.com Duckduckgo> (shortcut: “ddg” or “duckduckgo”)

Search results:

@
\[random query\](\@ddg)
<https://duckduckgo.com/?q=random+query>
@
-}
duckduckgo :: Shortcut
duckduckgo :: Shortcut
duckduckgo Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://duckduckgo.com/?q=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces Char
'+' Text
q

{- | <http://yandex.ru Yandex> (Russian search engine) (shortcut: “yandex”)

Search results:

@
\[random query\](\@yandex)
<http://yandex.ru/search/?noreask=1&text=random+query>
@
-}
yandex :: Shortcut
yandex :: Shortcut
yandex Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$
  Text
"http://yandex.ru/search/?noreask=1&text=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces Char
'+' Text
q

{- | <http://baidu.com Baidu> (Chinese search engine) (shortcut: “baidu”)

Search results:

@
\[random query\](\@baidu)
<http://baidu.com/s?nojc=1&wd=random+query>
@
-}
baidu :: Shortcut
baidu :: Shortcut
baidu Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://baidu.com/s?nojc=1&wd=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces Char
'+' Text
q

----------------------------------------------------------------------------
-- Haskell
----------------------------------------------------------------------------

{- | __Haskell__ – <https://haskell.org> (shortcut: “haskell hs”)

Link to ghcup:

@
\[ghcup\](\@haskell)
<https://haskell.org/ghcup>
@

>>> useShortcut "haskell" Nothing ""
Success "https://haskell.org/"
>>> useShortcut "hs" Nothing "ghcup"
Success "https://haskell.org/ghcup"
-}
haskell :: Shortcut
haskell :: Shortcut
haskell Maybe Text
_ Text
q = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://haskell.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces Char
'_' Text
q


{- | __Haskell__ – <https://hackage.haskell.org Hackage> (shortcut: “hackage hk”)

Link to a package:

@
\[shortcut-links\](\@hackage)
<https://hackage.haskell.org/package/shortcut-links>
@

>>> useShortcut "hackage" Nothing ""
Success "https://hackage.haskell.org"
>>> useShortcut "hk" Nothing "shortcut-links"
Success "https://hackage.haskell.org/package/shortcut-links"

-}
hackage :: Shortcut
hackage :: Shortcut
hackage Maybe Text
_ Text
q
    | Text -> Bool
T.null Text
q  = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
hkUrl
    | Bool
otherwise = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/package/{}" Text
hkUrl (Char -> Text -> Text
replaceSpaces Char
'-' Text
q)
  where
    hkUrl :: Text
    hkUrl :: Text
hkUrl = Text
"https://hackage.haskell.org"

{- | __Haskell__ – <https://staskell.org Stackage> (shortcut: “stackage”)

Link to a package:

@
\[colourista\](\@stackage)
<https://stackage.org/lts/package/colourista>
@

>>> 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 :: Shortcut
stackage Maybe Text
ltsNightly Text
q
    | Text -> Bool
T.null Text
q Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
ltsNightly = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
url
    | Text -> Bool
T.null Text
q  = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/{}" Text
url Text
lts
    | Bool
otherwise = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/{}/package/{}" Text
url Text
lts (Char -> Text -> Text
replaceSpaces Char
'-' Text
q)
  where
    url :: Text
    url :: Text
url = Text
"https://stackage.org"

    lts :: Text
    lts :: Text
lts = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"lts" Maybe Text
ltsNightly

{- | __Haskell__ – <https://haskell.org/cabal/users-guide Cabal> (shortcut: “cabal”)

Link to the intoduction package:

@
\[intro.html\](\@hackage)
<https://haskell.org/cabal/users-guide/intro.html>
@

>>> useShortcut "cabal" Nothing "intro.html"
Success "https://haskell.org/cabal/users-guide/intro.html"
-}
cabal :: Shortcut
cabal :: Shortcut
cabal Maybe Text
_ Text
q = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/{}" Text
url (Char -> Text -> Text
replaceSpaces Char
'-' Text
q)
  where
    url :: Text
    url :: Text
url = Text
"https://haskell.org/cabal/users-guide"

{- | __Node.js__ – <https://npmjs.com NPM> (shortcut: “npm”)

Link to a package:

@
\[markdown\](\@npm)
<https://www.npmjs.com/package/markdown>
@
-}
npm :: Shortcut
npm :: Shortcut
npm Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://npmjs.com/package/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Javascript__ – <http://jamjs.org/packages/#/ Jam> (shortcut: “jam”)

Link to a package:

@
\[pagedown\](\@jam)
<http://jamjs.org/packages/#/details/pagedown>
@
-}
jam :: Shortcut
jam :: Shortcut
jam Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://jamjs.org/packages/#/details/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Ruby__ – <https://rubygems.org RubyGems.org> (shortcut: “gem”)

Link to a package:

@
\[github-markdown\](\@gem)
<https://rubygems.org/gems/github-markdown>
@
-}
rubygems :: Shortcut
rubygems :: Shortcut
rubygems Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://rubygems.org/gems/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Python__ – <https://pypi.python.org/pypi PyPI> (shortcut: “pypi”)

Link to a package:

@
\[Markdown\](\@pypi)
<https://pypi.python.org/pypi/Markdown>
@
-}
pypi :: Shortcut
pypi :: Shortcut
pypi Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://pypi.python.org/pypi/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Perl__ – <https://metacpan.org MetaCPAN> (modules) (shortcut: “cpan”)

Link to a module:

@
\[Text::Markdown\](\@cpan)
<https://metacpan.org/pod/Text::Markdown>
@

To link to a release, look at 'metacpanRelease'.
-}
metacpanPod :: Shortcut
metacpanPod :: Shortcut
metacpanPod Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://metacpan.org/pod/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Perl__ – <https://metacpan.org MetaCPAN> (releases) (shortcut: “cpan-r”)

Link to a release:

@
\[Text-Markdown\](\@cpan-r)
<https://metacpan.org/release/Text-Markdown>
@
-}
metacpanRelease :: Shortcut
metacpanRelease :: Shortcut
metacpanRelease Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://metacpan.org/release/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Rust__ – <https://crates.io Cargo> (shortcut: “cargo”)

Link to a package:

@
\[hoedown\](\@cargo)
<https://crates.io/crates/hoedown>
@
-}
cargo :: Shortcut
cargo :: Shortcut
cargo Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://crates.io/crates/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __PHP__ – <http://pear.php.net PEAR> (shortcut: “pear”)

Link to a package:

@
\[Text_Wiki_Doku\](\@pear)
<http://pear.php.net/package/Text_Wiki_Doku>
@
-}
pear :: Shortcut
pear :: Shortcut
pear Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://pear.php.net/package/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Dart__ – <https://pub.dartlang.org pub> (shortcut: “pub”)

Link to a package:

@
\[md_proc\](\@pub)
<https://pub.dartlang.org/packages/md_proc>
@
-}
pub :: Shortcut
pub :: Shortcut
pub Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://pub.dartlang.org/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __R__ – <http://cran.r-project.org/web/packages/ CRAN> (shortcut: “cran”)

Link to a package:

@
\[markdown\](\@cran)
<http://cran.r-project.org/web/packages/markdown>
@
-}
cran :: Shortcut
cran :: Shortcut
cran Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://cran.r-project.org/web/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Erlang__ – <https://hex.pm Hex> (shortcut: “hex”)

Link to a package:

@
\[earmark\](\@hex)
<https://hex.pm/packages/earmark>
@
-}
hex :: Shortcut
hex :: Shortcut
hex Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://hex.pm/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __SWI-Prolog__ – <http://www.swi-prolog.org/pack/list packages> (shortcut: “swiprolog”)

Link to a package:

@
\[markdown\](\@swiprolog)
<http://www.swi-prolog.org/pack/list?p=markdown>
@
-}
swiprolog :: Shortcut
swiprolog :: Shortcut
swiprolog Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://www.swi-prolog.org/pack/list?p=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __D__ – <http://code.dlang.org DUB> (shortcut: “dub”)

Link to a package:

@
\[dmarkdown\](\@dub)
<http://code.dlang.org/packages/dmarkdown>
@
-}
dub :: Shortcut
dub :: Shortcut
dub Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://code.dlang.org/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Bash__ – <http://bpkg.io bpkg> (shortcut: “bpkg”)

Link to a package:

@
\[markdown\](\@bpkg)
<http://www.bpkg.io/pkg/markdown>
@
-}
bpkg :: Shortcut
bpkg :: Shortcut
bpkg Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://bpkg.io/pkg/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://github.com Github> (shortcut: “gh” or “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 them in the link text):

@
\[shortcut-links\](\@gh(aelve))
<https://github.com/aelve/shortcut-links>
@
-}
github :: Shortcut
github :: Shortcut
github Maybe Text
mbOwner Text
q = case Maybe Text
mbOwner of
  Maybe Text
Nothing    -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://github.com/{}" (Text -> Text
stripAt Text
q)
  Just Text
owner -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://github.com/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' then Text -> Text
T.tail Text
x else Text
x

{- | <https://bitbucket.org Bitbucket> (shortcut: “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 them in the link text):

@
\[text\](\@bitbucket(bos))
<https://bitbucket.org/bos/text>
@
-}
bitbucket :: Shortcut
bitbucket :: Shortcut
bitbucket Maybe Text
mbOwner Text
q = case Maybe Text
mbOwner of
  Maybe Text
Nothing    -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://bitbucket.org/{}" (Text -> Text
stripAt Text
q)
  Just Text
owner -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://bitbucket.org/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' then Text -> Text
T.tail Text
x else Text
x

{- | <https://gitlab.com Gitlab> (shortcut: “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 them in the link text):

@
\[lysa\](\@gitlab(learnyou))
<https://gitlab.com/learnyou/lysa>
@
-}
gitlab :: Shortcut
gitlab :: Shortcut
gitlab Maybe Text
mbOwner Text
q = case Maybe Text
mbOwner of
  Maybe Text
Nothing    -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://gitlab.com/{}" (Text -> Text
stripAt Text
q)
  Just Text
owner -> Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://gitlab.com/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' then Text -> Text
T.tail Text
x else Text
x

{- | __Android__ – <https://play.google.com Google Play> (formerly Play Market) (shortcut: “gplay” or “googleplay”)

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 :: Shortcut
googleplay Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://play.google.com/store/apps/details?id=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <http://braumeister.org Braumeister> (Homebrew formulas) (shortcut: “brew”)

Link to a formula:

@
\[multimarkdown\](\@brew)
<http://braumeister.org/formula/multimarkdown>
@

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 :: Shortcut
brew Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://braumeister.org/formula/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://chocolatey.org Chocolatey> (shortcut: “chocolatey”)

Link to a package:

@
\[Opera\](\@chocolatey)
<https://chocolatey.org/packages/Opera>
@
-}
chocolatey :: Shortcut
chocolatey :: Shortcut
chocolatey Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://chocolatey.org/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Debian__ – <https://debian.org/distrib/packages packages> (shortcut: “debian”)

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 :: Shortcut
debian Maybe Text
mbDist Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://packages.debian.org/{}/{}" Text
dist Text
q
  where
    dist :: Text
dist = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"stable" Maybe Text
mbDist

{- | __Arch Linux__ – <https://aur.archlinux.org AUR> (“user repository”) (shortcut: “aur”)

Link to a package:

@
\[ghc-git\](\@aur)
<https://aur.archlinux.org/packages/ghc-git>
@
-}
aur :: Shortcut
aur :: Shortcut
aur Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://aur.archlinux.org/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Gentoo__ – <https://packages.gentoo.org packages> (shortcut: “gentoo”)

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 :: Shortcut
gentoo Maybe Text
mbCat Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://packages.gentoo.org/package/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pkg
  where
    pkg :: Text
pkg = case Maybe Text
mbCat of
      Maybe Text
Nothing  -> Text
q
      Just Text
cat -> Text
cat Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __openSUSE__ – <http://software.opensuse.org packages> (shortcut: “opensuse”)

Link to a package:

@
\[ghc\](\@opensuse)
<http://software.opensuse.org/package/ghc>
@
-}
opensuse :: Shortcut
opensuse :: Shortcut
opensuse Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://software.opensuse.org/package/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Linux Mint__ – <http://community.linuxmint.com/software/browse packages> (shortcut: “mint”)

Link to a package:

@
\[ghc\](\@mint)
<http://community.linuxmint.com/software/view/ghc>
@
-}
mint :: Shortcut
mint :: Shortcut
mint Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://community.linuxmint.com/software/view/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Fedora__ – <https://admin.fedoraproject.org/pkgdb packages> (shortcut: “fedora”)

Link to a package:

@
\[ghc\](\@fedora)
<https://admin.fedoraproject.org/pkgdb/package/ghc>
@
-}
fedora :: Shortcut
fedora :: Shortcut
fedora Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://admin.fedoraproject.org/pkgdb/package/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Emacs__ – <https://marmalade-repo.org Marmalade> (shortcut: “marmalade”)

Link to a package:

@
\[markdown-mode\](\@marmalade)
<https://marmalade-repo.org/packages/markdown-mode>
@
-}
marmalade :: Shortcut
marmalade :: Shortcut
marmalade Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://marmalade-repo.org/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Emacs__ – <http://melpa.org MELPA> (shortcut: “melpa”)

Link to a package:

@
\[markdown-mode\](\@melpa)
<http://melpa.org/#/markdown-mode>
@
-}
melpa :: Shortcut
melpa :: Shortcut
melpa Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://melpa.org/#/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Emacs__ – <https://elpa.gnu.org ELPA> (shortcut: “elpa”)

Link to a package:

@
\[undo-tree\](\@elpa)
<https://elpa.gnu.org/packages/undo-tree.html>
@
-}
elpa :: Shortcut
elpa :: Shortcut
elpa Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://elpa.gnu.org/packages/{}.html" Text
q

{- | __Sublime Text__ – <https://packagecontrol.io Package Control> (shortcut: “sublimepc”)

Link to a package:

@
\[MarkdownEditing\](\@sublimepc)
<https://packagecontrol.io/packages/MarkdownEditing>
@
-}
packagecontrol :: Shortcut
packagecontrol :: Shortcut
packagecontrol Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://packagecontrol.io/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Atom__ – <https://atom.io/packages packages> (shortcut: “atom”)

Link to a package:

@
\[tidy-markdown\](\@atom)
<https://atom.io/packages/tidy-markdown>
@
-}
atomPackage :: Shortcut
atomPackage :: Shortcut
atomPackage Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://atom.io/packages/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Atom__ – <https://atom.io/themes themes> (shortcut: “atom-theme”)

Link to a theme:

@
\[atom-material-ui\](\@atom-theme)
<https://atom.io/themes/atom-material-ui>
@
-}
atomTheme :: Shortcut
atomTheme :: Shortcut
atomTheme Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://atom.io/themes/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __jEdit__ – <http://plugins.jedit.org plugins> (shortcut: “jedit”)

Link to a plugin:

@
\[MarkdownPlugin\](\@jedit)
<http://plugins.jedit.org/plugins/?MarkdownPlugin>
@
-}
jedit :: Shortcut
jedit :: Shortcut
jedit Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://plugins.jedit.org/plugins/?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Vim__ – <http://www.vim.org/scripts/ scripts> (shortcut: “vim”)

Link to a script (by ID):

@
\[haskell.vim\](\@vim:2062)
<http://www.vim.org/scripts/script.php?script_id=2062>
@
-}
vim :: Shortcut
vim :: Shortcut
vim Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"http://www.vim.org/scripts/script.php?script_id=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Opera__ – <https://addons.opera.com/extensions/ extensions> (shortcut: “opera”)

Link to an extension:

@
\[Amazon\](\@opera:amazon-for-opera)
<https://addons.opera.com/extensions/details/amazon-for-opera>
@
-}
operaExt :: Shortcut
operaExt :: Shortcut
operaExt Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://addons.opera.com/extensions/details/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Opera__ – <https://addons.opera.com/themes/ themes> (shortcut: “opera-theme”)

Link to a theme:

@
\[Space theme\](\@opera-theme:space-15)
<https://addons.opera.com/en/themes/details/space-15>
@
-}
operaTheme :: Shortcut
operaTheme :: Shortcut
operaTheme Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://addons.opera.com/themes/details/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Firefox__ – <https://addons.mozilla.org/firefox add-ons> (shortcut: “firefox”)

Link to an extension (or a theme):

@
\[tree-style-tab](\@firefox)
<https://addons.mozilla.org/firefox/addon/tree-style-tab>
@
-}
firefox :: Shortcut
firefox :: Shortcut
firefox Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://addons.mozilla.org/firefox/addon/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | __Chrome__ – <https://chrome.google.com/webstore Chrome Web Store> (shortcut: “chrome”)

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 :: Shortcut
chrome Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://chrome.google.com/webstore/detail/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://www.haskell.org/ghc/ GHC> (Glasgow Haskell Compiler) extensions (shortcut: “ghc-ext”)

Link to an extension's description in the user manual:

@
\[ViewPatterns\](\@ghc-ext)
<https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-ViewPatterns>
@
-}
ghcExt :: Shortcut
ghcExt :: Shortcut
ghcExt Maybe Text
_ Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ Text
"https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q

{- | <https://www.ietf.org/rfc.html RFCs> (shortcut: “rfc”)

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 :: Shortcut
rfc Maybe Text
_ Text
x = do
  let n :: Text
n = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum) (Text -> Text -> Text
tryStripPrefixCI Text
"rfc" Text
x)
  -- We don't use 'readMaybe' here because 'readMaybe' isn't available in GHC
  -- 7.4, which Pandoc has to be compatible with.
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
n) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"non-digits in RFC number"
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
n) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"no RFC number"
  let n' :: Text
n' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Text
n Text -> Text -> Text
forall a. (Eq a, Monoid a) => a -> a -> a
`orElse` Text
"0"
  Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"https://tools.ietf.org/html/rfc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n')

{- | <http://ecma-international.org/publications/index.html Ecma standards and technical reports> (shortcut: “ecma”)

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 :: Shortcut
ecma Maybe Text
_ Text
q = do
  -- TODO: move dropSeparators to Utils and use it in 'rfc' and 'cve'
  let dropSeparators :: Text -> Text
dropSeparators = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum)
  let (Text -> Text
dropSeparators -> Text
mbNum, Bool
isTR) = case Text -> Text -> Maybe Text
stripPrefixCI Text
"tr" Text
q of
        Maybe Text
Nothing -> (Text -> Text -> Text
tryStripPrefixCI Text
"ecma" Text
q, Bool
False)
        Just Text
q' -> (Text
q', Bool
True)
  -- We don't use 'readMaybe' here because 'readMaybe' isn't available in GHC
  -- 7.4, which Pandoc has to be compatible with.
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
mbNum) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"non-digits in ECMA standard number"
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
mbNum) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"no ECMA standard number"
  -- The number has to have at least 3 digits.
  let num :: Text
num = Int -> Char -> Text -> Text
T.justifyRight Int
3 Char
'0' Text
mbNum
      url :: Text
url = Text
"http://ecma-international.org/publications" :: Text
  Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$ if Bool
isTR
    then Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/techreports/E-TR-{}.htm" Text
url Text
num
    else Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"{}/standards/Ecma-{}.htm" Text
url Text
num

{- | <http://cve.mitre.org CVEs> (Common Vulnerabilities and Exposures) (shortcut: “cve”)

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 :: Shortcut
cve Maybe Text
_ Text
x = do
  let n :: Text
n = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum) (Text -> Text -> Text
tryStripPrefixCI Text
"cve" Text
x)
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
T.length Text
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"CVE-ID is too short"
  let isValid :: Bool
isValid = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [
        Text -> Int
T.length Text
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9,
        (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit (Int -> Text -> Text
T.take Int
4 Text
n),
        Text -> Int -> Char
T.index Text
n Int
4 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-',
        (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit (Int -> Text -> Text
T.drop Int
5 Text
n) ]
  Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isValid (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn String
"CVE-ID doesn't follow the <year>-<digits> format"
  Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n)

{- | <https://wikipedia.org/ Wikipedia> (shortcut: “w” or “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>
@


>>> 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 :: Shortcut
wikipedia (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"en" -> Text
lang) Text
q = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"https://{}.wikipedia.org/wiki/{}" Text
lang Text
replacedQ
  where
    replacedQ :: Text
    replacedQ :: Text
replacedQ = Text -> Text
titleFirst (Char -> Text -> Text
replaceSpaces Char
'_' Text
q)

{- | <http://tvtropes.org TV Tropes> (shortcut: “tvtropes”)

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 :: Shortcut
tvtropes Maybe Text
mbCat Text
q = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result Text) -> Text -> Result Text
forall a b. (a -> b) -> a -> b
$
  Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format Text
"http://tvtropes.org/pmwiki/pmwiki.php/{}/{}" Text
cat (Text -> Text
camel Text
q)
  where
    isSep :: Char -> Bool
isSep Char
c = (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''
    -- Break into words, transform each word like “it's” → “Its”, and concat.
    -- Note that e.g. “man-made” is considered 2 separate words.
    camel :: Text -> Text
camel = [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
titleFirst (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isAlphaNum) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSep
    cat :: Text
cat = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Main" Text -> Text
camel Maybe Text
mbCat