chriswarbo-net: 957ff9530fd5fda709cca9bedd05c57a5312d7c3
1: #!/usr/bin/env runhaskell
2: {-# LANGUAGE OverloadedStrings #-}
3:
4: import Control.Monad
5: import Data.Aeson
6: import qualified Data.ByteString.Lazy as BS
7: import Data.Default
8: import qualified Data.HashMap.Strict as HM
9: import Data.Microformats2.Parser
10: import qualified Data.Vector as V
11: import Network.URI
12: import System.Directory
13: import System.Environment
14:
15: parse = parseMf2 def . documentRoot . parseLBS
16:
17: isHentry :: Value -> Bool
18: isHentry (Object o) = case HM.lookup "type" o of
19: Just (Array types) -> V.elem (String "h-entry") types
20: _ -> False
21: isHentry _ = False
22:
23: getHentries :: Value -> [Value]
24: getHentries v = case v of
25: Object o -> if isHentry (Object o)
26: then [Object o]
27: else HM.foldl' acc [] o
28: Array a -> V.foldl' acc [] a
29: _ -> []
30: where acc result val = result ++ getHentries val
31:
32: hasOneHentry :: Value -> Bool
33: hasOneHentry = (== 1) . length . getHentries
34:
35: stringHasOneHentry = hasOneHentry . parse
36:
37: blogFiles :: IO [FilePath]
38: blogFiles = do dir <- blogDir
39: contents <- getDirectoryContents dir
40: return (filter (`notElem` [".", "..", "index.html"]) contents)
41:
42: blogDir :: IO FilePath
43: blogDir = fmap (++ "/blog") (getEnv "rendered")
44:
45: blogsWithoutEntry :: IO [FilePath]
46: blogsWithoutEntry = blogFiles >>= filterM missing
47: where missing f = do dir <- blogDir
48: keep <$> BS.readFile (dir ++ "/" ++ f)
49: keep = not . hasOneHentry . parse
50:
51: main = do
52: without <- blogsWithoutEntry
53: if null without
54: then return ()
55: else error ("Expected one h-entry in " ++ show without)
Generated by git2html.