hakyll-convert 0.2.0.0 → 0.3.0.1
raw patch · 25 files changed
+2089/−623 lines, 25 filesdep +datetimedep +tastydep +tasty-expected-failuredep −binarydep −hakylldep −xmldep ~basedep ~bytestringdep ~cmdargssetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: datetime, tasty, tasty-expected-failure, tasty-golden, tasty-hunit, tasty-quickcheck, temporary, xml-conduit, xml-types
Dependencies removed: binary, hakyll, xml
Dependency ranges changed: base, bytestring, cmdargs, containers, data-default, directory, feed, filepath, text, time
API changes (from Hackage documentation)
+ Hakyll.Convert.Blogger: instance GHC.Show.Show Hakyll.Convert.Blogger.FullPost
+ Hakyll.Convert.IO: savePost :: FilePath -> Text -> Text -> DistilledPost -> IO FilePath
- Hakyll.Convert.Blogger: FullPost :: Entry -> [Entry] -> String -> FullPost
+ Hakyll.Convert.Blogger: FullPost :: Entry -> [Entry] -> Text -> FullPost
- Hakyll.Convert.Blogger: [fpUri] :: FullPost -> String
+ Hakyll.Convert.Blogger: [fpUri] :: FullPost -> Text
- Hakyll.Convert.Common: DistilledPost :: String -> Text -> Maybe Text -> [Text] -> [Text] -> UTCTime -> DistilledPost
+ Hakyll.Convert.Common: DistilledPost :: Text -> Text -> Maybe Text -> [Text] -> [Text] -> UTCTime -> DistilledPost
- Hakyll.Convert.Common: [dpUri] :: DistilledPost -> String
+ Hakyll.Convert.Common: [dpUri] :: DistilledPost -> Text
- Hakyll.Convert.Wordpress: distill :: RSSItem -> DistilledPost
+ Hakyll.Convert.Wordpress: distill :: Bool -> RSSItem -> DistilledPost
Files
- CHANGELOG.md +21/−0
- Hakyll/Convert/Blogger.hs +0/−229
- Hakyll/Convert/Common.hs +0/−35
- Hakyll/Convert/OutputFormat.hs +0/−89
- Hakyll/Convert/Wordpress.hs +0/−79
- LICENSE +1/−0
- Setup.hs +1/−0
- app/hakyll-convert.hs +98/−0
- hakyll-convert.cabal +118/−47
- src/Hakyll/Convert/Blogger.hs +242/−0
- src/Hakyll/Convert/Common.hs +35/−0
- src/Hakyll/Convert/IO.hs +47/−0
- src/Hakyll/Convert/OutputFormat.hs +108/−0
- src/Hakyll/Convert/Wordpress.hs +141/−0
- test/golden/Golden/Blogger.hs +51/−0
- test/golden/Golden/GoldenTestHelpers.hs +49/−0
- test/golden/Golden/IO.hs +72/−0
- test/golden/Golden/Wordpress.hs +38/−0
- test/golden/Main.hs +18/−0
- test/spec/Main.hs +18/−0
- test/spec/Spec/Blogger.hs +449/−0
- test/spec/Spec/IO.hs +43/−0
- test/spec/Spec/OutputFormat.hs +157/−0
- test/spec/Spec/Wordpress.hs +382/−0
- tools/hakyll-convert.hs +0/−144
+ CHANGELOG.md view
@@ -0,0 +1,21 @@+## 0.3.0.1++### Added+- CHANGELOG.md is now part of sdist tarball.+- Cabal file now puts halyll-convert under "Tools" category.++### Fixed+- Version number in the Cabal file.+++## 0.3.0.0++### Added+- New function, `IO.savePost`, that writes a given post onto the disk, complete+ with a "front matter" understood by Hakyll.++### Changed+- Use `Text` instead of `String` in all public interfaces.++### Fixed+- Comments in modern Blogger backups work again.
− Hakyll/Convert/Blogger.hs
@@ -1,229 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-module Hakyll.Convert.Blogger- (FullPost(..), readPosts, distill)- where--import Control.Applicative-import Control.Arrow-import Control.Monad-import Data.Binary-import qualified Data.ByteString as B-import Data.Char-import Data.Data-import Data.Function-import Data.List-import Data.List-import Data.Maybe-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Time (UTCTime)-import Data.Time.Format (parseTimeM, defaultTimeLocale)--import Hakyll.Core.Compiler-import Hakyll.Core.Item-import Hakyll.Web.Template.Context-import Text.Atom.Feed-import Text.Atom.Feed.Export-import Text.Atom.Feed.Import-import Text.XML.Light--import Hakyll.Convert.Common---- | A post and its comments-data FullPost = FullPost- { fpPost :: Entry- , fpComments :: [Entry]- , fpUri :: String- }---- | An entry is assumed to be either a post, or a comment.--- If it's a post, it should be associated with the URI--- that visitors would use to read the post (on the old blog)--- If it's a comment, it should be the URI for the corresponding--- post.-data BloggerEntry =- Post { beUri_ :: String, beEntry :: Entry }- | Comment { beUri_ :: String, beEntry :: Entry }- | Orphan { beEntry :: Entry }- deriving (Show)--beUri :: BloggerEntry -> Maybe String-beUri (Orphan _) = Nothing-beUri (Post u _) = Just u-beUri (Comment u _) = Just u---- ------------------------------------------------------------------------ Feed to helper type--- ------------------------------------------------------------------------- | Returns only published posts-readPosts :: FilePath -> IO (Maybe [FullPost])-readPosts f = do- parseAtomDoc <$> B.readFile f- where- parseAtomDoc x =- select =<< parseXMLDoc (T.decodeUtf8 x)- select =- fmap (extractPosts . feedEntries) . elementFeed . deleteDrafts---- has to be done on the XML level as our atom lib doesn't understand--- the blogger-specific XML for drafts-deleteDrafts :: Element -> Element-deleteDrafts e =- e { elContent = filter isInnocent (elContent e) }- where- isInnocent (Elem e) = not (isDraft e)- isInnocent _ = True--isDraft :: Element -> Bool-isDraft e =- isJust $ findElement draft e- where- draft = QName- { qName = "draft"- , qURI = Just "http://purl.org/atom/app#"- , qPrefix = Just "app"- }------ | Warning: this silently ignores orphans, templates, settings-extractPosts :: [Entry] -> [FullPost]-extractPosts entries =- map toFullPost blocks- where- toFullPost (uri, entries) = FullPost- { fpPost = post- , fpComments = comments- , fpUri = uri- }- where- post = case [ e | Post _ e <- entries ] of- [] -> huh "Block of entries with no post?!"- [p] -> p- ps -> huh "Block of entries with more than one post?!"- comments = [ e | Comment _ e <- entries ]- huh msg = error . unlines $ msg : map (txtToString . entryTitle . beEntry) entries- blocks = [ (u,xs) | (Just u, xs) <- blocks_ ] -- drop orphans- blocks_ = buckets beUri- $ map identifyEntry- $ filter isInteresting entries---- | Contains actual meat (posts, comments; but not eg. templates)-isInteresting :: Entry -> Bool-isInteresting e =- not $ any isBoring cats- where- isBoring c = any (\t -> isBloggerCategoryOfType t c) ["settings", "template"]- cats = entryCategories e----- | Tag an entry from the blogger feed as either being a post,--- a comment, or an "orphan" (a comment without an associated post)-identifyEntry :: Entry -> BloggerEntry-identifyEntry e =- if isPost e- then case getLink "self" `mplus` getLink "alternate" of- Just l -> Post (postUrl l) e- Nothing -> entryError e oopsSelf- else case getLink "alternate" of- Just l -> Comment (postUrl l) e- Nothing -> Orphan e- where- isPost = any (isBloggerCategoryOfType "post") . entryCategories- postUrl = takeWhile (/= '?') . linkHref- getLink ty = case filter (isLink ty) $ entryLinks e of- [] -> Nothing- [x] -> Just x- xs -> entryError e (oopsLink ty)- isLink ty l = linkRel l == Just (Right ty) && linkType l == Just "text/html"- oopsSelf = "Was expecting blog posts to have a self link"- oopsLink ty = "Was expecting entries have at most one link of type " ++ ty--isBloggerCategory :: Category -> Bool-isBloggerCategory = (== Just "http://schemas.google.com/g/2005#kind")- . catScheme--isBloggerCategoryOfType :: String -- ^ \"comment\", \"post\", etc- -> Category- -> Bool-isBloggerCategoryOfType ty c =- isBloggerCategory c &&- catTerm c == "http://schemas.google.com/blogger/2008/kind#" ++ ty---- --------------------------------------------------------------------------- -----------------------------------------------------------------------distill :: Bool -> FullPost -> DistilledPost-distill extractComments fp = DistilledPost- { dpBody = body fpost- , dpUri = fpUri fp- , dpTitle = title fpost- , dpTags = tags fpost- , dpCategories = []- , dpDate = date fpost- }- where- fpost = fpPost fp- fcomments = fpComments fp- --- body post =- let article = fromContent $ entryContent post- comments = T.intercalate "\n" $ map formatComment fcomments- in if extractComments- then T.intercalate "\n"- [ article- , ""- , "<h3 id='hakyll-convert-comments-title'>Comments</h3>"- , comments]- else article-- fromContent (Just (HTMLContent x)) = T.pack x- fromContent _ = error "Hakyll.Convert.Blogger.distill expecting HTML"-- formatComment c = T.intercalate "\n" [- "<div class='hakyll-convert-comment'>"- , T.concat [ "<p class='hakyll-convert-comment-date'>"- , "On ", pubdate, ", ", author, " wrote:"- , "</p>" ]- , "<div class='hakyll-convert-comment-body'>", comment, "</div>"- , "</div>"- ]- where- pubdate = case entryPublished c of- Just d -> T.pack d- Nothing -> "unknown date"- author = T.unwords $ map (T.pack . personName) (entryAuthors c)- comment = fromContent $ entryContent c- --- title p = case txtToString (entryTitle p) of- "" -> Nothing- t -> Just (T.pack t)- tags = map (T.pack . catTerm)- . filter (not . isBloggerCategory)- . entryCategories- date x = case parseTime' =<< entryPublished x of- Nothing -> fromJust $ parseTime' "1970-01-01T00:00:00Z"- Just d -> d- parseTime' d = msum $ map (\f -> parseTimeM True defaultTimeLocale f d)- [ "%FT%T%Q%z" -- with time zone- , "%FT%T%QZ" -- zulu time- ]---- ------------------------------------------------------------------------ odds and ends--- -----------------------------------------------------------------------entryError e msg =- error $ msg ++ " [on entry " ++ entryId e ++ "]\n" ++ show e--buckets :: Ord b => (a -> b) -> [a] -> [ (b,[a]) ]-buckets f = map (first head . unzip)- . groupBy ((==) `on` fst)- . sortBy (compare `on` fst)- . map (\x -> (f x, x))
− Hakyll/Convert/Common.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}--module Hakyll.Convert.Common where--import Data.Data-import Data.Default-import Data.Maybe-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)--data DistilledPost = DistilledPost- { dpUri :: String- , dpBody :: Text- , dpTitle :: Maybe Text- , dpTags :: [Text]- -- | Categories are coarser-grained than tags; you might be- -- interested in ignoring tags and just focusing on categories- -- in cases where you have lots of little uninteresting tags.- , dpCategories :: [Text]- , dpDate :: UTCTime- }- deriving (Data, Typeable)--instance Default DistilledPost where- def = DistilledPost- { dpUri = ""- , dpBody = ""- , dpTitle = Nothing- , dpTags = []- , dpCategories = []- , dpDate = posixSecondsToUTCTime 0- }
− Hakyll/Convert/OutputFormat.hs
@@ -1,89 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}-module Hakyll.Convert.OutputFormat- (validOutputFormat, formatPath)- where--import Data.Default-import Data.Time.Format (formatTime, defaultTimeLocale)-import System.FilePath--import Hakyll.Convert.Common--import qualified Data.Text as T-import qualified Data.Map.Strict as M--validOutputFormat :: T.Text -> Bool-validOutputFormat format- | T.null format = False- | otherwise =- case formatPath format def of- Just _ -> True- Nothing -> False--formatPath :: T.Text -> DistilledPost -> Maybe T.Text-formatPath format post = helper [] format >>= return.T.concat- where- helper acc input =- case T.uncons input of- Just ('%', rest) ->- case T.uncons rest of- Just (ch, rest2) ->- if ch `M.member` acceptableFormats- then let formatter = acceptableFormats M.! ch- in helper ((formatter post):acc) rest2- else Nothing- Just (ch, rest) -> helper ((T.singleton ch):acc) rest- Nothing -> Just $ reverse acc---- When adding a new format, don't forget to update the help message in--- tools/hakyll-convert.hs-acceptableFormats :: M.Map Char (DistilledPost -> T.Text)-acceptableFormats = M.fromList [- -- this lets users put literal percent sign in the format)- ('%', const $ T.singleton '%')-- , ('o', fmtOriginalPath) -- original filepath, like 2016/01/02/blog-post.html- , ('s', fmtSlug) -- original slug, i.e. "blog-post" from the example above- , ('y', fmtYear2) -- publication year, 2 digits- , ('Y', fmtYear4) -- publication year, 4 digits- , ('m', fmtMonth) -- publication month- , ('d', fmtDay) -- publication day- , ('H', fmtHour) -- publication hour- , ('M', fmtMinute) -- publication minute- , ('S', fmtSecond) -- publication second- ]--fmtOriginalPath post =- T.pack- . dropTrailingSlash- . dropExtensions- $ chopUri (dpUri post)- where- dropTrailingSlash = reverse . dropWhile (== '/') . reverse- chopUri (dropPrefix "http://" -> ("",rest)) =- -- carelessly assumes we can treat URIs like filepaths- joinPath $ drop 1 -- drop the domain- $ splitPath rest- chopUri u = error $- "We've wrongly assumed that blog post URIs start with http://, but we got: " ++ u-- dropPrefix :: Eq a => [a] -> [a] -> ([a],[a])- dropPrefix (x:xs) (y:ys) | x == y = dropPrefix xs ys- dropPrefix left right = (left,right)--fmtSlug post =- T.reverse- . (T.takeWhile (/= '/'))- . T.reverse- $ fmtOriginalPath post--fmtDate format = T.pack . (formatTime defaultTimeLocale format) . dpDate--fmtYear2 = fmtDate "%y"-fmtYear4 = fmtDate "%Y"-fmtMonth = fmtDate "%m"-fmtDay = fmtDate "%d"-fmtHour = fmtDate "%H"-fmtMinute = fmtDate "%M"-fmtSecond = fmtDate "%S"
− Hakyll/Convert/Wordpress.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Convert.Wordpress- (readPosts, distill)- where--import Control.Applicative-import Control.Monad-import qualified Data.ByteString as B-import Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Time (UTCTime)-import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale, rfc822DateFormat)-import Text.XML.Light-import Text.RSS.Import-import Text.RSS.Syntax--import Hakyll.Convert.Common---- | Returns only public posts-readPosts :: FilePath -> IO (Maybe [RSSItem])-readPosts f = do- fmap select . parseRssDoc <$> B.readFile f- where- parseRssDoc x = elementToRSS =<< parseXMLDoc (T.decodeUtf8 x)- select = filter isPublished . rssItems . rssChannel--isPublished :: RSSItem -> Bool-isPublished i = "publish" `elem` getStatus i--distill :: RSSItem -> DistilledPost-distill item = DistilledPost- { dpTitle = T.pack <$> rssItemTitle item- , dpBody = content- , dpUri = link- , dpTags = tags- , dpCategories = categories- , dpDate = date- }- where- link = fromMaybe "" (rssItemLink item)- content = T.pack- $ unlines (map strContent contentTags)- categories = rssCategoriesOfType "category"- tags = rssCategoriesOfType "post_tag"- contentTags = concatMap (findElements contentTag)- (rssItemOther item)- rssCategoriesOfType ty =- [ T.pack (rssCategoryValue c)- | c <- rssItemCategories item- , rssCategoryDomain c == Just ty ]- contentTag = QName- { qName = "encoded"- , qURI = Just "http://purl.org/rss/1.0/modules/content/"- , qPrefix = Just "content"- }- --- date = case parseTime' =<< rssItemPubDate item of- Nothing -> fromJust $ parseTime' "1970-01-01T00:00:00Z"- Just d -> d- parseTime' d = msum $ map (\f -> parseTimeM True defaultTimeLocale f d)- [ rfc822DateFormat- ]---- ------------------------------------------------------------------------ helpers--- -----------------------------------------------------------------------getStatus :: RSSItem -> [String]-getStatus item =- map strContent statusTags- where- statusTags = concatMap (findElements (wpName "status"))- (rssItemOther item)- wpName n = QName- { qName = n- , qURI = Just "http://wordpress.org/export/1.2/"- , qPrefix = Just "wp"- }
LICENSE view
@@ -1,4 +1,5 @@ Copyright (c) 2013, Eric Kow <eric.kow@gmail.com>+Copyright (c) 2020 Alexander Batischev <eual.jp@gmail.com> All rights reserved.
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
+ app/hakyll-convert.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.Text as T+import qualified Hakyll.Convert.Blogger as Blogger+import Hakyll.Convert.IO+import Hakyll.Convert.OutputFormat+import qualified Hakyll.Convert.Wordpress as Wordpress+import System.Console.CmdArgs+import System.Environment+import System.FilePath++data InputFormat = Blogger | Wordpress+ deriving (Data, Typeable, Enum, Show)++data Config = Config+ { feed :: FilePath,+ outputDir :: FilePath,+ -- underscore will be turned into a dash when generating a commandline+ -- option+ output_format :: T.Text,+ format :: InputFormat,+ extract_comments :: Bool+ }+ deriving (Show, Data, Typeable)++parameters :: FilePath -> Config+parameters p =+ modes+ [ Config+ { feed = def &= argPos 0 &= typ "ATOM/RSS FILE",+ outputDir = def &= argPos 1 &= typDir,+ output_format = "%o" &= help outputFormatHelp,+ format = Blogger &= help "blogger or wordpress",+ extract_comments = False &= help "Extract comments"+ }+ &= help "Save blog posts Blogger feed into individual posts"+ ]+ &= program (takeFileName p)++outputFormatHelp :: String+outputFormatHelp =+ unlines+ [ "Output filenames format (without extension)",+ "Default: %o",+ "Available formats:",+ " %% - literal percent sign",+ " %o - original filename (e.g. 2016/01/02/blog-post)",+ " %s - original slug (e.g. \"blog-post\")",+ " %y - publication year, 2 digits",+ " %Y - publication year, 4 digits",+ " %m - publication month",+ " %d - publication day",+ " %H - publication hour",+ " %M - publication minute",+ " %S - publication second"+ ]++-- ---------------------------------------------------------------------+--+-- ---------------------------------------------------------------------++main :: IO ()+main = do+ p <- getProgName+ config <- cmdArgs (parameters p)++ let ofmt = output_format config++ if not (T.null ofmt || validOutputFormat ofmt)+ then fail $ "Invalid output format string: `" ++ T.unpack (output_format config) ++ "'"+ else case format config of+ Blogger -> mainBlogger config+ Wordpress -> mainWordPress config++mainBlogger :: Config -> IO ()+mainBlogger config = do+ mfeed <- Blogger.readPosts (feed config)+ case mfeed of+ Nothing -> fail $ "Could not understand Atom feed: " ++ feed config+ Just fd -> mapM_ process fd+ where+ process fd = do+ let distilled = Blogger.distill (extract_comments config) fd+ fname <- savePost (outputDir config) (output_format config) "html" distilled+ putStrLn fname++mainWordPress :: Config -> IO ()+mainWordPress config = do+ mfeed <- Wordpress.readPosts (feed config)+ case mfeed of+ Nothing -> fail $ "Could not understand RSS feed: " ++ feed config+ Just fd -> mapM_ process fd+ where+ process fd = do+ let distilled = Wordpress.distill (extract_comments config) fd+ fname <- savePost (outputDir config) (output_format config) "markdown" distilled+ putStrLn fname
hakyll-convert.cabal view
@@ -1,52 +1,123 @@--- Initial hakyll-convert.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/+cabal-version: 1.12 -name: hakyll-convert-version: 0.2.0.0-synopsis: Convert from other blog engines to Hakyll.-description: WordPress and Blogger only let one export posts in- a limited number of formats, none of which are supported- by Hakyll. @hakyll-convert@ is created to bridge this gap,- providing a way to turn other platform's datadumps into- a set of files Hakyll understands.-homepage: http://github.com/Minoru/hakyll-convert-license: BSD3-license-file: LICENSE-author: Eric Kow <eric.kow@gmail.com>, Alexander Batischev <eual.jp@gmail.com>-maintainer: Alexander Batischev <eual.jp@gmail.com>--- copyright: -category: Web-build-type: Simple-cabal-version: >=1.8+-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: a2a3bbd11da27cdd46f1ff08f298fc6887e42179f46bb8b725bffaf8a61e189e +name: hakyll-convert+version: 0.3.0.1+synopsis: Convert from other blog engines to Hakyll.+description: WordPress and Blogger only let one export posts in a limited number of formats, none of which are supported by Hakyll. @hakyll-convert@ is created to bridge this gap, providing a way to turn other platform's datadumps into a set of files Hakyll understands.+category: Tools+homepage: https://github.com/Minoru/hakyll-convert#readme+bug-reports: https://github.com/Minoru/hakyll-convert/issues+author: Eric Kow <eric.kow@gmail.com>, Alexander Batischev <eual.jp@gmail.com>+maintainer: Alexander Batischev <eual.jp@gmail.com>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/Minoru/hakyll-convert+ library- exposed-modules: Hakyll.Convert.Blogger- , Hakyll.Convert.Common- , Hakyll.Convert.Wordpress- , Hakyll.Convert.OutputFormat- build-depends: base- , binary- , bytestring- , containers- , data-default- , feed- , filepath- , hakyll- , text- , time- , xml+ exposed-modules:+ Hakyll.Convert.Blogger+ Hakyll.Convert.Common+ Hakyll.Convert.IO+ Hakyll.Convert.OutputFormat+ Hakyll.Convert.Wordpress+ other-modules:+ Paths_hakyll_convert+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.13 && <5+ , bytestring >=0.10 && <0.11+ , containers >=0.6 && <0.7+ , data-default >=0.7 && <0.8+ , directory >=1.3 && <1.4+ , feed >=1.3 && <1.4+ , filepath >=1.4 && <1.5+ , text >=1.2 && <1.3+ , time >=1.9 && <1.10+ , xml-conduit >=1.9 && <1.10+ , xml-types >=0.3 && <0.4+ default-language: Haskell2010 executable hakyll-convert- main-is: hakyll-convert.hs- hs-source-dirs: tools- -- other-modules: - build-depends: base < 5- , bytestring- , cmdargs- , directory- , feed- , filepath- , hakyll-convert- , text- , time- , xml+ main-is: hakyll-convert.hs+ other-modules:+ Paths_hakyll_convert+ hs-source-dirs:+ app+ ghc-options: -Wall+ build-depends:+ base >=4.13 && <5+ , cmdargs >=0.10 && <0.11+ , filepath >=1.4 && <1.5+ , hakyll-convert+ , text >=1.2 && <1.3+ , xml-types >=0.3 && <0.4+ default-language: Haskell2010++test-suite golden+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Golden.Blogger+ Golden.GoldenTestHelpers+ Golden.IO+ Golden.Wordpress+ Paths_hakyll_convert+ hs-source-dirs:+ test/golden+ ghc-options: -Wall -Wno-orphans+ build-depends:+ base >=4.13 && <5+ , bytestring >=0.10 && <0.11+ , data-default >=0.7 && <0.8+ , datetime >=0.3 && <0.4+ , filepath >=1.4 && <1.5+ , hakyll-convert+ , tasty >=1.2 && <1.3+ , tasty-golden >=2.3 && <2.4+ , temporary >=1.3 && <1.4+ , text >=1.2 && <1.3+ , xml-types >=0.3 && <0.4+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Spec.Blogger+ Spec.IO+ Spec.OutputFormat+ Spec.Wordpress+ Paths_hakyll_convert+ hs-source-dirs:+ test/spec+ ghc-options: -Wall -Wno-orphans+ build-depends:+ base >=4.13 && <5+ , data-default >=0.7 && <0.8+ , datetime >=0.3 && <0.4+ , directory >=1.3 && <1.4+ , feed >=1.3 && <1.4+ , filepath >=1.4 && <1.5+ , hakyll-convert+ , tasty >=1.2 && <1.3+ , tasty-expected-failure >=0.11 && <0.12+ , tasty-hunit >=0.10 && <0.11+ , tasty-quickcheck >=0.10 && <0.11+ , temporary >=1.3 && <1.4+ , text >=1.2 && <1.3+ , xml-types >=0.3 && <0.4+ default-language: Haskell2010
+ src/Hakyll/Convert/Blogger.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Hakyll.Convert.Blogger (FullPost (..), readPosts, distill) where++import Control.Arrow+import Control.Monad+import Data.Function+import Data.List+import Data.Maybe+import qualified Data.Text as T+import Data.Time.Format (defaultTimeLocale, parseTimeM)+import Data.XML.Types (Element (..), Name (..), Node (..), elementChildren)+import Hakyll.Convert.Common+import Text.Atom.Feed+import Text.Atom.Feed.Import+import qualified Text.XML as XML++-- | A post and its comments+data FullPost = FullPost+ { fpPost :: Entry,+ fpComments :: [Entry],+ fpUri :: T.Text+ }+ deriving (Show)++-- | An entry is assumed to be either a post, or a comment.+-- If it's a post, it should be associated with the URI+-- that visitors would use to read the post (on the old blog)+-- If it's a comment, it should be the URI for the corresponding+-- post.+data BloggerEntry+ = Post {beUri_ :: T.Text, beEntry :: Entry}+ | Comment {beUri_ :: T.Text, beEntry :: Entry}+ | Orphan {beEntry :: Entry}+ deriving (Show)++beUri :: BloggerEntry -> Maybe T.Text+beUri (Orphan _) = Nothing+beUri (Post u _) = Just u+beUri (Comment u _) = Just u++-- ---------------------------------------------------------------------+-- Feed to helper type+-- ---------------------------------------------------------------------++-- | Returns only published posts+readPosts :: FilePath -> IO (Maybe [FullPost])+readPosts f = do+ doc <- XML.readFile (XML.def :: XML.ParseSettings) f+ let root = XML.toXMLElement $ XML.documentRoot doc+ return $ fmap (extractPosts . feedEntries) $ elementFeed $ deleteDrafts root++-- has to be done on the XML level as our atom lib doesn't understand+-- the blogger-specific XML for drafts+deleteDrafts :: Element -> Element+deleteDrafts e =+ e {elementNodes = filter isInnocent (elementNodes e)}+ where+ isInnocent (NodeElement element) = not (isDraft element)+ isInnocent _ = True++isDraft :: Element -> Bool+isDraft e =+ not . null $ findElements draft e+ where+ draft =+ Name+ { nameLocalName = "draft",+ nameNamespace = Just "http://purl.org/atom/app#",+ namePrefix = Just "app"+ }++-- | Warning: this silently ignores orphans, templates, settings+extractPosts :: [Entry] -> [FullPost]+extractPosts entries =+ map toFullPost blocks+ where+ toFullPost (uri, blockEntries) =+ FullPost+ { fpPost = post,+ fpComments = comments,+ fpUri = uri+ }+ where+ post = case [e | Post _ e <- blockEntries] of+ [] -> huh "Block of entries with no post?!"+ [p] -> p+ _ps -> huh "Block of entries with more than one post?!"+ comments = [e | Comment _ e <- blockEntries]+ huh msg = error . unlines $ msg : map (txtToString . entryTitle . beEntry) blockEntries+ blocks = [(u, xs) | (Just u, xs) <- blocks_] -- drop orphans+ blocks_ =+ buckets beUri $+ map identifyEntry $+ filter isInteresting entries++-- | Contains actual meat (posts, comments; but not eg. templates)+isInteresting :: Entry -> Bool+isInteresting e =+ not $ any isBoring cats+ where+ isBoring c = any (\t -> isBloggerCategoryOfType t c) ["settings", "template"]+ cats = entryCategories e++-- | Tag an entry from the blogger feed as either being a post,+-- a comment, or an "orphan" (a comment without an associated post)+identifyEntry :: Entry -> BloggerEntry+identifyEntry e =+ if isPost e+ then case getLink "self" `mplus` getLink "alternate" of+ Just l -> Post (postUrl l) e+ Nothing -> entryError e oopsSelf+ else case getLink "alternate" of+ Just l -> Comment (postUrl l) e+ Nothing -> Orphan e+ where+ isPost = any (isBloggerCategoryOfType "post") . entryCategories+ postUrl = T.takeWhile (/= '?') . replaceSchema . linkHref+ replaceSchema url = maybe url (T.append "https://") (T.stripPrefix "http://" url)+ getLink ty = case filter (isLink ty) $ entryLinks e of+ [] -> Nothing+ [x] -> Just x+ _xs -> entryError e (oopsLink ty)+ isLink ty l = linkRel l == Just (Right ty) && linkType l == Just "text/html"+ oopsSelf = "Was expecting blog posts to have a self link"+ oopsLink ty = T.append "Was expecting entries have at most one link of type " ty++isBloggerCategory :: Category -> Bool+isBloggerCategory =+ (== Just "http://schemas.google.com/g/2005#kind")+ . catScheme++isBloggerCategoryOfType ::+ -- | \"comment\", \"post\", etc+ T.Text ->+ Category ->+ Bool+isBloggerCategoryOfType ty c =+ isBloggerCategory c+ && catTerm c == T.append "http://schemas.google.com/blogger/2008/kind#" ty++-- ---------------------------------------------------------------------+--+-- ---------------------------------------------------------------------++distill :: Bool -> FullPost -> DistilledPost+distill extractComments fp =+ DistilledPost+ { dpBody = body fpost,+ dpUri = fpUri fp,+ dpTitle = title fpost,+ dpTags = tags fpost,+ dpCategories = [],+ dpDate = date fpost+ }+ where+ fpost = fpPost fp+ fcomments = fpComments fp+ --+ body post =+ let article = fromContent $ entryContent post+ comments = T.intercalate "\n" $ map formatComment fcomments+ in if extractComments+ then+ T.intercalate+ "\n"+ [ article,+ "",+ "<h3 id='hakyll-convert-comments-title'>Comments</h3>",+ comments+ ]+ else article++ fromContent (Just (HTMLContent x)) = x+ fromContent _ = error "Hakyll.Convert.Blogger.distill expecting HTML"++ formatComment c =+ T.intercalate+ "\n"+ [ "<div class='hakyll-convert-comment'>",+ T.concat+ [ "<p class='hakyll-convert-comment-date'>",+ "On ",+ pubdate,+ ", ",+ author,+ " wrote:",+ "</p>"+ ],+ "<div class='hakyll-convert-comment-body'>",+ comment,+ "</div>",+ "</div>"+ ]+ where+ pubdate = fromMaybe "unknown date" (entryPublished c)+ author = T.unwords $ map personName (entryAuthors c)+ comment = fromContent $ entryContent c+ --+ title p = case txtToString (entryTitle p) of+ "" -> Nothing+ t -> Just (T.pack t)+ tags =+ map catTerm+ . filter (not . isBloggerCategory)+ . entryCategories+ date x = case parseTime' =<< entryPublished x of+ Nothing -> fromJust $ parseTime' "1970-01-01T00:00:00Z"+ Just d -> d+ parseTime' d =+ msum $+ map+ (\f -> parseTimeM True defaultTimeLocale f (T.unpack d))+ [ "%FT%T%Q%z", -- with time zone+ "%FT%T%QZ" -- zulu time+ ]++-- ---------------------------------------------------------------------+-- odds and ends+-- ---------------------------------------------------------------------++entryError :: forall a. Entry -> T.Text -> a+entryError e msg =+ error $ (T.unpack msg) ++ " [on entry " ++ (T.unpack (entryId e)) ++ "]\n" ++ show e++buckets :: Ord b => (a -> b) -> [a] -> [(b, [a])]+buckets f =+ map (first head . unzip)+ . groupBy ((==) `on` fst)+ . sortBy (compare `on` fst)+ . map (\x -> (f x, x))++-- | Find all non-nested elements which are named `name`, starting with `root`.+-- ("Non-nested" means we don't search sub-elements of an element that's named+-- `name`.)+findElements :: Name -> Element -> [Element]+findElements name element =+ if elementName element == name+ then [element]+ else concatMap (findElements name) (elementChildren element)
+ src/Hakyll/Convert/Common.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++module Hakyll.Convert.Common where++import Data.Data+import Data.Default+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)++data DistilledPost = DistilledPost+ { dpUri :: T.Text,+ dpBody :: Text,+ dpTitle :: Maybe Text,+ dpTags :: [Text],+ -- | Categories are coarser-grained than tags; you might be+ -- interested in ignoring tags and just focusing on categories+ -- in cases where you have lots of little uninteresting tags.+ dpCategories :: [Text],+ dpDate :: UTCTime+ }+ deriving (Data, Typeable)++instance Default DistilledPost where+ def =+ DistilledPost+ { dpUri = "",+ dpBody = "",+ dpTitle = Nothing,+ dpTags = [],+ dpCategories = [],+ dpDate = posixSecondsToUTCTime 0+ }
+ src/Hakyll/Convert/IO.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++module Hakyll.Convert.IO where++import qualified Data.ByteString as B+import Data.Maybe (fromJust)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Time.Format (defaultTimeLocale, formatTime)+import Hakyll.Convert.Common (DistilledPost (..))+import Hakyll.Convert.OutputFormat (formatPath)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory, takeFileName, (<.>), (</>))++-- | Save a post along with its comments in a format that Hakyll understands.+--+-- Returns the filename of the file that was written.+savePost :: FilePath -> T.Text -> T.Text -> DistilledPost -> IO FilePath+savePost odir oformat ext post = do+ createDirectoryIfMissing True (takeDirectory fname)+ B.writeFile fname . T.encodeUtf8 $+ T.unlines+ [ "---",+ metadata "title" (formatTitle (dpTitle post)),+ metadata "published" (formatDate (dpDate post)),+ metadata "categories" (formatTags (dpCategories post)),+ metadata "tags" (formatTags (dpTags post)),+ "---",+ "",+ formatBody (dpBody post)+ ]++ return fname+ where+ metadata k v = k <> ": " <> v+ --+ fname = odir </> postPath <.> (T.unpack ext)+ postPath = T.unpack $ fromJust $ formatPath oformat post+ --+ formatTitle (Just t) = t+ formatTitle Nothing =+ "untitled (" <> T.unwords firstFewWords <> "…)"+ where+ firstFewWords = T.splitOn "-" . T.pack $ takeFileName postPath+ formatDate = T.pack . formatTime defaultTimeLocale "%FT%TZ" --for hakyll+ formatTags = T.intercalate ","+ formatBody = id
+ src/Hakyll/Convert/OutputFormat.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Hakyll.Convert.OutputFormat (validOutputFormat, formatPath) where++import Data.Default+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import Data.Time.Format (defaultTimeLocale, formatTime)+import Hakyll.Convert.Common+import System.FilePath++validOutputFormat :: T.Text -> Bool+validOutputFormat format+ | T.null format = False+ | otherwise =+ case formatPath format def of+ Just _ -> True+ Nothing -> False++formatPath :: T.Text -> DistilledPost -> Maybe T.Text+formatPath format post = T.concat <$> helper [] format+ where+ helper acc input =+ case T.uncons input of+ Just ('%', rest) ->+ case T.uncons rest of+ Just (ch, rest2) ->+ if ch `M.member` acceptableFormats+ then+ let formatter = acceptableFormats M.! ch+ in helper ((formatter post) : acc) rest2+ else Nothing+ Nothing -> Nothing+ Just (ch, rest) -> helper ((T.singleton ch) : acc) rest+ Nothing -> Just $ reverse acc++-- When adding a new format, don't forget to update the help message in+-- tools/hakyll-convert.hs+acceptableFormats :: M.Map Char (DistilledPost -> T.Text)+acceptableFormats =+ M.fromList+ [ -- this lets users put literal percent sign in the format)+ ('%', const $ T.singleton '%'),+ ('o', fmtOriginalPath), -- original filepath, like 2016/01/02/blog-post.html+ ('s', fmtSlug), -- original slug, i.e. "blog-post" from the example above+ ('y', fmtYear2), -- publication year, 2 digits+ ('Y', fmtYear4), -- publication year, 4 digits+ ('m', fmtMonth), -- publication month+ ('d', fmtDay), -- publication day+ ('H', fmtHour), -- publication hour+ ('M', fmtMinute), -- publication minute+ ('S', fmtSecond) -- publication second+ ]++fmtOriginalPath :: DistilledPost -> T.Text+fmtOriginalPath post =+ T.pack+ . dropTrailingSlash+ . dropExtensions+ $ chopUri $ T.unpack (dpUri post)+ where+ dropTrailingSlash = reverse . dropWhile (== '/') . reverse+ dropDomain path =+ -- carelessly assumes we can treat URIs like filepaths+ joinPath $+ drop 1 $ -- drop the domain+ splitPath path+ chopUri (dropPrefix "http://" -> ("", rest)) = dropDomain rest+ chopUri (dropPrefix "https://" -> ("", rest)) = dropDomain rest+ chopUri u =+ error $+ "We've wrongly assumed that blog post URIs start with http:// or https://, but we got: " ++ u++ dropPrefix :: Eq a => [a] -> [a] -> ([a], [a])+ dropPrefix (x : xs) (y : ys) | x == y = dropPrefix xs ys+ dropPrefix left right = (left, right)++fmtSlug :: DistilledPost -> T.Text+fmtSlug post =+ T.reverse+ . (T.takeWhile (/= '/'))+ . T.reverse+ $ fmtOriginalPath post++fmtDate :: String -> DistilledPost -> T.Text+fmtDate format = T.pack . (formatTime defaultTimeLocale format) . dpDate++fmtYear2 :: DistilledPost -> T.Text+fmtYear2 = fmtDate "%y"++fmtYear4 :: DistilledPost -> T.Text+fmtYear4 = fmtDate "%Y"++fmtMonth :: DistilledPost -> T.Text+fmtMonth = fmtDate "%m"++fmtDay :: DistilledPost -> T.Text+fmtDay = fmtDate "%d"++fmtHour :: DistilledPost -> T.Text+fmtHour = fmtDate "%H"++fmtMinute :: DistilledPost -> T.Text+fmtMinute = fmtDate "%M"++fmtSecond :: DistilledPost -> T.Text+fmtSecond = fmtDate "%S"
+ src/Hakyll/Convert/Wordpress.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedStrings #-}++module Hakyll.Convert.Wordpress (readPosts, distill) where++import Control.Monad+import Data.Maybe+import qualified Data.Text as T+import Data.Time.Format (defaultTimeLocale, parseTimeM, rfc822DateFormat)+import Data.XML.Types (Element (..), Name (..), elementChildren, elementText)+import Hakyll.Convert.Common+import Text.RSS.Import+import Text.RSS.Syntax+import qualified Text.XML as XML++-- | Returns only public posts+readPosts :: FilePath -> IO (Maybe [RSSItem])+readPosts f = do+ doc <- XML.readFile (XML.def :: XML.ParseSettings) f+ let root = XML.toXMLElement $ XML.documentRoot doc+ return $ fmap select (elementToRSS root)+ where+ select = filter isPublished . rssItems . rssChannel++isPublished :: RSSItem -> Bool+isPublished i = "publish" `elem` getStatus i++distill :: Bool -> RSSItem -> DistilledPost+distill extractComments item =+ DistilledPost+ { dpTitle = rssItemTitle item,+ dpBody = body,+ dpUri = link,+ dpTags = tags,+ dpCategories = categories,+ dpDate = date+ }+ where+ body =+ if extractComments+ then+ T.intercalate+ "\n"+ [ content,+ "",+ "<h3 id='hakyll-convert-comments-title'>Comments</h3>",+ comments+ ]+ else content+ link = fromMaybe "" (rssItemLink item)+ content = T.unlines (map strContent contentTags)+ categories = rssCategoriesOfType "category"+ tags = rssCategoriesOfType "post_tag"+ contentTags = concatMap (findElements contentTag) (rssItemOther item)+ rssCategoriesOfType ty =+ [ rssCategoryValue c+ | c <- rssItemCategories item,+ rssCategoryDomain c == Just ty+ ]+ contentTag =+ Name+ { nameLocalName = "encoded",+ nameNamespace = Just "http://purl.org/rss/1.0/modules/content/",+ namePrefix = Just "content"+ }+ comments = T.intercalate "\n" $ map formatComment commentTags+ commentTags = rssItemOther item >>= findElements commentTag+ commentTag = wordpressTag "comment"+ --+ date = case parseTime' =<< rssItemPubDate item of+ Nothing -> fromJust $ parseTime' "Thu, 01 Jan 1970 00:00:00 UTC"+ Just d -> d+ parseTime' d =+ msum $+ map+ (\f -> parseTimeM True defaultTimeLocale f (T.unpack d))+ [ rfc822DateFormat+ ]++-- ---------------------------------------------------------------------+-- helpers+-- ---------------------------------------------------------------------++formatComment :: Element -> T.Text+formatComment commentElement =+ T.intercalate+ "\n"+ [ "<div class='hakyll-convert-comment'>",+ T.concat+ [ "<p class='hakyll-convert-comment-date'>",+ "On ",+ pubdate,+ ", ",+ author,+ " wrote:",+ "</p>"+ ],+ "<div class='hakyll-convert-comment-body'>",+ comment,+ "</div>",+ "</div>"+ ]+ where+ pubdate = fromMaybe "unknown date" $ findField "comment_date"+ author = fromMaybe "unknown author" $ findField "comment_author"+ comment = fromMaybe "" $ findField "comment_content"+ findField name =+ strContent <$> findChild (wordpressTag name) commentElement++wordpressTag :: T.Text -> Name+wordpressTag name =+ Name+ { nameLocalName = name,+ nameNamespace = Just "http://wordpress.org/export/1.2/",+ namePrefix = Just "wp"+ }++getStatus :: RSSItem -> [T.Text]+getStatus item =+ map strContent statusTags+ where+ statusTags = concatMap (findElements (wordpressTag "status")) (rssItemOther item)++-- | Find all non-nested elements which are named `name`, starting with `root`.+-- ("Non-nested" means we don't search sub-elements of an element that's named+-- `name`.)+findElements :: Name -> Element -> [Element]+findElements name element =+ if elementName element == name+ then [element]+ else concatMap (findElements name) (elementChildren element)++-- | Find first immediate child of `root` which is named `name`.+findChild :: Name -> Element -> Maybe Element+findChild name element =+ let subelements = elementChildren element+ matching = filter (\child -> elementName child == name) subelements+ in listToMaybe matching++-- | The contents of the element (ignoring non-text sub-elements).+strContent :: Element -> T.Text+strContent element = T.concat $ elementText element
+ test/golden/Golden/Blogger.hs view
@@ -0,0 +1,51 @@+module Golden.Blogger where++import Data.Maybe (listToMaybe)+import Golden.GoldenTestHelpers+import Hakyll.Convert.Blogger+import Test.Tasty (TestTree, testGroup)++goldenTests :: TestTree+goldenTests =+ testGroup+ "Blogger"+ [ blogger_000,+ blogger_001,+ blogger_002+ ]++blogger_000 :: TestTree+blogger_000 =+ testGroup+ "readPosts"+ [ helper+ ("post No." ++ no)+ (listToMaybe . (drop offset))+ | (no, offset) <- map (\n -> (show n, n)) [0 .. 2]+ ]+ where+ helper = readPostsHelper readPosts "test/golden/data/blogger-000/"++blogger_001 :: TestTree+blogger_001 =+ testGroup+ "distilled posts (blogger-001)"+ [ helper+ ("post No." ++ no)+ (listToMaybe . (drop offset))+ | (no, offset) <- map (\n -> (show n, n)) [0 .. 2]+ ]+ where+ helper = readAndDistillHelper readPosts distill "test/golden/data/blogger-001/"++blogger_002 :: TestTree+blogger_002 =+ testGroup+ "distilled posts (blogger-002)"+ [ helper+ ("post No." ++ no)+ (listToMaybe . (drop offset))+ | (no, offset) <- map (\n -> (show n, n)) [0 .. 2]+ ]+ where+ helper = readAndDistillHelper readPosts distill "test/golden/data/blogger-002/"
+ test/golden/Golden/GoldenTestHelpers.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE StandaloneDeriving #-}++module Golden.GoldenTestHelpers where++import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Maybe (fromMaybe)+import Hakyll.Convert.Common+import Test.Tasty (TestTree)+import Test.Tasty.Golden (goldenVsString)++deriving instance Show DistilledPost++readPostsHelper ::+ Show a =>+ (FilePath -> IO (Maybe [a])) ->+ String ->+ String ->+ ([a] -> Maybe a) ->+ TestTree+readPostsHelper readPosts dir testName selector =+ goldenVsString+ testName+ (dir ++ (map spaceToDash testName) ++ ".golden")+ ( do+ posts <- readPosts (dir ++ "input.xml")+ return $+ fromMaybe+ LBS.empty+ ( posts+ >>= selector+ >>= (return . LBS.pack . show)+ )+ )+ where+ spaceToDash = \c -> if c == ' ' then '-' else c++readAndDistillHelper ::+ (FilePath -> IO (Maybe [a])) ->+ (Bool -> a -> DistilledPost) ->+ String ->+ String ->+ ([DistilledPost] -> Maybe DistilledPost) ->+ TestTree+readAndDistillHelper readPosts distill dir testName selector =+ let fut filepath = do+ posts <- readPosts filepath+ let extractComments = True+ return $ fmap (map (distill extractComments)) posts+ in readPostsHelper fut dir testName selector
+ test/golden/Golden/IO.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++module Golden.IO where++import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.DateTime (fromGregorian)+import Data.Default (def)+import Hakyll.Convert.Common (DistilledPost (..))+import Hakyll.Convert.IO (savePost)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.Golden (goldenVsString)++goldenTests :: TestTree+goldenTests =+ testGroup+ "IO.savePost"+ [ writesUntitledPost,+ writesPostWithTitle+ ]++writesUntitledPost :: TestTree+writesUntitledPost =+ goldenVsString+ "Writes untitled post to a file"+ "test/golden/data/io-000/untitled-post.golden"+ ( withSystemTempDirectory "hakyll-convert" $ \tempDir -> do+ let output_format = "output"+ let file_extension = "html"+ let post =+ def+ { dpUri = "https://example.com/~joe/2011/01/02/just-testing.php",+ dpDate = fromGregorian 2011 1 2 3 14 59,+ dpCategories = ["Category 1", "Category 2"],+ dpTags = ["Tagged", "with", "<3"],+ dpBody = "<p>This tool is <em>awesome</em>!</p>"+ }++ -- Ignore the generated filename -- we'll just check if the file is at+ -- the expected place instead.+ _filename <- savePost tempDir output_format file_extension post++ let filename = tempDir </> "output.html"+ LBS.readFile filename+ )++writesPostWithTitle :: TestTree+writesPostWithTitle =+ goldenVsString+ "Writes post with title to a file"+ "test/golden/data/io-000/post-with-title.golden"+ ( withSystemTempDirectory "hakyll-convert" $ \tempDir -> do+ let output_format = "output"+ let file_extension = "aspx"+ let post =+ def+ { dpUri = "https://example.com/~joe/a%20joke.php",+ dpDate = fromGregorian 1999 12 31 23 59 1,+ dpCategories = ["jokes"],+ dpTags = ["non-funny", "unoriginal"],+ dpTitle = Just "And now for something completely different…",+ dpBody = "Wonder what it is?"+ }++ -- Ignore the generated filename -- we'll just check if the file is at+ -- the expected place instead.+ _filename <- savePost tempDir output_format file_extension post++ let filename = tempDir </> "output.aspx"+ LBS.readFile filename+ )
+ test/golden/Golden/Wordpress.hs view
@@ -0,0 +1,38 @@+module Golden.Wordpress where++import Data.Maybe (listToMaybe)+import Golden.GoldenTestHelpers+import Hakyll.Convert.Wordpress+import Test.Tasty (TestTree, testGroup)++goldenTests :: TestTree+goldenTests =+ testGroup+ "Wordpress"+ [ wordpress_000,+ wordpress_001+ ]++wordpress_000 :: TestTree+wordpress_000 =+ testGroup+ "readPosts"+ [ helper+ ("post No. " ++ no)+ (listToMaybe . (drop offset))+ | (no, offset) <- map (\n -> (show n, n)) [0 .. 11]+ ]+ where+ helper = readPostsHelper readPosts "test/golden/data/wordpress-000/"++wordpress_001 :: TestTree+wordpress_001 =+ testGroup+ "distilled posts"+ [ helper+ ("post No. " ++ no)+ (listToMaybe . (drop offset))+ | (no, offset) <- map (\n -> (show n, n)) [0 .. 11]+ ]+ where+ helper = readAndDistillHelper readPosts distill "test/golden/data/wordpress-001/"
+ test/golden/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import qualified Golden.Blogger as Blogger+import qualified Golden.IO as IO+import qualified Golden.Wordpress as Wordpress+import Test.Tasty (TestTree, defaultMain, testGroup)++main :: IO ()+main = defaultMain goldenTests++goldenTests :: TestTree+goldenTests =+ testGroup+ "Golden tests"+ [ Blogger.goldenTests,+ IO.goldenTests,+ Wordpress.goldenTests+ ]
+ test/spec/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import qualified Spec.Blogger as Blogger+import qualified Spec.IO as IO+import qualified Spec.OutputFormat as OutputFormat+import qualified Spec.Wordpress as Wordpress+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+ defaultMain $+ testGroup+ "Spec tests"+ [ Blogger.tests,+ Wordpress.tests,+ OutputFormat.tests,+ IO.tests+ ]
+ test/spec/Spec/Blogger.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}++module Spec.Blogger (tests) where++import Data.DateTime (fromGregorian)+import qualified Data.Text as T+import Hakyll.Convert.Blogger+import Hakyll.Convert.Common (DistilledPost (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.ExpectedFailure (expectFail)+import Test.Tasty.HUnit+import qualified Text.Atom.Feed as Atom++deriving instance Eq DistilledPost++deriving instance Show DistilledPost++tests :: TestTree+tests =+ testGroup+ "Blogger.distill"+ [ extractsPostUri,+ extractsPostBody,+ extractsPostTitle,+ canSkipComments,+ canExtractComments,+ enumeratesAllCommentAuthors,+ errorsOnNonHtmlPost,+ errorsOnNonHtmlComment,+ turnsIncorrectDatesIntoEpochStart,+ parsesDates,+ extractsPostTags+ ]++extractsPostUri :: TestTree+extractsPostUri =+ testGroup+ "extracts post's URI"+ [ testCase (T.unpack uri) (dpUri (distill False (createInput uri)) @?= uri)+ | uri <-+ [ "https://example.com/testing-post-uris",+ "http://www.example.com/~joe/posts.atom"+ ]+ ]+ where+ createInput uri =+ FullPost+ { fpPost = entry,+ fpComments = [],+ fpUri = uri+ }+ entry =+ Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "Test post")+ "2003-12-13T18:30:02Z"++extractsPostBody :: TestTree+extractsPostBody =+ testGroup+ "extracts post's body"+ [ testCase (T.unpack body) (dpBody (distill False (createInput body)) @?= body)+ | body <-+ [ "<p>Today was a snowy day, and I decided to...</p>",+ "<h3>My opinion on current affairs</h3><p>So you see, I...</p>"+ ]+ ]+ where+ createInput body =+ FullPost+ { fpPost = createEntry body,+ fpComments = [],+ fpUri = "https://example.com"+ }+ createEntry body =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "Test post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent body)+ }++extractsPostTitle :: TestTree+extractsPostTitle =+ testGroup+ "extracts post's title"+ [ testCase (T.unpack title) (dpTitle (distill False (createInput title)) @?= Just (title))+ | title <-+ [ "First post",+ "You won't believe what happened to me today",+ "Trying out <i>things</i>…"+ ]+ ]+ where+ createInput title =+ FullPost+ { fpPost = createEntry title,+ fpComments = [],+ fpUri = "https://example.com/titles.atom"+ }+ createEntry title =+ Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString title)+ "2003-12-13T18:30:02Z"++canSkipComments :: TestTree+canSkipComments =+ testCase+ "does not extract comments if first argument is False"+ (dpBody (distill False input) @?= expected)+ where+ input =+ FullPost+ { fpPost = entry,+ fpComments = [comment],+ fpUri = "https://example.com/feed"+ }+ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Hello, world!</p>"),+ Atom.entryPublished = Just "2003-12-13T18:30:02Z"+ }+ comment =+ ( Atom.nullEntry+ "https://example.com/entry#comment1"+ (Atom.TextString "Nice")+ "2003-12-13T20:00:03Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Nice post.</p>")+ }++ expected = "<p>Hello, world!</p>"++canExtractComments :: TestTree+canExtractComments =+ testGroup+ "extracts comments if first argument is True"+ [ noDateNoAuthor,+ dateNoAuthor,+ noDateAuthor,+ dateAuthor+ ]+ where+ createInput comment =+ FullPost+ { fpPost = entry,+ fpComments = [comment],+ fpUri = "https://example.com/feed"+ }++ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Hello, world!</p>"),+ Atom.entryPublished = Just "2003-12-13T18:30:02Z"+ }++ noDateNoAuthor =+ testCase+ "comments with no \"published\" date and no author"+ (dpBody (distill True (createInput commentNoDateNoAuthor)) @?= expectedNoDateNoAuthor)+ commentNoDateNoAuthor =+ ( Atom.nullEntry+ "https://example.com/entry#comment1"+ (Atom.TextString "Nice")+ "2003-12-13T20:00:03Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Nice post.</p>")+ }+ expectedNoDateNoAuthor =+ "<p>Hello, world!</p>\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Nice post.</p>\n\+ \</div>\n\+ \</div>"++ dateNoAuthor =+ testCase+ "comments with a \"published\" date but no author"+ (dpBody (distill True (createInput commentDateNoAuthor)) @?= expectedDateNoAuthor)+ commentDateNoAuthor =+ commentNoDateNoAuthor+ { Atom.entryPublished = Just "2019-01-02T03:04:05Z"+ }+ expectedDateNoAuthor =+ "<p>Hello, world!</p>\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On 2019-01-02T03:04:05Z, wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Nice post.</p>\n\+ \</div>\n\+ \</div>"++ noDateAuthor =+ testCase+ "comments with no \"published\" date but with an author"+ (dpBody (distill True (createInput commentNoDateAuthor)) @?= expectedNoDateAuthor)+ commentNoDateAuthor =+ commentNoDateNoAuthor+ { Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "John Doe"}]+ }+ expectedNoDateAuthor =+ "<p>Hello, world!</p>\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, John Doe wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Nice post.</p>\n\+ \</div>\n\+ \</div>"++ dateAuthor =+ testCase+ "comments with a \"published\" date and an author"+ (dpBody (distill True (createInput commentDateAuthor)) @?= expectedDateAuthor)+ commentDateAuthor =+ commentNoDateNoAuthor+ { Atom.entryPublished = Just "2019-01-02T03:04:05Z",+ Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "John Doe"}]+ }+ expectedDateAuthor =+ "<p>Hello, world!</p>\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On 2019-01-02T03:04:05Z, John Doe wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Nice post.</p>\n\+ \</div>\n\+ \</div>"++enumeratesAllCommentAuthors :: TestTree+enumeratesAllCommentAuthors =+ testCase+ "enumerates all authors of a multi-author comment"+ (dpBody (distill True input) @?= expected)+ where+ input =+ FullPost+ { fpPost = entry,+ fpComments = [comment],+ fpUri = "https://example.com/feed"+ }+ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Hello, world!</p>"),+ Atom.entryPublished = Just "2003-12-13T18:30:02Z"+ }+ comment =+ ( Atom.nullEntry+ "https://example.com/entry#comment1"+ (Atom.TextString "Nice")+ "2103-05-11T18:37:49Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent "<p>Nice post.</p>"),+ Atom.entryAuthors =+ [ Atom.nullPerson {Atom.personName = "First Author"},+ Atom.nullPerson {Atom.personName = "Second Author"}+ ]+ }++ expected =+ "<p>Hello, world!</p>\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, First Author Second Author wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Nice post.</p>\n\+ \</div>\n\+ \</div>"++nullDistilledPost :: DistilledPost+nullDistilledPost =+ DistilledPost+ { dpUri = "",+ dpBody = "",+ dpTitle = Nothing,+ dpTags = [],+ dpCategories = [],+ dpDate = fromGregorian 2003 12 13 18 30 2+ }++errorsOnNonHtmlPost :: TestTree+errorsOnNonHtmlPost =+ expectFail $+ testCase+ "`error`s if post has non-HTML body"+ (distill False input @?= nullDistilledPost)+ where+ input =+ FullPost+ { fpPost = entry,+ fpComments = [],+ fpUri = "https://example.com/feed"+ }+ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.TextContent "oops, this will fail")+ }++errorsOnNonHtmlComment :: TestTree+errorsOnNonHtmlComment =+ expectFail $+ testCase+ "`error`s if comment has non-HTML body"+ (distill False input @?= nullDistilledPost)+ where+ input =+ FullPost+ { fpPost = entry,+ fpComments = [comment],+ fpUri = "https://example.com/feed"+ }+ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.TextContent "testing...")+ }++ comment =+ ( Atom.nullEntry+ "https://example.com/entry#2"+ (Atom.TextString "test comment")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.TextContent "oops, this will fail")+ }++turnsIncorrectDatesIntoEpochStart :: TestTree+turnsIncorrectDatesIntoEpochStart =+ testGroup+ "turns incorrect \"published\" dates into Unix epoch start date"+ [ testCase (T.unpack date) (dpDate (distill False (createInput date)) @?= expected)+ | date <-+ [ "First of April",+ "2020.07.30",+ "2020.07.30 00:01",+ "2020-07-30 00:01",+ "2020-07-30T00:01",+ "2020-07-30T00:01Z",+ "Sun, 31st July, 2020"+ ]+ ]+ where+ createInput date =+ FullPost+ { fpPost = createEntry date,+ fpComments = [],+ fpUri = "https://example.com/feed"+ }+ createEntry date =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ date+ )+ { Atom.entryContent = Just (Atom.HTMLContent ""),+ Atom.entryPublished = Just date+ }++ expected = fromGregorian 1970 1 1 0 0 0++parsesDates :: TestTree+parsesDates =+ testGroup+ "parses \"published\" dates"+ [ testCase (T.unpack dateStr) (dpDate (distill False (createInput dateStr)) @?= expected)+ | (dateStr, expected) <-+ [ ("2020-07-30T15:50:21Z", fromGregorian 2020 7 30 15 50 21),+ ("1015-02-18T01:04:13Z", fromGregorian 1015 2 18 1 4 13),+ ("2020-07-30T15:50:21+0000", fromGregorian 2020 7 30 15 50 21),+ ("1015-02-18T01:04:13+0000", fromGregorian 1015 2 18 1 4 13),+ ("1015-02-18T01:04:13+0001", fromGregorian 1015 2 18 1 (4 -1) 13),+ ("1015-02-18T01:04:13-0001", fromGregorian 1015 2 18 1 (4 + 1) 13),+ ("1015-02-18T01:04:13+0100", fromGregorian 1015 2 18 (1 -1) 4 13),+ ("1015-02-18T01:04:13-0100", fromGregorian 1015 2 18 (1 + 1) 4 13)+ ]+ ]+ where+ createInput date =+ FullPost+ { fpPost = createEntry date,+ fpComments = [],+ fpUri = "https://example.com/feed"+ }+ createEntry date =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ date+ )+ { Atom.entryContent = Just (Atom.HTMLContent ""),+ Atom.entryPublished = Just date+ }++extractsPostTags :: TestTree+extractsPostTags =+ testCase+ "extracts post's tags"+ (dpTags (distill False input) @?= expected)+ where+ input =+ FullPost+ { fpPost = entry,+ fpComments = [],+ fpUri = "https://example.com/feed"+ }+ entry =+ ( Atom.nullEntry+ "https://example.com/entry"+ (Atom.TextString "First post")+ "2003-12-13T18:30:02Z"+ )+ { Atom.entryContent = Just (Atom.HTMLContent ""),+ Atom.entryCategories =+ [ Atom.newCategory "first tag",+ Atom.newCategory "second tag",+ Atom.newCategory "third tag",+ (Atom.newCategory "blogger category (should be ignored)")+ { Atom.catScheme = Just "http://schemas.google.com/g/2005#kind"+ }+ ]+ }++ expected = ["first tag", "second tag", "third tag"]
+ test/spec/Spec/IO.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module Spec.IO (tests) where++import Data.DateTime (fromGregorian)+import Data.Default (def)+import Hakyll.Convert.Common (DistilledPost (..))+import Hakyll.Convert.IO (savePost)+import System.Directory (doesFileExist)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "IO.savePost"+ [ namesTheFileAccordingToFormat+ ]++namesTheFileAccordingToFormat :: TestTree+namesTheFileAccordingToFormat =+ testCase+ "Names the output file according to the given filename format"+ ( withSystemTempDirectory "hakyll-convert" $ \tempDir -> do+ let output_format = "%o-%Y^%y%%_%s%dd & %m—%S%H%M"+ let file_extension = "xyz"+ let post =+ def+ { -- The slug, %s, is going to be "yet-another"+ dpUri = "https://example.com/2020/yet-another.post.html",+ dpDate = fromGregorian 2020 11 6 11 33 46+ }++ let expectedFilename = tempDir </> "2020/yet-another-2020^20%_yet-another06d & 11—461133.xyz"++ filename <- savePost tempDir output_format file_extension post+ expectedFilename @=? filename++ exists <- doesFileExist expectedFilename+ assertBool "The file with expected name doesn't exist" exists+ )
+ test/spec/Spec/OutputFormat.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}++module Spec.OutputFormat (tests) where++import Data.DateTime (fromGregorian)+import Data.Default+import Data.Maybe (isJust)+import qualified Data.Text as T+import Hakyll.Convert.Common (DistilledPost (..))+import Hakyll.Convert.OutputFormat+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+ testGroup+ "OutputFormat"+ [ validOutputFormatTests,+ formatPathTests+ ]++validOutputFormatTests :: TestTree+validOutputFormatTests =+ testGroup+ "`validOutputFormat`"+ [ falseOnEmptyFormat,+ synchronyWithFormatPath+ ]+ where+ falseOnEmptyFormat =+ testCase+ "returns False if format string is empty"+ (validOutputFormat "" @?= False)++ synchronyWithFormatPath =+ testProperty+ "returns False if `formatPath` returns `Nothing`, otherwise True"+ ( \format ->+ let format' = T.pack format+ result = validOutputFormat format'+ formatPathResult = isJust (formatPath format' def)+ in not (null format) ==> (result && formatPathResult) || (not result && not formatPathResult)+ )++formatPathTests :: TestTree+formatPathTests =+ testGroup+ "`formatPath`"+ [ noChange,+ lowercaseO,+ lowercaseS,+ lowercaseY,+ uppercaseY,+ lowercaseM,+ lowercaseD,+ uppercaseH,+ uppercaseM,+ uppercaseS,+ complexExamples,+ abortsProcessingOnUnknownFormat+ ]+ where+ noChange =+ let input = "Hello, world!/2020-09-03-test.markdown"+ in testCase+ "does not change text that has no percent signs in it"+ (formatPath input def @?= Just input)++ lowercaseO =+ testGroup+ "%o is replaced by the original filepath"+ [ testCase+ "works with HTTP schema"+ (formatPath "%o" (def {dpUri = "http://example.com/post.html"}) @?= Just "post"),+ testCase+ "works with HTTPS schema"+ (formatPath "%o" (def {dpUri = "https://example.com/post.html"}) @?= Just "post"),+ testCase+ "trailing slashes are removed"+ (formatPath "%o" (def {dpUri = "https://example.com/2020-09-03-hello////"}) @?= Just "2020-09-03-hello"),+ testCase+ "file extension is removed"+ (formatPath "%o" (def {dpUri = "https://example.com/first-post.html"}) @?= Just "first-post"),+ testCase+ "all file extensions are removed"+ (formatPath "%o" (def {dpUri = "https://example.com/first-post.aspx.gz"}) @?= Just "first-post")+ ]++ lowercaseS =+ testCase+ "%s is replaced by the original slug"+ (formatPath "%s" (def {dpUri = "https://example.com/today-is-my-birthday.php"}) @?= Just "today-is-my-birthday")++ lowercaseY =+ testCase+ "%y is replaced by the two-digit publication year"+ (formatPath "%y" (def {dpDate = fromGregorian 1917 01 01 0 0 0}) @?= Just "17")++ uppercaseY =+ testCase+ "%Y is replaced by the four-digit publication year"+ (formatPath "%Y" (def {dpDate = fromGregorian 1917 1 1 0 0 0}) @?= Just "1917")++ lowercaseM =+ testCase+ "%m is replaced by the two-digit publication month"+ (formatPath "%m" (def {dpDate = fromGregorian 2011 3 1 2 3 4}) @?= Just "03")++ lowercaseD =+ testCase+ "%d is replaced by the two-digit publication day"+ (formatPath "%d" (def {dpDate = fromGregorian 2013 1 31 0 0 0}) @?= Just "31")++ uppercaseH =+ testCase+ "%H is replaced by the two-digit publication hour, 00 to 23"+ (formatPath "%H" (def {dpDate = fromGregorian 2014 1 1 23 0 0}) @?= Just "23")++ uppercaseM =+ testCase+ "%M is replaced by the two-digit publication minute"+ (formatPath "%M" (def {dpDate = fromGregorian 2015 1 2 3 59 0}) @?= Just "59")++ uppercaseS =+ testCase+ "%S is replaced by the two-digit publication second"+ (formatPath "%S" (def {dpDate = fromGregorian 2016 1 2 3 4 0}) @?= Just "00")++ complexExamples =+ testGroup+ "format string can contain multiple formats"+ [ helper "%H:%M:%S" "18:30:02",+ helper "old/%Y/%m/%d-%H%M%S-%s.html" "old/2003/12/13-183002-hello-world.html",+ helper "/posts/%y-%m-%d-%H%M%S-%s/" "/posts/03-12-13-183002-hello-world/",+ helper "/migrated/%o" "/migrated/~joe/hello-world",+ helper "99.9%% true/%o" "99.9% true/~joe/hello-world"+ ]+ where+ post =+ DistilledPost+ { dpUri = "https://example.com/~joe/hello-world.php",+ dpBody = "",+ dpTitle = Nothing,+ dpTags = [],+ dpCategories = [],+ dpDate = fromGregorian 2003 12 13 18 30 2+ }++ helper format expected = testCase format (formatPath (T.pack format) post @?= Just expected)++ abortsProcessingOnUnknownFormat =+ testGroup+ "returns Nothing upon encountering an unsupported format"+ [ testCase "unknown format %x" (formatPath "%H%M%S-%x.html" def @?= Nothing),+ testCase "no format specifier after percent sign" (formatPath "%H%M%" def @?= Nothing)+ ]
+ test/spec/Spec/Wordpress.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}++module Spec.Wordpress (tests) where++import Data.DateTime (fromGregorian)+import qualified Data.Text as T+import qualified Data.XML.Types as XML+import Hakyll.Convert.Common (DistilledPost (..))+import Hakyll.Convert.Wordpress+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import qualified Text.RSS.Syntax as RSS++deriving instance Eq DistilledPost++deriving instance Show DistilledPost++tests :: TestTree+tests =+ testGroup+ "Wordpress.distill"+ [ extractsPostUri,+ extractsPostBody,+ combinesMultipleContentTags,+ extractsPostTitle,+ canSkipComments,+ canExtractComments,+ usesTheFirstCommentAuthorTag,+ turnsIncorrectDatesIntoEpochStart,+ parsesDates,+ extractsPostTags,+ extractsPostCategories+ ]++extractsPostUri :: TestTree+extractsPostUri =+ testGroup+ "extracts post's item link"+ [ testCase (T.unpack uri) (dpUri (distill False (createInput uri)) @?= uri)+ | uri <-+ [ "https://example.com/testing-post-uris",+ "http://www.example.com/~joe/posts.atom"+ ]+ ]+ where+ createInput uri =+ (RSS.nullItem "First post")+ { RSS.rssItemLink = Just uri+ }++contentTag :: XML.Name+contentTag =+ XML.Name+ { XML.nameLocalName = "encoded",+ XML.nameNamespace = Just "http://purl.org/rss/1.0/modules/content/",+ XML.namePrefix = Just "content"+ }++namedElement :: XML.Name -> [XML.Node] -> XML.Element+namedElement name nodes =+ XML.Element+ { XML.elementName = name,+ XML.elementAttributes = [],+ XML.elementNodes = nodes+ }++extractsPostBody :: TestTree+extractsPostBody =+ testGroup+ "extracts post's body"+ [ testCase (T.unpack body) (dpBody (distill False (createInput body)) @?= T.append body "\n")+ | body <-+ [ "<p>Today was a snowy day, and I decided to...</p>",+ "<h3>My opinion on current affairs</h3><p>So you see, I...</p>"+ ]+ ]+ where+ createInput body =+ (RSS.nullItem "Test post")+ { RSS.rssItemOther =+ [ namedElement contentTag [XML.NodeContent $ XML.ContentText body]+ ]+ }++combinesMultipleContentTags :: TestTree+combinesMultipleContentTags =+ testCase+ "combines multiple content:encoded tags into the post body"+ (dpBody (distill False input) @?= T.unlines [body1, body2])+ where+ body1 = "<h3>Welcome!</h3>"+ body2 = "<p>Hope you like my blog</p>"++ input =+ (RSS.nullItem "Just testing")+ { RSS.rssItemOther =+ [ createElement body1,+ createElement body2+ ]+ }+ createElement body = namedElement contentTag [XML.NodeContent $ XML.ContentText body]++extractsPostTitle :: TestTree+extractsPostTitle =+ testGroup+ "extracts post's title"+ [ testCase (T.unpack title) (dpTitle (distill False (RSS.nullItem title)) @?= Just title)+ | title <-+ [ "First post",+ "You won't believe what happened to me today",+ "Trying out <i>things</i>…"+ ]+ ]++commentTag :: XML.Name+commentTag =+ XML.Name+ { XML.nameLocalName = "comment",+ XML.nameNamespace = Just "http://wordpress.org/export/1.2/",+ XML.namePrefix = Just "wp"+ }++commentContentTag :: XML.Name+commentContentTag =+ XML.Name+ { XML.nameLocalName = "comment_content",+ XML.nameNamespace = Just "http://wordpress.org/export/1.2/",+ XML.namePrefix = Just "wp"+ }++commentDateTag :: XML.Name+commentDateTag =+ XML.Name+ { XML.nameLocalName = "comment_date",+ XML.nameNamespace = Just "http://wordpress.org/export/1.2/",+ XML.namePrefix = Just "wp"+ }++commentAuthorTag :: XML.Name+commentAuthorTag =+ XML.Name+ { XML.nameLocalName = "comment_author",+ XML.nameNamespace = Just "http://wordpress.org/export/1.2/",+ XML.namePrefix = Just "wp"+ }++canSkipComments :: TestTree+canSkipComments =+ testCase+ "does not extract comments if first argument is False"+ (dpBody (distill False input) @?= "<p>Hello, world!</p>\n")+ where+ input =+ (RSS.nullItem "Testing...")+ { RSS.rssItemOther =+ [ namedElement contentTag [XML.NodeContent $ XML.ContentText "<p>Hello, world!</p>"],+ namedElement+ commentTag+ [ XML.NodeContent $ XML.ContentText "<p>I'd like to point out that...</p>"+ ]+ ]+ }++canExtractComments :: TestTree+canExtractComments =+ testGroup+ "extracts comments if first argument is True"+ [ noDateNoAuthor,+ dateNoAuthor,+ noDateAuthor,+ dateAuthor+ ]+ where+ createInput comment =+ (RSS.nullItem "Testing...")+ { RSS.rssItemOther =+ [ namedElement contentTag [XML.NodeContent $ XML.ContentText "<p>Is this thing on?</p>"],+ comment+ ]+ }++ noDateNoAuthor =+ testCase+ "comments with no \"published\" date and no author"+ (dpBody (distill True (createInput noDateNoAuthorComment)) @?= expectedNoDateNoAuthor)+ noDateNoAuthorComment =+ namedElement+ commentTag+ [ XML.NodeElement $+ namedElement commentContentTag [XML.NodeContent $ XML.ContentText "<p>hi</p>"]+ ]+ expectedNoDateNoAuthor =+ "<p>Is this thing on?</p>\n\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, unknown author wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>hi</p>\n\+ \</div>\n\+ \</div>"++ dateNoAuthor =+ testCase+ "comments with a \"published\" date but no author"+ (dpBody (distill True (createInput dateNoAuthorComment)) @?= expectedDateNoAuthor)+ dateNoAuthorComment =+ namedElement+ commentTag+ [ XML.NodeElement $ namedElement commentContentTag [XML.NodeContent $ XML.ContentText "<p>hi</p>"],+ XML.NodeElement $ namedElement commentDateTag [XML.NodeContent $ XML.ContentText "2017-09-02 21:28:46"]+ ]+ expectedDateNoAuthor =+ "<p>Is this thing on?</p>\n\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On 2017-09-02 21:28:46, unknown author wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>hi</p>\n\+ \</div>\n\+ \</div>"++ noDateAuthor =+ testCase+ "comments with no \"published\" date but with an author"+ (dpBody (distill True (createInput commentNoDateAuthor)) @?= expectedNoDateAuthor)+ commentNoDateAuthor =+ namedElement+ commentTag+ [ XML.NodeElement $+ namedElement+ commentContentTag+ [XML.NodeContent $ XML.ContentText "<p>Here's the thing: …</p>"],+ XML.NodeElement $+ namedElement commentAuthorTag [XML.NodeContent $ XML.ContentText "Terry Jones"]+ ]+ expectedNoDateAuthor =+ "<p>Is this thing on?</p>\n\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, Terry Jones wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Here's the thing: …</p>\n\+ \</div>\n\+ \</div>"++ dateAuthor =+ testCase+ "comments with a \"published\" date and an author"+ (dpBody (distill True (createInput commentDateAuthor)) @?= expectedDateAuthor)+ commentDateAuthor =+ namedElement+ commentTag+ [ XML.NodeElement $+ namedElement+ commentContentTag+ [XML.NodeContent $ XML.ContentText "<p>It sure is!</p>"],+ XML.NodeElement $+ namedElement+ commentDateTag+ [XML.NodeContent $ XML.ContentText "2017-09-02 21:28:46"],+ XML.NodeElement $+ namedElement+ commentAuthorTag+ [XML.NodeContent $ XML.ContentText "Elizabeth Keyes"]+ ]+ expectedDateAuthor =+ "<p>Is this thing on?</p>\n\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On 2017-09-02 21:28:46, Elizabeth Keyes wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>It sure is!</p>\n\+ \</div>\n\+ \</div>"++usesTheFirstCommentAuthorTag :: TestTree+usesTheFirstCommentAuthorTag =+ testCase+ "uses the first wp:comment_author tag"+ (dpBody (distill True input) @?= expected)+ where+ input =+ (RSS.nullItem "Testing...")+ { RSS.rssItemOther =+ [ namedElement+ contentTag+ [XML.NodeContent $ XML.ContentText "<p>Check this out!</p>"],+ namedElement+ commentTag+ [ XML.NodeElement $ namedElement commentContentTag [XML.NodeContent $ XML.ContentText "<p>Cool!</p>"],+ XML.NodeElement $ namedElement commentAuthorTag [XML.NodeContent $ XML.ContentText "Alexander Batischev"],+ XML.NodeElement $ namedElement commentAuthorTag [XML.NodeContent $ XML.ContentText "John Doe"]+ ]+ ]+ }++ expected =+ "<p>Check this out!</p>\n\n\n\+ \<h3 id='hakyll-convert-comments-title'>Comments</h3>\n\+ \<div class='hakyll-convert-comment'>\n\+ \<p class='hakyll-convert-comment-date'>On unknown date, Alexander Batischev wrote:</p>\n\+ \<div class='hakyll-convert-comment-body'>\n\+ \<p>Cool!</p>\n\+ \</div>\n\+ \</div>"++turnsIncorrectDatesIntoEpochStart :: TestTree+turnsIncorrectDatesIntoEpochStart =+ testGroup+ "turns incorrect \"published\" dates into Unix epoch start date"+ [ testCase (T.unpack date) (dpDate (distill False (createInput date)) @?= expected)+ | date <-+ [ "First of April",+ "2020.07.30",+ "2020.07.30 00:01",+ "2020-07-30 00:01",+ "2020-07-30T00:01",+ "2020-07-30T00:01Z",+ "Sun, 31st July, 2020"+ ]+ ]+ where+ createInput date =+ (RSS.nullItem "Testing...")+ { RSS.rssItemPubDate = Just date+ }++ expected = fromGregorian 1970 1 1 0 0 0++parsesDates :: TestTree+parsesDates =+ testGroup+ "parses \"published\" dates"+ [ testCase (T.unpack dateStr) (dpDate (distill False (createInput dateStr)) @?= expected)+ | (dateStr, expected) <-+ [ ("Sun, 06 Nov 1994 08:49:37 GMT", fromGregorian 1994 11 6 8 49 37),+ ("Fri, 31 Jul 2020 22:21:59 EST", fromGregorian 2020 8 1 3 21 59)+ ]+ ]+ where+ createInput date =+ (RSS.nullItem "Testing...")+ { RSS.rssItemPubDate = Just date+ }++extractsPostTags :: TestTree+extractsPostTags =+ testCase+ "extracts post's tags"+ (dpTags (distill False input) @?= expected)+ where+ input =+ (RSS.nullItem "Testing tags here")+ { RSS.rssItemCategories =+ [ (RSS.newCategory "first tag") {RSS.rssCategoryDomain = Just "post_tag"},+ (RSS.newCategory "a non-tag") {RSS.rssCategoryDomain = Just "wrong domain"},+ (RSS.newCategory "second tag") {RSS.rssCategoryDomain = Just "post_tag"},+ (RSS.newCategory "another non-tag") {RSS.rssCategoryDomain = Nothing},+ (RSS.newCategory "third tag") {RSS.rssCategoryDomain = Just "post_tag"}+ ]+ }++ expected = ["first tag", "second tag", "third tag"]++extractsPostCategories :: TestTree+extractsPostCategories =+ testCase+ "extracts post's categories"+ (dpCategories (distill False input) @?= expected)+ where+ input =+ (RSS.nullItem "Testing categories here")+ { RSS.rssItemCategories =+ [ (RSS.newCategory "essays") {RSS.rssCategoryDomain = Just "category"},+ (RSS.newCategory "a non-category") {RSS.rssCategoryDomain = Just "wrong domain"},+ (RSS.newCategory "traveling") {RSS.rssCategoryDomain = Just "category"},+ (RSS.newCategory "another non-category") {RSS.rssCategoryDomain = Nothing}+ ]+ }++ expected = ["essays", "traveling"]
− tools/hakyll-convert.hs
@@ -1,144 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}--import Control.Applicative-import Control.Arrow-import Control.Monad-import qualified Data.ByteString as B-import Data.Char-import Data.Function-import Data.List-import Data.List-import Data.Maybe-import Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Time.Format (formatTime, defaultTimeLocale)-import System.Directory-import System.Environment-import System.FilePath--import System.Console.CmdArgs-import Text.RSS.Export-import Text.RSS.Import-import Text.RSS.Syntax-import Text.Atom.Feed-import Text.Atom.Feed.Export-import Text.Atom.Feed.Import-import Text.XML.Light--import Hakyll.Convert.Common-import Hakyll.Convert.OutputFormat-import qualified Hakyll.Convert.Blogger as Blogger-import qualified Hakyll.Convert.Wordpress as Wordpress--data InputFormat = Blogger | Wordpress- deriving (Data, Typeable, Enum, Show)--data Config = Config- { feed :: FilePath- , outputDir :: FilePath- -- underscore will be turned into a dash when generating a commandline- -- option- , output_format :: T.Text- , format :: InputFormat- , extract_comments :: Bool- }- deriving (Show, Data, Typeable)--parameters :: FilePath -> Config-parameters p = modes- [ Config- { feed = def &= argPos 0 &= typ "ATOM/RSS FILE"- , outputDir = def &= argPos 1 &= typDir- , output_format = "%o" &= help outputFormatHelp- , format = Blogger &= help "blogger or wordpress"- , extract_comments = False &= help "Extract comments (Blogger only)"- } &= help "Save blog posts Blogger feed into individual posts"- ] &= program (takeFileName p)--outputFormatHelp = unlines [- "Output filenames format (without extension)"- , "Default: %o"- , "Available formats:"- , " %% - literal percent sign"- , " %o - original filename (e.g. 2016/01/02/blog-post)"- , " %s - original slug (e.g. \"blog-post\")"- , " %y - publication year, 2 digits"- , " %Y - publication year, 4 digits"- , " %m - publication month"- , " %d - publication day"- , " %H - publication hour"- , " %M - publication minute"- , " %S - publication second"- ]---- --------------------------------------------------------------------------- -----------------------------------------------------------------------main = do- p <- getProgName- config <- cmdArgs (parameters p)-- let ofmt = output_format config-- if not (T.null ofmt || validOutputFormat ofmt)- then fail $ "Invalid output format string: `" ++ T.unpack (output_format config) ++ "'"- else case format config of- Blogger -> mainBlogger config- Wordpress -> mainWordPress config--mainBlogger :: Config -> IO ()-mainBlogger config = do- mfeed <- Blogger.readPosts (feed config)- case mfeed of- Nothing -> fail $ "Could not understand Atom feed: " ++ feed config- Just fd -> mapM_ process fd- where- process = savePost config "html" . Blogger.distill (extract_comments config)--mainWordPress :: Config -> IO ()-mainWordPress config = do- mfeed <- Wordpress.readPosts (feed config)- case mfeed of- Nothing -> fail $ "Could not understand RSS feed: " ++ feed config- Just fd -> mapM_ process fd- where- process = savePost config "markdown" . Wordpress.distill---- ------------------------------------------------------------------------ To Hakyll (sort of)--- Saving feed in bite-sized pieces--- ------------------------------------------------------------------------- | Save a post along with its comments as a mini atom feed-savePost :: Config -> String -> DistilledPost -> IO ()-savePost cfg ext post = do- putStrLn fname- createDirectoryIfMissing True (takeDirectory fname)- B.writeFile fname . T.encodeUtf8 $ T.unlines- [ "---"- , metadata "title" (formatTitle (dpTitle post))- , metadata "published" (formatDate (dpDate post))- , metadata "categories" (formatTags (dpCategories post))- , metadata "tags" (formatTags (dpTags post))- , "---"- , ""- , formatBody (dpBody post)- ]- where- metadata k v = k <> ": " <> v- odir = outputDir cfg- --- fname = odir </> postPath <.> ext- postPath = T.unpack $ fromJust $ formatPath (output_format cfg) post- --- formatTitle (Just t) = t- formatTitle Nothing =- "untitled (" <> T.unwords firstFewWords <> "…)"- where- firstFewWords = T.splitOn "-" . T.pack $ takeFileName postPath- formatDate = T.pack . formatTime defaultTimeLocale "%FT%TZ" --for hakyll- formatTags = T.intercalate ","- formatBody = id