1 files changed, 57 insertions, 0 deletions
diff --git a/cachetheyaml.hs b/cachetheyaml.hs
new file mode 100644
index 0000000..78129ff
--- /dev/null
+++ b/cachetheyaml.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Control.Exception.Base as E
+import qualified Data.FileStore as DF
+import qualified Data.List as L
+import qualified Data.List.Split as DLS
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import qualified Data.ByteString.Char8 as DBC8
+import qualified Data.ByteString as DB
+import qualified Data.ByteString.Lazy as DBL
+import qualified Data.Text as T
+import qualified Data.Yaml as Y
+import System.IO (hPutStr, hPutStrLn, stderr)
+
+isLeft :: Either a b -> Bool
+isLeft (Left  _) = True
+isLeft (Right _) = False
+
+markdownFiles :: [FilePath] -> [FilePath]
+markdownFiles = filter (L.isSuffixOf ".mdwn")
+
+extractYAML :: [DB.ByteString] -> [DB.ByteString]
+extractYAML x
+  | elem topDelim x && elem bottomDelim x = DLS.splitOneOf [topDelim,bottomDelim] x !! 1
+  | otherwise = [DB.empty]
+    where topDelim = DBC8.pack "--YAML--"
+          bottomDelim = DBC8.pack "..."
+
+revisionToContents :: (FilePath, DF.RevisionId) -> IO DBL.ByteString
+revisionToContents (p,r) = E.catch (DF.retrieve repo p (Just r))
+                                   (\e -> do let err = show (e :: E.IOException)
+                                             hPutStr stderr ("Warning: Couldn't retrieve " ++ show (p,r) ++ ": " ++ err)
+                                             return DBL.empty)
+
+contentsToYAML :: DBL.ByteString -> Either Y.ParseException (Map.Map T.Text T.Text)
+contentsToYAML = fmap denullify . Y.decodeEither' . DBC8.unlines . extractYAML . DBC8.lines . DBL.toStrict
+    where
+        denullify :: Map.Map T.Text (Maybe T.Text) -> Map.Map T.Text T.Text
+	denullify = Map.map (fromMaybe "")
+
+stampFilename :: FilePath -> Map.Map T.Text T.Text -> Map.Map T.Text T.Text
+stampFilename = Map.insert "filename" . T.pack
+
+repo :: DF.FileStore
+repo = DF.gitFileStore "."
+
+main :: IO ()
+main = do
+   repofiles <- DF.index repo
+   let markdowns = markdownFiles repofiles
+   latestrevs <- mapM (DF.latest repo) markdowns
+   repodata <- mapM revisionToContents (zip markdowns latestrevs)
+   let repocontents = map contentsToYAML repodata
+       allfilemapping = zipWith (stampFilename) markdowns (map (either (const Map.empty) id) repocontents)
+   mapM_ (hPutStrLn stderr . show) (filter (\(_,y) -> isLeft y) (zip markdowns repocontents))
+   Y.encodeFile "/home/report/tmp/yamlcache.yaml" allfilemapping