hakyll-convert 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+200/−241 lines, 7 filesdep +containersdep +data-defaultdep −old-localenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, data-default

Dependencies removed: old-locale

API changes (from Hackage documentation)

Files

• Hakyll/Convert/Blogger.hs +36/−13
• Hakyll/Convert/Common.hs +16/−2
• Hakyll/Convert/OutputFormat.hs +89/−0
• Hakyll/Convert/Wordpress.hs +4/−7
• hakyll-convert.cabal +14/−15
• tools/hakyll-convert-demo.hs +0/−151
• tools/hakyll-convert.hs +41/−53

@@ -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+                              , ""+                              , "<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@@ -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

@@ -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+    }

@@ -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"

@@ -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

@@ -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 <eric.kow@gmail.com>-maintainer:          Eric Kow <eric.kow@gmail.com>+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@@ -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

@@ -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--}

@@ -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)