Added getTemplate to Text.Pandoc.Templates.

This allows the caller to select whether to allow user overrides
from the user data directory (~/.pandoc).

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1803 788f1e2b-df1e-0410-8736-df70ead52e1b

changelog

@@ -2,6 +2,10 @@ pandoc (1.4.1)
 
   [ John MacFarlane ]
 
+  * Text.Pandoc.Templates now exports getTemplate, which differs from
+    getDefaultTemplate in allowing the caller to select
+    whether to allow user overrides from the ~/.pandoc directory.
+
   * Changed default of writerXeTeX to False.
 
   * HTML writer: don't include empty UL if --toc but no sections.

src/Text/Pandoc/Templates.hs

@@ -66,27 +66,47 @@ You may optionally specify separators using @$sep$@:
 
 module Text.Pandoc.Templates ( renderTemplate
                              , TemplateTarget
+                             , getTemplate
                              , getDefaultTemplate) where
 
 import Text.ParserCombinators.Parsec
 import Control.Monad (liftM, when, forM)
 import qualified Control.Exception as E (try, IOException)
 import System.FilePath
-import Text.Pandoc.Shared (readDataFile)
 import Data.List (intercalate, intersperse)
 import Text.PrettyPrint (text, Doc)
 import Text.XHtml (primHtml, Html)
 import Data.ByteString.Lazy.UTF8 (ByteString, fromString)
+import System.Directory
+-- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv
+-- So we use System.IO.UTF8 only if we have an earlier version
+#if MIN_VERSION_base(4,2,0)
+#else
+import Prelude hiding ( readFile )
+import System.IO.UTF8 ( readFile )
+#endif
+import Paths_pandoc (getDataFileName)
+
+-- | Get a template for the specified writer.
+getTemplate :: Bool   -- ^ Allow override from user's application data directory?
+            -> String -- ^ Name of writer 
+            -> IO (Either E.IOException String)
+getTemplate _ "native" = return $ Right ""
+getTemplate user "s5" = getTemplate user "html"
+getTemplate user "odt" = getTemplate user "opendocument"
+getTemplate user writer = do
+  let format = takeWhile (/='+') writer  -- strip off "+lhs" if present
+  userDir <- getAppUserDataDirectory "pandoc"
+  let fname = "templates" </> format  <.> "template"
+  hasUserTemplate <- doesFileExist (userDir </> fname)
+  E.try $ if user && hasUserTemplate
+             then readFile $ userDir </> fname
+             else getDataFileName fname >>= readFile
 
 -- | Get the default template, either from the application's user data
 -- directory (~/.pandoc on unix) or from the cabal data directory.
 getDefaultTemplate :: String -> IO (Either E.IOException String)
-getDefaultTemplate "native" = return $ Right ""
+getDefaultTemplate = getTemplate True
-getDefaultTemplate "s5" = getDefaultTemplate "html"
-getDefaultTemplate "odt" = getDefaultTemplate "opendocument"
-getDefaultTemplate format = do
-  let format' = takeWhile (/='+') format  -- strip off "+lhs" if present
-  E.try $ readDataFile $ "templates" </> format' <.> "template"
 
 data TemplateState = TemplateState Int [(String,String)]