Included migration script

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