diff options
Diffstat (limited to 'cachetheyaml.hs')
-rw-r--r-- | cachetheyaml.hs | 57 |
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 |