[Trimmed out import project; no longer needed and easier for folks to roll their own. prb@mult.ifario.us**20080203223243] { hunk ./perpubplat_import/LICENSE 1 -Copyright (c) 2008, Multfiarious, Inc. - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of the Multifarious, Inc. nor the names of its - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. rmfile ./perpubplat_import/LICENSE hunk ./perpubplat_import/Setup.lhs 1 -#!/usr/bin/env runghc - -> module Main where -> import Distribution.Simple - -> main :: IO () -> main = defaultMain rmfile ./perpubplat_import/Setup.lhs hunk ./perpubplat_import/perpubplat_import.cabal 1 -name: PerpubplatImporter -version: 0.9 -copyright: Copyright 2008 Multifarious, Inc. -description: Convert JSON exported from Typo into the internal perpubplat format. -license: BSD3 -license-file: LICENSE -author: Paul Brown -homepage: http://datapr0n.com/perpubplat -maintainer: Paul Brown -build-depends: base >= 2.0, parsec >= 2.0, xhtml >= 3000, json >= 0.1, perpubplat >= 0.9, - haskell98, containers, filepath >= 1.1, old-time >= 1.0, directory >= 1.0 - - -executable: import-typo -main-is: typo_importer.hs -hs-source-dirs: src -ghc-options: -O -Werror -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-matches rmfile ./perpubplat_import/perpubplat_import.cabal hunk ./perpubplat_import/src/Import.hs 1 -module Import where - -import qualified Blog.Model.Entry as B -import qualified Blog.BackEnd.IoOperations as I - -import qualified Text.Json as J -import qualified Data.Map as M -import Data.Map (Map, (!)) -import List -import qualified Text.ParserCombinators.Parsec as P -import Monad - -type JsonEntry = Map String J.Value - -unR (Right r) = r - -unO :: J.Value -> JsonEntry -unO (J.Object o) = o - -unA :: J.Value -> [J.Value] -unA (J.Array a) = a - -unV :: J.Value -> String -unV (J.String s) = s -unV (J.Null) = "" - -{- Functions for extracting specific values from a JSON representation of an entry or comment or trackback. -} -published_at_ :: JsonEntry -> String -published_at_ = munge . unV . (M.! "published_at") - -created_at_ :: JsonEntry -> String -created_at_ = munge . unV . (M.! "created_at") - -body_ :: JsonEntry -> String -body_ = unV . (M.! "body") - -updated_at_ :: JsonEntry -> String -updated_at_ = munge . unV . (M.! "updated_at") - -tags_ :: JsonEntry -> [String] -tags_ = words . unV . (M.! "keywords") - -title_ :: JsonEntry -> String -title_ = unV . (M.! "title") - -excerpt_ :: JsonEntry -> Maybe String -excerpt_ = blankIsNothing . unV . (M.! "excerpt") - -guid_ :: JsonEntry -> String -guid_ = unV . (M.! "guid") - -categories_ :: JsonEntry -> [String] -categories_ = const [] - -permatitle_ :: JsonEntry -> String -permatitle_ = unV . (M.! "permalink") - -published_ :: JsonEntry -> Bool -published_ m = ((unV . (M.! "published")) m) == "1" - -id_ :: JsonEntry -> String -id_ = unV . (M.! "id") - -article_id_ :: JsonEntry -> String -article_id_ = unV . (M.! "article_id") - -email_ :: JsonEntry -> Maybe String -email_ = blankIsNothing . unV . (M.! "email") - -author_ :: JsonEntry -> String -author_ = unV . (M.! "author") - -uri_ :: JsonEntry -> Maybe String -uri_ = blankIsNothing . unV . (M.! "url") - -author = B.Author "Paul Brown" (Just "http://mult.ifario.us") (Just "prb@mult.ifario.us") True - -{- pull a JSON dump of Typo entries into memory -} -load_typo_entries :: String -> IO [JsonEntry] -load_typo_entries file = (liftM (map unpack2)) (unpack1 json) - where unpack1 = liftM (unA.unR) - unpack2 = unO . (M.! "attributes") . unO - json = (P.parseFromFile J.json file) - - --- | Convert a typo article into a top-level blog posting. -convert_typo_entry :: JsonEntry -> B.Item -convert_typo_entry m = B.Item 0 (B.Post) (title_ m) (excerpt_ m) - (cleanup_ $ body_ m) ((tags_ m) ++ (categories_ m)) ("http://mult.ifario.us/p/" ++ ptitle) - (ptitle) (published_at_ m) - (updated_at_ m) author (published_ m) Nothing - where - ptitle = fix_up_permalink $ permatitle_ m - -{- Convert a comment or trackback into a blog posting ready to be appended to a specific top-level post. -} -convert_typo_comment :: JsonEntry -> B.Item -convert_typo_comment m = let c = (convert_typo_entry m) in - c { B.author = comment_author m, - B.kind = B.Comment, - B.permatitle = "comment-" ++ (show $ B.internal_id c )} - -comment_author :: JsonEntry -> B.Author -comment_author m = B.Author (author_ m) (uri_ m) (email_ m) False - -{- Down and dirty conversion from, e.g., 2007-01-01 12:00:00 to 2007-01-01T12:00:00Z -} -munge :: String -> String -munge s = (date s) ++ 'T':(time s) ++ "Z" - where - date = (take 10) - time = reverse.(take 8).reverse - -{- most of the permalinks are relative -} -fix_up_permalink :: String -> String -fix_up_permalink s = fix_up_permalink_ [] s - -fix_up_permalink_ :: String -> String -> String -fix_up_permalink_ s [] = reverse s -fix_up_permalink_ t s | (take 5 s == "8220-") || - (take 5 s == "8221-") || - (take 5 s == "-8221") || - (take 5 s == "-8220") = fix_up_permalink_ t (drop 5 s) -fix_up_permalink_ t (s:ss) = fix_up_permalink_ (s:t) ss - -group_comments :: [JsonEntry] -> [[JsonEntry]] -group_comments = groupBy (\x y -> (article_id_ x) == (article_id_ y)) - -presort_comments :: [[JsonEntry]] -> [[JsonEntry]] -presort_comments = map (sortBy (\x y -> compare (created_at_ x) (created_at_ y))) - -type LegacyId = String -type Permatitle = String -type LegacyIdToPermatitleMap = Map LegacyId Permatitle - -map_legacy_ids :: [JsonEntry] -> LegacyIdToPermatitleMap -map_legacy_ids p = map_legacy_ids_ p M.empty - -map_legacy_ids_ :: [JsonEntry] -> LegacyIdToPermatitleMap -> LegacyIdToPermatitleMap -map_legacy_ids_ [] m = m -map_legacy_ids_ (p:ps) m = map_legacy_ids_ ps (M.insert (id_ p) (permatitle_ p) m) - --- | Map permatitle to the list of comments/trackbacks on it. -type CommentMap = Map String [B.Item] - -map_comments :: LegacyIdToPermatitleMap -> [[JsonEntry]] -> CommentMap -map_comments lipm c = map_comments_ lipm c M.empty - -map_comments_ :: LegacyIdToPermatitleMap -> [[JsonEntry]] -> CommentMap -> CommentMap -map_comments_ _ [] m = m -map_comments_ lipm (c:cs) m = let cx = map (convert_typo_comment) c in - map_comments_ lipm cs - (M.insert ((M.! (article_id_$head c)) lipm) cx m) - -set_parent :: B.Item -> B.Item -> B.Item -set_parent par chil = chil { B.parent = Just ( B.internal_id par ), - B.uid = (B.uid par) ++ "#" ++ (B.permatitle chil) } - -blankIsNothing :: String -> Maybe String -blankIsNothing "" = Nothing -blankIsNothing s = Just s - -uniquify_permatitles :: [String] -> [B.Item] -> [B.Item] -> [B.Item] -uniquify_permatitles _ p [] = p -uniquify_permatitles t d (n:ns) = if ((B.permatitle n) `elem` t) then - uniquify_permatitles (pt:t) ((n { B.permatitle = (uniquify t pt)}):d) ns - else - uniquify_permatitles (pt:t) (n:d) ns - where - pt = B.permatitle n - -uniquify :: [String] -> String -> String -uniquify s t = t ++ '-':(show $ length (filter ((==) t) s)) - -apply_parents :: Map String B.Item -> [(String,[B.Item])] -> [B.Item] -apply_parents pi cm = concat $ map (\(x,y) -> (map (set_parent (pi ! (fix_up_permalink x))) y)) cm - -build_content :: [String] -> [String] -> IO () -build_content entry_json_files comment_json_files = - do { raw_entries <- (liftM concat) $ mapM load_typo_entries entry_json_files - ; raw_comments <- (liftM concat) $ mapM load_typo_entries comment_json_files - ; let entries' = map (convert_typo_entry) raw_entries - ; let li = map_legacy_ids raw_entries - ; let cm = map_comments li ((presort_comments . group_comments) raw_comments) - ; let permatitle_x_item = M.fromList (zip (map B.permatitle entries') entries') - ; let comments = apply_parents permatitle_x_item (M.toList cm) - ; I.dump $ B.build_model (entries' ++ comments) } - -replace_with :: String -> String -> String -> String -replace_with old new source = replace_with_ old (reverse new) source [] - -replace_with_ :: String -> String -> String -> String -> String -replace_with_ _ _ [] work = reverse work -replace_with_ old wen inp@(i:is) work | old `isPrefixOf` inp = replace_with_ old wen (drop (length old) inp) (wen ++ work) - | otherwise = replace_with_ old wen is (i:work) - --- A few automated clean-ups to help things along. -cleanup_ :: String -> String -cleanup_ = (replace_with "—" "—") - . (replace_with " " " ") - . (replace_with "»" "»") - . (replace_with "«" "«") - . (replace_with "’" "'") - . (replace_with "" "
")
-           . (replace_with "" "
") - . (replace_with "" "
")
-           . (replace_with "" "
")
-           . (replace_with "" "
")
-           . (replace_with "" "
")
-           . (replace_with "" "
")
rmfile ./perpubplat_import/src/Import.hs
hunk ./perpubplat_import/src/typo_importer.hs 1
-import Import
-
-q :: String -> String
-q s = "/Users/prb/work/hblog/data/" ++ s
-
-main :: IO ()
-main = build_content
-       [q "entries.json",q "other_entries.json"]
-       [q "comments.json", q "trackbacks.json"]
+
rmfile ./perpubplat_import/src/typo_importer.hs
rmdir ./perpubplat_import/src
rmdir ./perpubplat_import
}