blob: 78129ff6a5da650efc27baaf9917d35fff554a1b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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
|
