pandoc.hs 2.02 KB
Newer Older
Henrik Tramberend's avatar
Henrik Tramberend committed
1 2
{-- Author: Henrik Tramberend <henrik@tramberend.de> --} 

Henrik Tramberend's avatar
Henrik Tramberend committed
3
module Pandoc
4 5
  (
  ) where
Henrik Tramberend's avatar
Henrik Tramberend committed
6

Henrik Tramberend's avatar
Henrik Tramberend committed
7 8 9 10
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
11
import Data.Digest.Pure.MD5
Henrik Tramberend's avatar
Henrik Tramberend committed
12 13 14
import qualified Data.HashMap.Strict as H
import Data.List
import qualified Data.Map as M
15
import Data.Maybe
Henrik Tramberend's avatar
Henrik Tramberend committed
16
import qualified Data.MultiMap as MM
17
import qualified Data.Text as T
Henrik Tramberend's avatar
Henrik Tramberend committed
18
import qualified Data.Yaml as Y
19
import Debug.Trace
Henrik Tramberend's avatar
Henrik Tramberend committed
20
import Development.Shake
Henrik Tramberend's avatar
Henrik Tramberend committed
21 22 23 24 25 26
import Network.HTTP.Conduit
import Network.HTTP.Simple
import Network.HTTP.Types.Status
import Network.URI
import System.Directory
import System.FilePath.Posix
Henrik Tramberend's avatar
Henrik Tramberend committed
27 28
import Text.Pandoc
import Text.Pandoc.Walk
Henrik Tramberend's avatar
Henrik Tramberend committed
29 30 31 32 33
import Utilities

type MetaData = M.Map FilePath Y.Value

readMetaData :: [FilePath] -> IO MetaData
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
readMetaData metaFiles = do
  canonMetaFiles <- mapM canonicalizePath metaFiles
  aDataList <- mapM decodeYaml canonMetaFiles
  let joined = M.map joinHorizontally $ MM.toMap $ MM.fromList aDataList
  return $ M.mapWithKey (joinVertically joined) joined
  where
    decodeYaml :: FilePath -> IO (FilePath, Y.Value)
    decodeYaml file = do
      result <- Y.decodeFileEither file
      case result of
        Right object@(Y.Object _) -> return (takeDirectory file, object)
        Right _ ->
          throw $
          YamlException $ "Top-level meta value must be an object: " ++ file
        Left exception -> throw exception
    joinHorizontally :: [Y.Value] -> Y.Value
    joinHorizontally = foldl1 joinMeta
    joinVertically :: MetaData -> FilePath -> Y.Value -> Y.Value
    joinVertically meta dir ignore =
      if not $ equalFilePath dir "/"
        then let up = joinVertically meta (takeDirectory dir) ignore
             in maybe up (joinMeta up) (M.lookup dir meta)
        else Y.Object (H.fromList [])
    joinMeta :: Y.Value -> Y.Value -> Y.Value
    joinMeta (Y.Object old) (Y.Object new) = Y.Object (H.union new old)
    joinMeta _ _ = throw $ YamlException "Can only join YAML objects."
60
-- extractMetaDataFromMarkdown :: T.Text -> Y.Value