BlogLiterately 0.8.1.6 → 0.8.2

raw patch · 5 files changed

+230/−11 lines, 5 filesdep +HTTPdep +tagsoupdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HTTP, tagsoup

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• BlogLiterately.cabal +6/−4
• CHANGES.md +8/−0
• doc/BlogLiteratelyDoc.lhs +46/−0
• src/Text/BlogLiterately/Post.hs +17/−3
• src/Text/BlogLiterately/Transform.hs +153/−4

@@ -1,5 +1,5 @@ Name:           BlogLiterately-Version:        0.8.1.6+Version:        0.8.2 Synopsis:       A tool for posting Haskelly articles to blogs Description:    Write blog posts in Markdown format, then use BlogLiterately                 to do syntax highlighting, format ghci sessions, and upload@@ -26,7 +26,7 @@ Maintainer:     Brent Yorgey <byorgey@cis.upenn.edu> Stability:      experimental Build-Type:     Simple-Tested-With:    GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.1+Tested-With:    GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.1 Extra-Source-Files: CHANGES.md                     README.markdown                     doc/BlogLiteratelyDoc.lhs@@ -39,7 +39,7 @@   location: git://github.com/byorgey/BlogLiterately.git  Library-  Build-Depends:   base >= 4.0 && < 4.9,+  Build-Depends:   base >= 4.0 && < 4.10,                    process,                    filepath,                    directory,@@ -62,7 +62,9 @@                    pandoc-citeproc >= 0.1.2 && < 0.10,                    highlighting-kate >= 0.5 && < 0.7,                    data-default >= 0.5 && < 0.6,-                   lens >= 3.8 && < 4.14+                   lens >= 3.8 && < 4.14,+                   tagsoup >= 0.13.4 && < 0.14,+                   HTTP >= 4000.3 && < 4000.4   Exposed-modules: Text.BlogLiterately                    Text.BlogLiterately.Block                    Text.BlogLiterately.Ghci

@@ -1,3 +1,11 @@+0.8.2 (25 March 2016)+---------------------++  * New feature: support various types of "special links" which are+    automatically replaced with appropriate URLs.  Initial support for+    wikipedia links, Google "feeling lucky" search, and links to other+    posts on the same blog specified by ID or search term.+ 0.8.1.6 (22 March 2016) ----------------------- 

@@ -224,6 +224,52 @@ Note that an extra `$latex...` won't be added to the beginning of LaTeX expressions which already appear to be in WordPress format. +Special links+-------------++Certain special link types can be replaced with appropriate URLs.  A+special link is one where the URL is of the form `<name>::<text>`+where `<name>` is used to identify the special link type, and `<text>`+is passed as a parameter to a function which can use it to generate a+URL. Currently, four types of special links are supported by default+(and you can easily add your own):++`lucky::<search>`++:   The first Google result for `<search>`.++`wiki::<title>`++:   The Wikipedia page for `<title>`.  (Note that the page is not+    checked for existence.)++`post::nnnn`++:   Link to the blog post on your blog with post ID `nnnn`.  Note that+    this form of special link is invoked when `nnnn` consists of all+    digits, so it only works on blogs which use numerical identifiers for+    post IDs (as Wordpress does).++`post::<search>`++:   Link to the most recent blog post (among the+    20 most recent posts) containing `<search>` in its title.++For example, a post written in Markdown format containing++```+    This is a post about the game of [Go](wiki::Go (game)).+```++will be formatted in HTML as++```+    <p>This is a post about the game of <a href="https://en.wikipedia.org/wiki/Go%20(game)">Go</a>.</p>+```++You can easily add your own new types of special links.  See the+`SpecialLink` type and the `mkSpecialLinksXF` function.+ Table of contents ----------------- 

