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.