diff --git a/Hakyll/Convert/Blogger.hs b/Hakyll/Convert/Blogger.hs
--- a/Hakyll/Convert/Blogger.hs
+++ b/Hakyll/Convert/Blogger.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
module Hakyll.Convert.Blogger
(FullPost(..), readPosts, distill)
where
@@ -20,8 +21,7 @@
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime)
-import Data.Time.Format (parseTime, formatTime)
-import System.Locale (defaultTimeLocale)
+import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Hakyll.Core.Compiler
import Hakyll.Core.Item
@@ -159,8 +159,8 @@
--
-- ---------------------------------------------------------------------
-distill :: FullPost -> DistilledPost
-distill fp = DistilledPost
+distill :: Bool -> FullPost -> DistilledPost
+distill extractComments fp = DistilledPost
{ dpBody = body fpost
, dpUri = fpUri fp
, dpTitle = title fpost
@@ -169,11 +169,37 @@
, dpDate = date fpost
}
where
- fpost = fpPost fp
+ fpost = fpPost fp
+ fcomments = fpComments fp
--
- body = fromContent . entryContent
+ body post =
+ let article = fromContent $ entryContent post
+ comments = T.intercalate "\n" $ map formatComment fcomments
+ in if extractComments
+ then T.intercalate "\n"
+ [ article
+ , ""
+ , ""
+ , comments]
+ else article
+
fromContent (Just (HTMLContent x)) = T.pack x
fromContent _ = error "Hakyll.Convert.Blogger.distill expecting HTML"
+
+ formatComment c = T.intercalate "\n" [
+ ""
+ ]
+ 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
@@ -181,16 +207,13 @@
tags = map (T.pack . catTerm)
. filter (not . isBloggerCategory)
. entryCategories
- date x = T.pack $
- case parseTime' =<< entryPublished x of
- Nothing -> "1970-01-01"
- Just d -> formatTime' d
- parseTime' d = msum $ map (\f -> parseTime defaultTimeLocale f d)
+ 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
]
- formatTime' :: UTCTime -> String
- formatTime' = formatTime defaultTimeLocale "%FT%TZ" --for hakyll
-- ---------------------------------------------------------------------
-- odds and ends
diff --git a/Hakyll/Convert/Common.hs b/Hakyll/Convert/Common.hs
--- a/Hakyll/Convert/Common.hs
+++ b/Hakyll/Convert/Common.hs
@@ -4,8 +4,12 @@
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
@@ -16,6 +20,16 @@
-- interested in ignoring tags and just focusing on categories
-- in cases where you have lots of little uninteresting tags.
, dpCategories :: [Text]
- , dpDate :: Text
+ , dpDate :: UTCTime
}
- deriving (Show, Data, Typeable)
+ deriving (Data, Typeable)
+
+instance Default DistilledPost where
+ def = DistilledPost
+ { dpUri = ""
+ , dpBody = ""
+ , dpTitle = Nothing
+ , dpTags = []
+ , dpCategories = []
+ , dpDate = posixSecondsToUTCTime 0
+ }
diff --git a/Hakyll/Convert/OutputFormat.hs b/Hakyll/Convert/OutputFormat.hs
new file mode 100644
--- /dev/null
+++ b/Hakyll/Convert/OutputFormat.hs
@@ -0,0 +1,89 @@
+{-# 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"
diff --git a/Hakyll/Convert/Wordpress.hs b/Hakyll/Convert/Wordpress.hs
--- a/Hakyll/Convert/Wordpress.hs
+++ b/Hakyll/Convert/Wordpress.hs
@@ -10,8 +10,7 @@
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime)
-import Data.Time.Format (parseTime, formatTime)
-import System.Locale (defaultTimeLocale, rfc822DateFormat)
+import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale, rfc822DateFormat)
import Text.XML.Light
import Text.RSS.Import
import Text.RSS.Syntax
@@ -57,13 +56,11 @@
}
--
date = case parseTime' =<< rssItemPubDate item of
- Nothing -> "1970-01-01"
- Just d -> T.pack (formatTime' d)
- parseTime' d = msum $ map (\f -> parseTime defaultTimeLocale f d)
+ Nothing -> fromJust $ parseTime' "1970-01-01T00:00:00Z"
+ Just d -> d
+ parseTime' d = msum $ map (\f -> parseTimeM True defaultTimeLocale f d)
[ rfc822DateFormat
]
- formatTime' :: UTCTime -> String
- formatTime' = formatTime defaultTimeLocale "%FT%TZ" --for hakyll
-- ---------------------------------------------------------------------
-- helpers
diff --git a/hakyll-convert.cabal b/hakyll-convert.cabal
--- a/hakyll-convert.cabal
+++ b/hakyll-convert.cabal
@@ -2,14 +2,18 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: hakyll-convert
-version: 0.1.0.0
+version: 0.2.0.0
synopsis: Convert from other blog engines to Hakyll.
--- description:
-homepage: http://github.com/kowey/hakyll-convert
+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
-maintainer: Eric Kow
+author: Eric Kow , Alexander Batischev
+maintainer: Alexander Batischev
-- copyright:
category: Web
build-type: Simple
@@ -19,12 +23,15 @@
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
- , old-locale
, text
, time
, xml
@@ -41,13 +48,5 @@
, filepath
, hakyll-convert
, text
+ , time
, xml
-
-executable hakyll-convert-demo
- main-is: hakyll-convert-demo.hs
- hs-source-dirs: tools
- -- other-modules:
- build-depends: base
- , hakyll
- , hakyll-convert
- , filepath
diff --git a/tools/hakyll-convert-demo.hs b/tools/hakyll-convert-demo.hs
deleted file mode 100644
--- a/tools/hakyll-convert-demo.hs
+++ /dev/null
@@ -1,151 +0,0 @@
---------------------------------------------------------------------------------
-{-# LANGUAGE OverloadedStrings #-}
-import Control.Applicative ((<$>))
-import Data.Monoid ((<>),mappend,mconcat)
-import Hakyll
-
-import Hakyll.Convert.Blogger
-import Debug.Trace
-
---------------------------------------------------------------------------------
-main :: IO ()
-main = hakyll $ do
- match "images/*" $ do
- route idRoute
- compile copyFileCompiler
-
- match "css/*" $ do
- route idRoute
- compile compressCssCompiler
-
- match (fromList ["about.markdown"]) $ do
- route $ setExtension "html"
- compile $ pandocCompiler
- >>= loadAndApplyTemplate "templates/default.html" defaultContext
- >>= relativizeUrls
-
- -- distilled <- match koweycodePattern $ compile bloggerCompiler
-
- -- tags0 <- buildTags "posts/*" (fromCapture "tags/*.html")
- tags <- buildTags koweycodePattern (fromCapture "tags/*.html")
-
-{-
- match "posts/*" $ do
- route $ setExtension "html"
- compile $ pandocCompiler
- >>= loadAndApplyTemplate "templates/post.html" (postCtx tags)
- >>= loadAndApplyTemplate "templates/default.html" (postCtx tags)
- >>= relativizeUrls
--}
-
- match koweycodePattern $ do
- route $ setExtension "html"
- compile $ pandocCompiler -- TODO shouldn't be needed
- >>= loadAndApplyTemplate "templates/post.html" (postCtx tags)
- >>= loadAndApplyTemplate "templates/default.html" (postCtx tags)
- >>= relativizeUrls
-
- -- Post tags
- tagsRules tags $ \tag pattern -> do
- let title = "Posts tagged " ++ tag
- archiveCtx = archiveContext "Posts tagged" tags pattern
-
- -- Copied from posts, need to refactor
- route idRoute
- compile $ do
- list <- postList tags pattern recentFirst
- makeItem ""
- >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
- >>= loadAndApplyTemplate "templates/default.html" defaultContext
- >>= relativizeUrls
-
-{-
- -- Create RSS feed as well
- version "rss" $ do
- route $ setExtension "xml"
- compile $ loadAllSnapshots pattern "content"
- >>= fmap (take 10) . recentFirst
- >>= renderAtom (feedConfiguration title) feedCtx
--}
-
- let plainPattern = "posts/*"
-
- create ["archive.html"] $ do
- route idRoute
- compile $ do
- let archiveCtx = archiveContext "Archives" tags koweycodePattern
- makeItem ""
- >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
- >>= loadAndApplyTemplate "templates/default.html" archiveCtx
- >>= relativizeUrls
-
- match "index.html" $ do
- route idRoute
- compile $ do
- let indexCtx = field "posts" $ \_ -> postList tags koweycodePattern (fmap (take 3) . recentFirst)
-
- getResourceBody
- >>= applyAsTemplate indexCtx
- >>= loadAndApplyTemplate "templates/default.html" (postCtx tags)
- >>= relativizeUrls
-
- match "templates/*" $ compile templateCompiler
- where
- koweycodePattern = "koweycode/**"
-
-archiveContext title tags pattern =
- field "posts" (const getList) `mappend`
- constField "title" title `mappend`
- defaultContext
- where
- getList = postList tags pattern recentFirst
-
-
---------------------------------------------------------------------------------
-{-
-postCtx :: Context String
-postCtx =
- dateField "date" "%e %B %Y" `mappend`
- defaultContext
--}
-
-postCtx :: Tags -> Context String
-postCtx tags = mconcat
- [ modificationTimeField "mtime" "%U"
- , dateField "date" "%e %B %Y"
- , tagsField "tags" tags
- , defaultContext
- ]
-
---------------------------------------------------------------------------------
-
-postList :: Tags -> Pattern -> ([Item String] -> Compiler [Item String])
- -> Compiler String
-postList tags pattern sortFilter = do
- posts <- sortFilter =<< loadAll pattern
- itemTpl <- loadBody "templates/post-item.html"
- applyTemplateList itemTpl (postCtx tags) posts
-
-{-
-
-postList :: ([Item String] -> [Item String]) -> Compiler String
-postList sortFilter = do
- posts1_ <- loadAll "posts/*"
- --posts2_ <- loadAll "koweycode/*/*/*"
- let posts1 = posts1_
- posts2 = []
- let posts = sortFilter (posts1 ++ posts2)
- itemTpl <- loadBody "templates/post-item.html"
- list <- applyTemplateList itemTpl postCtx posts
- return list
-
--}
-
-{-
-oldPostList :: ([Item String] -> [Item String]) -> Compiler String
-oldPostList sortFilter = do
- posts <- sortFilter <$> loadAll "koweycode/*/*/*"
- itemTpl <- loadBody "templates/post-item.html"
- list <- applyTemplateList itemTpl postCtx posts
- return list
--}
diff --git a/tools/hakyll-convert.hs b/tools/hakyll-convert.hs
--- a/tools/hakyll-convert.hs
+++ b/tools/hakyll-convert.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
import Control.Applicative
import Control.Arrow
@@ -14,6 +13,7 @@
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
@@ -28,6 +28,7 @@
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
@@ -35,21 +36,43 @@
deriving (Data, Typeable, Enum, Show)
data Config = Config
- { feed :: FilePath
- , outputDir :: FilePath
- , format :: InputFormat
+ { 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
- , format = Blogger &= help "blogger or wordpress"
+ { 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"
+ ]
+
-- ---------------------------------------------------------------------
--
-- ---------------------------------------------------------------------
@@ -57,10 +80,15 @@
main = do
p <- getProgName
config <- cmdArgs (parameters p)
- case format config of
- Blogger -> mainBlogger config
- Wordpress -> mainWordPress config
+ 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)
@@ -68,7 +96,7 @@
Nothing -> fail $ "Could not understand Atom feed: " ++ feed config
Just fd -> mapM_ process fd
where
- process = savePost config "html" . Blogger.distill
+ process = savePost config "html" . Blogger.distill (extract_comments config)
mainWordPress :: Config -> IO ()
mainWordPress config = do
@@ -104,53 +132,13 @@
odir = outputDir cfg
--
fname = odir postPath <.> ext
- postPath = 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
+ 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 = id
+ formatDate = T.pack . formatTime defaultTimeLocale "%FT%TZ" --for hakyll
formatTags = T.intercalate ","
formatBody = id
-
-{-
--- Ugh! convert br tags inside of pre tags
-fixupBloggerHtml :: Content -> Content
-fixupBloggerHtml = descendElem $ \e ->
- if elName e == unqual "pre"
- then Just . Elem $
- e { elContent = map (descendElem fixBr) (elContent e) }
- else Nothing
- where
- fixBr e =
- if elName e == unqual "br"
- then Just (Text newline)
- else Nothing
- newline = CData CDataRaw "\n" Nothing
-
-descendElem pred (Elem e) =
- case pred e of
- Nothing -> Elem $ e { elContent = map (descendElem pred) (elContent e) }
- Just e2 -> e2
-descendElem _ x = x
--}
-
--- ---------------------------------------------------------------------
--- utilities
--- ---------------------------------------------------------------------
-
-dropPrefix :: Eq a => [a] -> [a] -> ([a],[a])
-dropPrefix (x:xs) (y:ys) | x == y = dropPrefix xs ys
-dropPrefix left right = (left,right)
" + , "On ", pubdate, ", ", author, " wrote:" + , "
" ] + , "