@@ -9,17 +9,20 @@ -- License     :  GPL (see LICENSE) -- Maintainer  :  Brent Yorgey <byorgey@gmail.com> ----- Uploading posts to the server.+-- Uploading posts to the server and fetching posts from the server. -- -----------------------------------------------------------------------------  module Text.BlogLiterately.Post     (-      mkPost, mkArray, postIt+      mkPost, mkArray, postIt, getPostURL, findTitle     ) where  import           Control.Lens                (at, makePrisms, to, traverse,-                                              (^.), (^?))+                                              (^.), (^..), (^?), _Just, _head)+import           Data.Char                   (toLower)+import           Data.Function               (on)+import           Data.List                   (isInfixOf) import qualified Data.Map                    as M  import           Network.XmlRpc.Client       (remote)@@ -104,6 +107,17 @@ getPostURL url pid usr pwd = do   v <- remote url "metaWeblog.getPost" pid usr pwd   return (v ^? _ValueStruct . to M.fromList . at "link" . traverse . _ValueString)++-- | Look at the last n posts and find the most recent whose title+--   contains the search term (case insensitive); return its permalink+--   URL.+findTitle :: Int -> String -> String -> String -> String -> IO (Maybe String)+findTitle numPrev url search usr pwd = do+  res <- remote url "metaWeblog.getRecentPosts" (0::Int) usr pwd numPrev+  let matches s = (isInfixOf `on` map toLower) search s+      posts  = res ^.. _ValueArray . traverse . _ValueStruct . to M.fromList+      posts' = filter (\p -> maybe False matches (p ^? at "title" . _Just . _ValueString)) posts+  return (posts' ^? _head . at "link" . _Just . _ValueString)  -- | Given a configuration and a formatted post, upload it to the server. postIt :: BlogLiterately -> String -> IO ()

