diff --git a/migrate.hs b/migrate.hs new file mode 100644 index 0000000..5f6c6ff --- /dev/null +++ b/migrate.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} +import Debug.Trace +import Data.Conduit +import qualified Data.Conduit.List as CL +import Data.Conduit.Filesystem +import Data.Text (Text) +import qualified Filesystem.Path.CurrentOS as F +import qualified Filesystem as F +import qualified Data.Map as Map +import Control.Monad +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified Data.Text.Lazy.IO as TLIO +import Data.Text.Lazy.Builder +import Data.Monoid +import qualified Data.Attoparsec.Text as A +import Control.Applicative (many, (<|>)) + +type Contents = [Content] + +type Title = Text + +data Content = Text Text | Link + { linkPath :: F.FilePath + , linkText :: Text + } + deriving Show + +main :: IO () +main = do + files <- runResourceT $ traverse False "old" $$ CL.filter (flip F.hasExtension "markdown") =$ CL.mapM load =$ CL.consume + let titleMap' = Map.unionsWith (++) $ map (\(t, _, c) -> Map.singleton t [c]) files + titleMap <- fmap Map.fromList $ forM (Map.toList titleMap') (\(k, sv) -> do + case sv of + [v] -> return (k, v) + _ -> error $ "Duplicated title: " ++ show k) + + let fileMap = Map.fromList $ map (\(t, fp, _) -> (fp, t)) files + + mapM_ (output fileMap) $ Map.toList titleMap + +--output :: (Title, Contents) -> IO () +output fileMap (title, cs) = + TLIO.writeFile (F.encodeString fp) $ toLazyText $ mconcat $ map build cs + where + fp = F.fromText title' F.<.> "md" + title' = T.map fix title + fix ' ' = '-' + fix '/' = '-' + fix c = c + + build (Text t) = fromText t + build (Link fp t) = mconcat + [ "[[" + , fromText t + , "|" + , fromText link + , "]]" + ] + where + link = + case Map.lookup fp fileMap of + Nothing -> "missing:" `T.append` either id id (F.toText fp) + Just x -> x + +load :: F.FilePath -> IO (Title, F.FilePath, Contents) +load fp = do + full <- fmap (T.filter (/= '\r')) $ TIO.readFile $ F.encodeString fp + let (mtitle, body) = + case T.stripPrefix "Title: " full of + Nothing -> (Nothing, full) + Just rest -> + let (x, y) = T.break (== '\n') rest + in (Just x, T.drop 1 y) + niceDir <- + case T.stripPrefix "./old/" $ either id id $ F.toText $ F.directory fp of + Nothing -> error $ "huh? " ++ show (F.toText (F.directory fp)) + Just x + | not (T.null x) && T.last x == '/' -> return $ T.init x + | otherwise -> return x + let title = + case mtitle of + Nothing -> niceDir + Just title -> fst (T.breakOnEnd "/" niceDir) `T.append` title + + contents <- either error return $ A.parseOnly parseContents body + return (title, fp, contents) + +parseContents = many parseContent + +parseContent = A.try parseLink <|> + fmap Text (A.string "[") <|> + fmap Text (A.takeWhile1 (/= '[')) + +parseLink = do + A.char '[' + linktext <- A.takeWhile (/= ']') + A.string "](" + href <- A.takeWhile (/= ')') + A.char ')' + href' <- fmap (T.replace "%20" " ") $ stripWiki href + let fp = "old" F. F.fromText href' F. "index.markdown" + return $ Link fp linktext + +stripWiki t + | Just x <- T.stripPrefix "http://www.yesodweb.com/wiki/" t = return x + | Just x <- T.stripPrefix "/wiki/" t = return x + | otherwise = {-traceShow t $ -}fail ""