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

{- |
Copyright:  (c) 2015-2019 Aelve
            (c) 2019-2020 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.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 (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 x :: String
x <*> :: Result (a -> b) -> Result a -> Result b
<*> _ = String -> Result b
forall a. String -> Result a
Failure String
x
    Warning wf :: [String]
wf f :: a -> b
f <*> s :: Result a
s = case Result a
s of
        Success a :: a
a    -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning [String]
wf (a -> b
f a
a)
        Warning wa :: [String]
wa a :: 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 x :: String
x    -> String -> Result b
forall a. String -> Result a
Failure String
x
    Success f :: a -> b
f <*> a :: 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 x :: String
x    >>= :: Result a -> (a -> Result b) -> Result b
>>= _ = String -> Result b
forall a. String -> Result a
Failure String
x
    Warning wa :: [String]
wa a :: a
a >>= f :: a -> Result b
f = case a -> Result b
f a
a of
        Success    b :: b
b -> [String] -> b -> Result b
forall a. [String] -> a -> Result a
Warning [String]
wa b
b
        Warning wb :: [String]
wb b :: 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 x :: String
x    -> String -> Result b
forall a. String -> Result a
Failure String
x
    Success    a :: a
a >>= f :: 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 s :: 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)
(.=) names :: Text
names func :: b
func = (Text -> [Text]
T.words Text
names, b
func)
  in
    [ -- encyclopedias
      "w wikipedia"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
wikipedia
    , "tvtropes"                Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
tvtropes
      -- social networks
    , "fb facebook"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
facebook
    , "vk vkontakte"            Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
vk
    , "gp gplus googleplus"     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
googleplus
    , "tg tme telegram"         Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
telegram
      -- microblogs
    , "t twitter"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
twitter
    , "juick"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
juick
      -- search engines
    , "google"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
google
    , "ddg duckduckgo"          Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
duckduckgo
    , "yandex"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
yandex
    , "baidu"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
baidu
      -- programming language libraries
        -- Haskell
    , "hackage hk" Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
hackage
    , "stackage"   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
stackage
    , "haskell hs" Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
haskell
    , "cabal"      Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cabal
        -- Others
    , "npm"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
npm
    , "jam"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
jam
    , "gem"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
rubygems
    , "pypi"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pypi
    , "cpan"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
metacpanPod
    , "cpan-r"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
metacpanRelease
    , "cargo"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cargo
    , "pub"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pub
    , "hex"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
hex
    , "cran"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
cran
    , "swiprolog"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
swiprolog
    , "dub"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
dub
    , "bpkg"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
bpkg
    , "pear"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
pear
      -- code hosting
    , "gh github"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
github
    , "gitlab"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
gitlab
    , "bitbucket"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
bitbucket
      -- OS
    , "gplay googleplay"        Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
googleplay
    , "chocolatey"              Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
chocolatey
    , "brew"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
brew
      -- OS – Linux
    , "debian"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
debian
    , "aur"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
aur
    , "mint"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
mint
    , "fedora"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
fedora
    , "gentoo"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
gentoo
    , "opensuse"                Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
opensuse
      -- text editors
    , "marmalade"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
marmalade
    , "melpa"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
melpa
    , "elpa"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
elpa
    , "sublimepc"               Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
packagecontrol
    , "atom"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
atomPackage
    , "atom-theme"              Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
atomTheme
    , "jedit"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
jedit
    , "vim"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
vim
      -- browsers
    , "opera"                   Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
operaExt
    , "opera-theme"             Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
operaTheme
    , "firefox"                 Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
firefox
    , "chrome"                  Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
chrome
      -- manuals
    , "ghc-ext"                 Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
ghcExt
      -- standards and databases
    , "rfc"                     Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
rfc
    , "ecma"                    Text -> Shortcut -> ([Text], Shortcut)
forall b. Text -> b -> ([Text], b)
.= Shortcut
ecma
    , "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 _ q :: 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
$ "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
$ "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 _ q :: 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
$ "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
$ "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 _ q :: 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
== '#' = 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 "{}/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
== '+' = 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
url ([Text] -> Text
T.concat (Text -> [Text]
T.words Text
q))
  where
    url :: Text
url = "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 _ q :: Text
q
    | Text -> Bool
T.null Text
q       = Text -> Result Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
url
    | Just ('@', username :: 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 = "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 _ q :: 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
== '#' = 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 "{}/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
== '@' = 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 = "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 _ q :: 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
== '*' = 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 "{}/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
== '@' = 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 = "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 _ q :: 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
$
  "https://google.com/search?nfpr=1&q=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces '+' 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 _ q :: 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
$ "https://duckduckgo.com/?q=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces '+' 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 _ q :: 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
$
  "http://yandex.ru/search/?noreask=1&text=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces '+' 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 _ q :: 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
$ "http://baidu.com/s?nojc=1&wd=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces '+' 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 _ q :: 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
$ "https://haskell.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
replaceSpaces '_' 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 _ q :: 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 "{}/package/{}" Text
hkUrl (Char -> Text -> Text
replaceSpaces '-' Text
q)
  where
    hkUrl :: Text
    hkUrl :: Text
hkUrl = "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 ltsNightly :: Maybe Text
ltsNightly q :: 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
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 "{}/{}/package/{}" Text
url Text
lts (Char -> Text -> Text
replaceSpaces '-' Text
q)
  where
    url :: Text
    url :: Text
url = "https://stackage.org"

    lts :: Text
    lts :: Text
lts = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "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 _ q :: 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
url (Char -> Text -> Text
replaceSpaces '-' Text
q)
  where
    url :: Text
    url :: Text
url = "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 mbOwner :: Maybe Text
mbOwner q :: Text
q = case Maybe Text
mbOwner of
  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 "https://github.com/{}" (Text -> Text
stripAt Text
q)
  Just owner :: 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 "https://github.com/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt x :: Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '@' 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 mbOwner :: Maybe Text
mbOwner q :: Text
q = case Maybe Text
mbOwner of
  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 "https://bitbucket.org/{}" (Text -> Text
stripAt Text
q)
  Just owner :: 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 "https://bitbucket.org/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt x :: Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '@' 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 mbOwner :: Maybe Text
mbOwner q :: Text
q = case Maybe Text
mbOwner of
  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 "https://gitlab.com/{}" (Text -> Text
stripAt Text
q)
  Just owner :: 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 "https://gitlab.com/{}/{}" (Text -> Text
stripAt Text
owner) Text
q
  where
    stripAt :: Text -> Text
stripAt x :: Text
x = if Text -> Char
T.head Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '@' 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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 mbDist :: Maybe Text
mbDist q :: 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 "https://packages.debian.org/{}/{}" Text
dist Text
q
  where
    dist :: Text
dist = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "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 _ q :: 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
$ "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 mbCat :: Maybe Text
mbCat q :: 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
$ "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
      Nothing  -> Text
q
      Just cat :: Text
cat -> Text
cat Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" 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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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 "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ q :: 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
$ "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 _ x :: 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 "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 "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 "no RFC number"
  let n' :: Text
n' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0') Text
n Text -> Text -> Text
forall a. (Eq a, Monoid a) => a -> a -> a
`orElse` "0"
  Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return ("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 _ q :: 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, isTR :: Bool
isTR) = case Text -> Text -> Maybe Text
stripPrefixCI "tr" Text
q of
        Nothing -> (Text -> Text -> Text
tryStripPrefixCI "ecma" Text
q, Bool
False)
        Just q' :: 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 "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 "no ECMA standard number"
  -- The number has to have at least 3 digits.
  let num :: Text
num = Int -> Char -> Text -> Text
T.justifyRight 3 '0' Text
mbNum
      url :: Text
url = "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 "{}/techreports/E-TR-{}.htm" Text
url Text
num
    else Text -> Text -> Text -> Text
forall r. FormatType r => Text -> r
format "{}/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 _ x :: 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 "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
>= 9) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
    String -> Result ()
warn "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
>= 9,
        (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit (Int -> Text -> Text
T.take 4 Text
n),
        Text -> Int -> Char
T.index Text
n 4 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-',
        (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit (Int -> Text -> Text
T.drop 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 "CVE-ID doesn't follow the <year>-<digits> format"
  Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return ("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 "en" -> Text
lang) q :: 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 "https://{}.wikipedia.org/wiki/{}" Text
lang Text
replacedQ
  where
    replacedQ :: Text
    replacedQ :: Text
replacedQ = Text -> Text
titleFirst (Char -> Text -> Text
replaceSpaces '_' 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 mbCat :: Maybe Text
mbCat q :: 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 "http://tvtropes.org/pmwiki/pmwiki.php/{}/{}" Text
cat (Text -> Text
camel Text
q)
  where
    isSep :: Char -> Bool
isSep c :: 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
/= '\''
    -- 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 "Main" Text -> Text
camel Maybe Text
mbCat