@@ -0,0 +1,121 @@
2+Copyright (C) 2013 John MacFarlane <jgm@berkeley.edu>
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20+ Module : Text.Pandoc.Writers.Shared
21+ Copyright : Copyright (C) 2013 John MacFarlane
22+ License : GNU GPL, version 2 or above
24+ Maintainer : John MacFarlane <jgm@berkeley.edu>
26+ Portability : portable
28+Shared utility functions for pandoc writers.
30+module Text.Pandoc.Writers.Shared (
37+import Text.Pandoc.Definition
38+import Control.Monad (liftM)
39+import Text.Pandoc.Options (WriterOptions(..))
40+import qualified Data.HashMap.Strict as H
41+import qualified Data.Map as M
42+import qualified Data.Text as T
43+import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..))
44+import qualified Data.Traversable as Traversable
46+-- | Create JSON value for template from a 'Meta' and an association list
47+-- of variables, specified at the command line or in the writer.
48+-- Variables overwrite metadata fields with the same names.
49+-- If multiple variables are set with the same name, a list is
53+ -> ([Block] -> m String)
54+ -> ([Inline] -> m String)
57+metaToJSON opts blockWriter inlineWriter (Meta metamap)
58+ | writerStandalone opts = do
59+ let baseContext = foldl (\acc (x,y) -> setField x y acc) (Object H.empty)
60+ $ writerVariables opts
61+ renderedMap <- Traversable.mapM
62+ (metaValueToJSON blockWriter inlineWriter)
64+ return $ M.foldWithKey (\key val obj -> defField key val obj)
65+ baseContext renderedMap
66+ | otherwise = return (Object H.empty)
68+metaValueToJSON :: Monad m
69+ => ([Block] -> m String)
70+ -> ([Inline] -> m String)
73+metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = liftM toJSON $
74+ Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
75+metaValueToJSON blockWriter inlineWriter (MetaList xs) = liftM toJSON $
76+ Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
77+metaValueToJSON _ _ (MetaString s) = return $ toJSON s
78+metaValueToJSON blockWriter _ (MetaBlocks bs) = liftM toJSON $ blockWriter bs
79+metaValueToJSON _ inlineWriter (MetaInlines bs) = liftM toJSON $ inlineWriter bs
81+-- | Retrieve a field value from a JSON object.
82+getField :: FromJSON a
86+getField field (Object hashmap) = do
87+ result <- H.lookup (T.pack field) hashmap
88+ case fromJSON result of
89+ Success x -> return x
90+ _ -> fail "Could not convert from JSON"
91+getField _ _ = fail "Not a JSON object"
98+-- | Set a field of a JSON object. If the field already has a value,
99+-- convert it into a list with the new value appended to the old value(s).
100+-- This is a utility function to be used in preparing template contexts.
101+setField field val (Object hashmap) =
102+ Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
103+ where combine newval oldval =
104+ case fromJSON oldval of
105+ Success xs -> toJSON $ xs ++ [newval]
106+ _ -> toJSON [oldval, newval]
114+-- | Set a field of a JSON object if it currently has no value.
115+-- If it has a value, do nothing.
116+-- This is a utility function to be used in preparing template contexts.
117+defField field val (Object hashmap) =
118+ Object $ H.insertWith f (T.pack field) (toJSON val) hashmap
119+ where f _newval oldval = oldval