@@ -1,6 +1,6 @@+ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TypeOperators     #-} @@ -35,6 +35,14 @@     , centerImagesXF     , citationsXF +      -- * Link generation+    , specialLinksXF+    , mkSpecialLinksXF+    , standardSpecialLinks+    , luckyLink+    , wikiLink+    , postLink+       -- * Transforms     , Transform(..), pureTransform, ioTransform, runTransform, runTransforms @@ -51,12 +59,18 @@                                                     (.=), (.~), (^.), _1, _2,                                                     _Just) import           Control.Monad.State-import           Data.List                         (intercalate, isPrefixOf)+import           Data.Char                         (isDigit, toLower)+import           Data.List                         (intercalate, isInfixOf,+                                                    isPrefixOf)+import           Data.List.Split                   (splitOn) import qualified Data.Map                          as M+import           Data.Maybe                        (fromMaybe) import           Data.Monoid                       (mappend) import           Data.Monoid                       (mempty, (<>)) import qualified Data.Set                          as S import           Data.Traversable                  (traverse)+import           Network.HTTP                      (getRequest, getResponseBody,+                                                    simpleHTTP) import           System.Directory                  (doesFileExist,                                                     getAppUserDataDirectory) import           System.Exit                       (exitFailure)@@ -64,6 +78,7 @@ import           System.IO                         (hFlush, stdout) import           Text.Blaze.Html.Renderer.String   (renderHtml) import           Text.CSL.Pandoc                   (processCites')+import           Text.HTML.TagSoup import           Text.Pandoc import           Text.Pandoc.Error                 (PandocError) import           Text.Parsec                       (ParseError)@@ -78,6 +93,7 @@ import           Text.BlogLiterately.LaTeX         (wpTeXify) import           Text.BlogLiterately.Options import           Text.BlogLiterately.Options.Parse (readBLOptions)+import           Text.BlogLiterately.Post          (findTitle, getPostURL)  -- | A document transformation consists of two parts: an actual --   transformation, expressed as a function over Pandoc documents, and@@ -177,12 +193,142 @@   where     centerImage :: [Block] -> [Block]     centerImage (img@(Para [Image _attr _altText (_imgUrl, _imgTitle)]) : bs) =-        RawBlock "html" "<div style=\"text-align: center;\">"+        RawBlock (Format "html") "<div style=\"text-align: center;\">"       : img-      : RawBlock "html" "</div>"+      : RawBlock (Format "html") "</div>"       : bs     centerImage bs = bs +-- | Replace special links with appropriate URLs.  Currently, four+--   types of special links are supported:+--+--   [@lucky::<search>@] The first Google result for @<search>@.+--+--   [@wiki::<title>@] The Wikipedia page for @<title>@.  Note that+--   the page is not checked for existence.+--+--   [@post::nnnn@] Link to the blog post with post ID @nnnn@.  Note+--   that this form of special link is invoked when @nnnn@ consists of+--   all digits, so it only works on blogs which use numerical+--   identifiers for post IDs (as Wordpress does).+--+--   [@post::<search>@] Link to the most recent blog post (among the+--   20 most recent posts) containing @<search>@ in its title.+--+--   For example, a post written in Markdown format containing+--+--   @+--       This is a post about the game of [Go](wiki::Go (game)).+--   @+--+--   will be formatted in HTML as+--+--   @+--       <p>This is a post about the game of <a href="https://en.wikipedia.org/wiki/Go%20(game)">Go</a>.</p>+--   @+--+--   You can also create a Transform with your own special link types,+--   using 'mkSpecialLinksXF', and I am happy to receive pull requests+--   adding new types of standard special links.+specialLinksXF :: Transform+specialLinksXF = mkSpecialLinksXF standardSpecialLinks++-- | The standard special link types included in 'specialLinksXF':+--   'luckyLink', 'wikiLink', and 'postLink'.+standardSpecialLinks :: [SpecialLink]+standardSpecialLinks = [luckyLink, wikiLink, postLink]++-- | A special link consists of two parts:+--+--   * An identifier string.  If the identifier string is @<id>@, this+--   will trigger for links which are of the form @<id>::XXXX@.+--+--   * A URL generation function.  It takes as input the string+--   following the @::@ (the @XXXX@ in the example above), the+--   configuration record, and must output a URL.+--+--   For example,+--+--   @("twitter", \u _ -> return $ "https://twitter.com/" ++ u)@+--+--   is a simple 'SpecialLink' which causes links of the form+--   @twitter::user@ to be replaced by @https://twitter.com/user@.+type SpecialLink = (String, String -> BlogLiterately -> IO String)++-- | Create a transformation which looks for the given special links+--   and replaces them appropriately. You can use this function with+--   your own types of special links.+mkSpecialLinksXF :: [SpecialLink] -> Transform+mkSpecialLinksXF links = ioTransform (specialLinks links) (const True)++-- | Create a document transformation which looks for the given+--   special links and replaces them appropriately.+specialLinks :: [SpecialLink] -> BlogLiterately -> Pandoc -> IO Pandoc+specialLinks links bl = bottomUpM specialLink+  where+    specialLink :: Inline -> IO Inline+    specialLink i@(Link attrs alt (url, title))+      | Just (typ, target) <- getSpecial url+      = mkLink <$> case lookup (map toLower typ) links of+                     Just mkURL -> mkURL target bl+                     Nothing    -> return target+      where+        mkLink u = Link attrs alt (u, title)++    specialLink i = return i++    getSpecial url+      | "::" `isInfixOf` url =+          let (typ:rest) = splitOn "::" url+          in  Just (typ, intercalate "::" rest)+      | otherwise = Nothing++-- | Turn @lucky::<search>@ into a link to the first Google result for+-- @<search>@.+luckyLink :: SpecialLink+luckyLink = ("lucky", getLucky)+  where+    getLucky searchTerm _ = do+      results <- openURL $ "http://www.google.com/search?q=" ++ searchTerm+      let tags   = parseTags results+          anchor = take 1 . dropWhile (~/= "<a>") . dropWhile (~/= "<h3 class='r'>") $ tags+          url = case anchor of+            [t@(TagOpen{})] -> takeWhile (/='&') . dropWhile (/='h') . fromAttrib "href" $ t+            _ -> searchTerm+      return url++-- | Get the contents of the given URL in a simple way.+openURL :: String -> IO String+openURL x = getResponseBody =<< simpleHTTP (getRequest x)++-- | Given @wiki::<title>@, generate a link to the Wikipedia page for+--   @<title>@.  Note that the page is not checked for existence.+wikiLink :: SpecialLink+wikiLink = ("wiki", \target _ -> return $ "https://en.wikipedia.org/wiki/" ++ target)++-- | @postLink@ handles two types of special links.+--+-- [@post::nnnn@] Link to the blog post with post ID @nnnn@.  Note that+-- this form of special link is invoked when @nnnn@ consists of all+-- digits, so it only works on blogs which use numerical identifiers+-- for post IDs (as Wordpress does).+--+-- [@post::<search>@] Link to the most recent blog post (among the+-- 20 most recent posts) containing @<search>@ in its title.+postLink :: SpecialLink+postLink = ("post", getPostLink)+  where+    getPostLink target bl =+      fromMaybe target <$>+        case (all isDigit target, bl ^. blog) of+          (_    , Nothing ) -> return Nothing+          (True , Just url) -> getPostURL url target (user' bl) (password' bl)+          (False, Just url) -> findTitle 20 url target (user' bl) (password' bl)++          -- If all digits, replace with permalink for that postid+          -- Otherwise, search titles of 20 most recent posts.+          --   Choose most recent that matches.+ -- | Potentially extract a title from the metadata block, and set it --   in the options record. titleXF :: Transform@@ -295,6 +441,8 @@ -- --   * 'centerImagesXF': center images occurring in their own paragraph --+--   * 'specialLinksXF': replace special link types with URLs+-- --   * 'highlightOptsXF': load the requested highlighting style file -- --   * 'highlightXF': perform syntax highlighting@@ -318,6 +466,7 @@   , ghciXF   , uploadImagesXF   , centerImagesXF+  , specialLinksXF   , highlightOptsXF   , highlightXF   , citationsXF