diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,17 @@ `shortcut-links` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.5.1.0 — May 6, 2020 + +* [#10](https://github.com/kowainik/colourista/issues/10): + Support GHC-8.10.1. Move to support of GHC-8.8.3 instead of 8.8.1. +* [#9](https://github.com/kowainik/colourista/issues/9): + Add more Haskell shortcuts: `hackage`, `stackage`, `haskell` and `cabal`. +* [#1](https://github.com/kowainik/colourista/issues/1): + Add `telegram` shortcut links. +* [#3](https://github.com/kowainik/colourista/issues/3): + Treat `#` correctly in wikipedia links. + ## 0.5.0.0 - Dec 26, 2019 * Support GHC-8.8.1. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ # shortcut-links +[![GitHub CI](https://github.com/kowainik/colourista/workflows/CI/badge.svg)](https://github.com/kowainik/colourista/actions) [![Travis CI](https://img.shields.io/travis/kowainik/shortcut-links.svg?logo=travis)](https://travis-ci.org/kowainik/shortcut-links) [![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/shortcut-links?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/shortcut-links) [![Hackage](https://img.shields.io/hackage/v/shortcut-links.svg?logo=haskell)](https://hackage.haskell.org/package/shortcut-links) diff --git a/shortcut-links.cabal b/shortcut-links.cabal --- a/shortcut-links.cabal +++ b/shortcut-links.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: shortcut-links -version: 0.5.0.0 +version: 0.5.1.0 synopsis: Link shortcuts for use in text markup description: This package is a database of link shortcuts. A Markdown example: @@ -23,19 +23,15 @@ tested-with: GHC == 8.2.2 GHC == 8.4.4 GHC == 8.6.5 - GHC == 8.8.1 + GHC == 8.8.3 + GHC == 8.10.1 source-repository head type: git location: git://github.com/kowainik/shortcut-links.git -library - hs-source-dirs: src - exposed-modules: ShortcutLinks - ShortcutLinks.All - ShortcutLinks.Utils - build-depends: base >= 4.5 && < 4.14 - , text >= 1.1 && < 1.3 +common common-options + build-depends: base >= 4.10 && < 4.15 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates @@ -43,12 +39,32 @@ -Widentities -Wredundant-constraints -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields if impl(ghc >= 8.8.1) ghc-options: -Wmissing-deriving-strategies -Werror=missing-deriving-strategies - + if impl(ghc >= 8.10.1) + ghc-options: -Wunused-packages + default-language: Haskell2010 default-extensions: DerivingStrategies InstanceSigs OverloadedStrings + ViewPatterns - default-language: Haskell2010 +library + import: common-options + hs-source-dirs: src + exposed-modules: ShortcutLinks + ShortcutLinks.All + ShortcutLinks.Utils + build-depends: text >= 1.1 && < 1.3 + +test-suite shortcut-links-doctest + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Doctest.hs + build-depends: doctest ^>= 0.16 + ghc-options: -threaded diff --git a/src/ShortcutLinks/All.hs b/src/ShortcutLinks/All.hs --- a/src/ShortcutLinks/All.hs +++ b/src/ShortcutLinks/All.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE ViewPatterns #-} {- | Copyright: (c) 2015-2019 Aelve @@ -22,6 +21,7 @@ , facebook , vk , googleplus + , telegram -- * Microblogs , twitter @@ -34,13 +34,18 @@ , baidu -- * Programming language libraries + -- ** Haskell + , haskell + , hackage + , stackage + , cabal + -- ** Other , npm , jam , rubygems , pypi , metacpanPod , metacpanRelease - , hackage , cargo , pub , hex @@ -50,6 +55,7 @@ , bpkg , pear + -- * Code hosting , github , gitlab @@ -95,18 +101,23 @@ , cve ) where -import Control.Monad (ap, unless, when) +import Control.Monad (unless, when) import Data.Char (isAlphaNum, isDigit, isPunctuation, isSpace) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isNothing) import Data.Semigroup ((<>)) import Data.Text (Text) -import ShortcutLinks.Utils (format, orElse, replaceSpaces, stripPrefixCI, titleFirst, +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 @@ -114,104 +125,126 @@ deriving stock (Show, Functor) instance Applicative Result where - pure = return - (<*>) = ap + pure :: a -> Result a + pure = Success + (<*>) :: Result (a -> b) -> Result a -> Result b + Failure x <*> _ = Failure x + Warning wf f <*> s = case s of + Success a -> Warning wf (f a) + Warning wa a -> Warning (wf <> wa) (f a) + Failure x -> Failure x + Success f <*> a = f <$> a + instance Monad Result where #if !(MIN_VERSION_base(4,13,0)) - fail = Fail.fail + fail :: String -> Result a + fail = Fail.fail #endif - return = Success - Failure x >>= _ = Failure x - Warning wa a >>= f = case f a of - Success b -> Warning wa b - Warning wb b -> Warning (wa ++ wb) b - Failure x -> Failure x - Success a >>= f = f a + return :: a -> Result a + return = pure + (>>=) :: Result a -> (a -> Result b) -> Result b + Failure x >>= _ = Failure x + Warning wa a >>= f = case f a of + Success b -> Warning wa b + Warning wb b -> Warning (wa ++ wb) b + Failure x -> Failure x + Success a >>= f = f a + instance Fail.MonadFail Result where + fail :: String -> Result a fail = Failure +-- | Create a unit 'Warning' with a single warning message warn :: String -> Result () warn s = Warning [s] () +-- | Type alias for shortcut links 'Result' functions. type Shortcut = Maybe Text -> Text -> Result Text -{- | -A list of all functions included in this module, together with suggested names for them. +{- | A list of all functions included in this module, together with suggested +names for them. -} allShortcuts :: [([Text], Shortcut)] allShortcuts = -- When changing something here, don't forget to update the description for -- the corresponding shortcut. let (.=) names func = (T.words names, func) - in [ - -- encyclopedias - "w wikipedia" .= wikipedia, - "tvtropes" .= tvtropes, - -- social networks - "fb facebook" .= facebook, - "vk vkontakte" .= vk, - "gp gplus googleplus" .= googleplus, - -- microblogs - "t twitter" .= twitter, - "juick" .= juick, - -- search engines - "google" .= google, - "ddg duckduckgo" .= duckduckgo, - "yandex" .= yandex, - "baidu" .= baidu, - -- programming language libraries - "npm" .= npm, - "jam" .= jam, - "gem" .= rubygems, - "pypi" .= pypi, - "cpan" .= metacpanPod, - "cpan-r" .= metacpanRelease, - "hackage" .= hackage, - "cargo" .= cargo, - "pub" .= pub, - "hex" .= hex, - "cran" .= cran, - "swiprolog" .= swiprolog, - "dub" .= dub, - "bpkg" .= bpkg, - "pear" .= pear, - -- code hosting - "gh github" .= github, - "gitlab" .= gitlab, - "bitbucket" .= bitbucket, - -- OS - "gplay googleplay" .= googleplay, - "chocolatey" .= chocolatey, - "brew" .= brew, - -- OS – Linux - "debian" .= debian, - "aur" .= aur, - "mint" .= mint, - "fedora" .= fedora, - "gentoo" .= gentoo, - "opensuse" .= opensuse, - -- text editors - "marmalade" .= marmalade, - "melpa" .= melpa, - "elpa" .= elpa, - "sublimepc" .= packagecontrol, - "atom" .= atomPackage, - "atom-theme" .= atomTheme, - "jedit" .= jedit, - "vim" .= vim, - -- browsers - "opera" .= operaExt, - "opera-theme" .= operaTheme, - "firefox" .= firefox, - "chrome" .= chrome, - -- manuals - "ghc-ext" .= ghcExt, - -- standards and databases - "rfc" .= rfc, - "ecma" .= ecma, - "cve" .= cve ] + in + [ -- encyclopedias + "w wikipedia" .= wikipedia + , "tvtropes" .= tvtropes + -- social networks + , "fb facebook" .= facebook + , "vk vkontakte" .= vk + , "gp gplus googleplus" .= googleplus + , "tg tme telegram" .= telegram + -- microblogs + , "t twitter" .= twitter + , "juick" .= juick + -- search engines + , "google" .= google + , "ddg duckduckgo" .= duckduckgo + , "yandex" .= yandex + , "baidu" .= baidu + -- programming language libraries + -- Haskell + , "hackage hk" .= hackage + , "stackage" .= stackage + , "haskell hs" .= haskell + , "cabal" .= cabal + -- Others + , "npm" .= npm + , "jam" .= jam + , "gem" .= rubygems + , "pypi" .= pypi + , "cpan" .= metacpanPod + , "cpan-r" .= metacpanRelease + , "cargo" .= cargo + , "pub" .= pub + , "hex" .= hex + , "cran" .= cran + , "swiprolog" .= swiprolog + , "dub" .= dub + , "bpkg" .= bpkg + , "pear" .= pear + -- code hosting + , "gh github" .= github + , "gitlab" .= gitlab + , "bitbucket" .= bitbucket + -- OS + , "gplay googleplay" .= googleplay + , "chocolatey" .= chocolatey + , "brew" .= brew + -- OS – Linux + , "debian" .= debian + , "aur" .= aur + , "mint" .= mint + , "fedora" .= fedora + , "gentoo" .= gentoo + , "opensuse" .= opensuse + -- text editors + , "marmalade" .= marmalade + , "melpa" .= melpa + , "elpa" .= elpa + , "sublimepc" .= packagecontrol + , "atom" .= atomPackage + , "atom-theme" .= atomTheme + , "jedit" .= jedit + , "vim" .= vim + -- browsers + , "opera" .= operaExt + , "opera-theme" .= operaTheme + , "firefox" .= firefox + , "chrome" .= chrome + -- manuals + , "ghc-ext" .= ghcExt + -- standards and databases + , "rfc" .= rfc + , "ecma" .= ecma + , "cve" .= cve + ] {- | (shortcut: “fb” or “facebook”) @@ -296,11 +329,45 @@ googleplus _ q | T.null q = return url | T.head q == '#' = return $ format "{}/explore/{}" url (T.tail q) - | T.head q == '+' = return $ format "{}/{}" url q - | T.all isDigit q = return $ format "{}/{}" url q + | T.head q == '+' = return $ formatSlash url q + | T.all isDigit q = return $ formatSlash url q | otherwise = return $ format "{}/+{}" url (T.concat (T.words q)) - where url = "https://plus.google.com" + where + url = "https://plus.google.com" +{- | (shortcut: "tg", "tme" or "telegram") + +Link by username: + +@ +\[Kowainik telegram channel\](\@t:kowainik) + +@ + + +It's alright if the username already starts with a “\@”: + +@ +\[\@kowainik\](\@t) + +@ + +>>> useShortcut "telegram" Nothing "" +Success "https://t.me" +>>> useShortcut "tme" Nothing "@kowainik" +Success "https://t.me/kowainik" +>>> useShortcut "telegram" Nothing "kowainik" +Success "https://t.me/kowainik" +-} +telegram :: Shortcut +telegram _ q + | T.null q = pure url + | Just ('@', username) <- T.uncons q = pure $ formatSlash url username + | otherwise = pure $ formatSlash url q + where + url :: Text + url = "https://t.me" + {- | (shortcut: “t” or “twitter”) Link by username: @@ -328,8 +395,8 @@ twitter _ q | T.null q = return url | T.head q == '#' = return $ format "{}/hashtag/{}" url (T.tail q) - | T.head q == '@' = return $ format "{}/{}" url (T.tail q) - | otherwise = return $ format "{}/{}" url q + | T.head q == '@' = return $ formatSlash url (T.tail q) + | otherwise = return $ formatSlash url q where url = "https://twitter.com" {- | (shortcut: “juick”) @@ -359,8 +426,8 @@ juick _ q | T.null q = return url | T.head q == '*' = return $ format "{}/tag/{}" url (T.tail q) - | T.head q == '@' = return $ format "{}/{}" url (T.tail q) - | otherwise = return $ format "{}/{}" url q + | T.head q == '@' = return $ formatSlash url (T.tail q) + | otherwise = return $ formatSlash url q where url = "https://juick.com" {- | (shortcut: “google”) @@ -413,6 +480,105 @@ baidu :: Shortcut baidu _ q = return $ "http://baidu.com/s?nojc=1&wd=" <> replaceSpaces '+' q +---------------------------------------------------------------------------- +-- Haskell +---------------------------------------------------------------------------- + +{- | __Haskell__ – (shortcut: “haskell hs”) + +Link to ghcup: + +@ +\[ghcup\](\@haskell) + +@ + +>>> useShortcut "haskell" Nothing "" +Success "https://haskell.org/" +>>> useShortcut "hs" Nothing "ghcup" +Success "https://haskell.org/ghcup" +-} +haskell :: Shortcut +haskell _ q = pure $ "https://haskell.org/" <> replaceSpaces '_' q + + +{- | __Haskell__ – (shortcut: “hackage hk”) + +Link to a package: + +@ +\[shortcut-links\](\@hackage) + +@ + +>>> useShortcut "hackage" Nothing "" +Success "https://hackage.haskell.org" +>>> useShortcut "hk" Nothing "shortcut-links" +Success "https://hackage.haskell.org/package/shortcut-links" + +-} +hackage :: Shortcut +hackage _ q + | T.null q = pure hkUrl + | otherwise = pure $ format "{}/package/{}" hkUrl (replaceSpaces '-' q) + where + hkUrl :: Text + hkUrl = "https://hackage.haskell.org" + +{- | __Haskell__ – (shortcut: “stackage”) + +Link to a package: + +@ +\[colourista\](\@stackage) + +@ + +>>> useShortcut "stackage" Nothing "" +Success "https://stackage.org" +>>> useShortcut "stackage" (Just "nightly") "" +Success "https://stackage.org/nightly" +>>> useShortcut "stackage" (Just "lts") "" +Success "https://stackage.org/lts" +>>> useShortcut "stackage" (Just "lts-15.0") "" +Success "https://stackage.org/lts-15.0" +>>> useShortcut "stackage" Nothing "colourista" +Success "https://stackage.org/lts/package/colourista" +>>> useShortcut "stackage" (Just "nightly") "colourista" +Success "https://stackage.org/nightly/package/colourista" +>>> useShortcut "stackage" (Just "lts-15.10") "colourista" +Success "https://stackage.org/lts-15.10/package/colourista" +-} +stackage :: Shortcut +stackage ltsNightly q + | T.null q && isNothing ltsNightly = pure url + | T.null q = pure $ format "{}/{}" url lts + | otherwise = pure $ format "{}/{}/package/{}" url lts (replaceSpaces '-' q) + where + url :: Text + url = "https://stackage.org" + + lts :: Text + lts = fromMaybe "lts" ltsNightly + +{- | __Haskell__ – (shortcut: “cabal”) + +Link to the intoduction package: + +@ +\[intro.html\](\@hackage) + +@ + +>>> useShortcut "cabal" Nothing "intro.html" +Success "https://haskell.org/cabal/users-guide/intro.html" +-} +cabal :: Shortcut +cabal _ q = pure $ format "{}/{}" url (replaceSpaces '-' q) + where + url :: Text + url = "https://haskell.org/cabal/users-guide" + {- | __Node.js__ – (shortcut: “npm”) Link to a package: @@ -487,18 +653,6 @@ metacpanRelease :: Shortcut metacpanRelease _ q = return $ "https://metacpan.org/release/" <> q -{- | __Haskell__ – (shortcut: “hackage”) - -Link to a package: - -@ -\[cmark\](\@hackage) - -@ --} -hackage :: Shortcut -hackage _ q = return $ "https://hackage.haskell.org/package/" <> q - {- | __Rust__ – (shortcut: “cargo”) Link to a package: @@ -1076,13 +1230,28 @@ \[Haskell\](\@w(ru)) @ + + +>>> useShortcut "wikipedia" Nothing "" +Success "https://en.wikipedia.org/wiki/" +>>> useShortcut "w" (Just "ru") "" +Success "https://ru.wikipedia.org/wiki/" +>>> useShortcut "wikipedia" Nothing "Query" +Success "https://en.wikipedia.org/wiki/Query" +>>> useShortcut "w" Nothing "multiple words query" +Success "https://en.wikipedia.org/wiki/Multiple_words_query" +>>> useShortcut "wikipedia" Nothing "grey-headed flying fox" +Success "https://en.wikipedia.org/wiki/Grey-headed_flying_fox" + +>>> useShortcut "w" Nothing "pattern matching#primitive patterns" +Success "https://en.wikipedia.org/wiki/Pattern_matching#Primitive_patterns" -} wikipedia :: Shortcut -wikipedia mbLang q = return $ - format "https://{}.wikipedia.org/wiki/{}" lang q' +wikipedia (fromMaybe "en" -> lang) q = pure $ + format "https://{}.wikipedia.org/wiki/{}" lang replacedQ where - lang = fromMaybe "en" mbLang - q' = titleFirst (replaceSpaces '_' q) + replacedQ :: Text + replacedQ = titleFirst (replaceSpaces '_' q) {- | (shortcut: “tvtropes”) diff --git a/src/ShortcutLinks/Utils.hs b/src/ShortcutLinks/Utils.hs --- a/src/ShortcutLinks/Utils.hs +++ b/src/ShortcutLinks/Utils.hs @@ -16,6 +16,7 @@ , stripPrefixCI , orElse , format + , formatSlash ) where import Data.Char (isSpace, toUpper) @@ -43,9 +44,12 @@ as “Ss”, which is a redirect to “Schutzstaffel”. -} titleFirst :: Text -> Text -titleFirst s = case T.uncons s of - Nothing -> "" - Just (c, rest) -> toUpper c `T.cons` rest +titleFirst = T.intercalate "#" . map title . T.splitOn "#" + where + title :: Text -> Text + title s = case T.uncons s of + Nothing -> "" + Just (c, rest) -> toUpper c `T.cons` rest {- | Strip given prefix from a string, or do nothing if the string doesn't have given prefix. @@ -126,3 +130,6 @@ -} format :: FormatType r => Text -> r format str = format' str [] + +formatSlash :: FormatType r => r +formatSlash = format "{}/{}" diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1,28 @@ +{- +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +DocTest's run function to keep docs up to date. +-} + +module Main (main) where + +import Test.DocTest (doctest) + + +main :: IO () +main = doctest + $ "-XDeriveAnyClass" + : "-XDeriveGeneric" + : "-XDerivingStrategies" + : "-XGeneralizedNewtypeDeriving" + : "-XInstanceSigs" + : "-XLambdaCase" + : "-XOverloadedStrings" + : "-XViewPatterns" + : "-XRecordWildCards" + : "-XScopedTypeVariables" + : "-XTypeApplications" + : [ "src/ShortcutLinks/All.hs" + ]