Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 2 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
View
1  Yst/Config.hs
@@ -41,6 +41,7 @@ parseConfigFile configfile = do
, indexFile = indexfile
, pageIndex = M.fromList $ map (\pg -> (pageUrl pg, pg)) ind
, navigation = nav
+ , filterCommand = getStrAttrMaybe "filter" xs
}
_ -> errorExit 7 "Configuration file must be a YAML hash." >> return undefined
View
40 Yst/Render.hs
@@ -30,6 +30,10 @@ import Data.List.Split (wordsBy)
import Text.StringTemplate
import Data.Maybe (fromMaybe)
import System.FilePath
+import System.Process (createProcess, shell, StdStream(..), CreateProcess(..))
+import Text.JSON.Generic (encodeJSON, decodeJSON)
+import Control.Concurrent (forkIO)
+import System.IO.UTF8 (hPutStr, hGetContents)
-- 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)
@@ -117,7 +121,9 @@ renderPage site page = do
return $ render (setManyAttrib attrs templ)
layoutTempl <- getTemplate layout g
let format = formatFromExtension (stripStExt layout)
- let contents = converterForFormat format rawContents
+ let doc = readMarkdown defaultParserState{stateSmart = True} rawContents
+ doc' <- maybeFilterDoc (filterCommand site) doc
+ let contents = converterForFormat format defaultWriterOptions doc'
let root' = case length (filter (=='/') $ pageUrl page) of
0 -> ""
n -> concat $ replicate n "../"
@@ -131,19 +137,25 @@ renderPage site page = do
. setAttribute "nav" menuHtml
$ layoutTempl
-converterForFormat :: Format -> String -> String
-converterForFormat f =
- let reader = readMarkdown defaultParserState{stateSmart = True}
- in case f of
- HtmlFormat -> writeHtmlString defaultWriterOptions . reader
- LaTeXFormat -> writeLaTeX defaultWriterOptions . reader
- PlainFormat -> id
- ConTeXtFormat -> writeConTeXt defaultWriterOptions . reader
- ManFormat -> writeMan defaultWriterOptions . reader
- RTFFormat -> writeRTF defaultWriterOptions . reader
- DocBookFormat -> writeDocbook defaultWriterOptions . reader
- TexinfoFormat -> writeTexinfo defaultWriterOptions . reader
- OpenDocumentFormat -> writeOpenDocument defaultWriterOptions . reader
+maybeFilterDoc :: Maybe String -> Pandoc -> IO Pandoc
+maybeFilterDoc Nothing doc = return doc
+maybeFilterDoc (Just cmd) doc = do
+ (Just inp, Just out, _, _) <- createProcess (shell cmd)
+ {std_in = CreatePipe, std_out = CreatePipe}
+ forkIO $ hPutStr inp $ encodeJSON doc
+ hGetContents out >>= return . decodeJSON
+
+converterForFormat :: Format -> WriterOptions -> Pandoc -> String
+converterForFormat f = case f of
+ HtmlFormat -> writeHtmlString
+ LaTeXFormat -> writeLaTeX
+ PlainFormat -> writeMarkdown
+ ConTeXtFormat -> writeConTeXt
+ ManFormat -> writeMan
+ RTFFormat -> writeRTF
+ DocBookFormat -> writeDocbook
+ TexinfoFormat -> writeTexinfo
+ OpenDocumentFormat -> writeOpenDocument
getTemplate :: Stringable a => String -> STGroup a -> IO (StringTemplate a)
getTemplate templateName templateGroup = do
View
1  Yst/Types.hs
@@ -34,6 +34,7 @@ data Site = Site {
, indexFile :: FilePath
, pageIndex :: M.Map String Page
, navigation :: [NavNode]
+ , filterCommand :: Maybe String
} deriving (Show, Read, Eq)
data Source = TemplateFile FilePath
View
14 Yst/Util.hs
@@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-module Yst.Util (stripBlanks, parseAsDate, stripStExt, getStrAttrWithDefault, getStrListWithDefault, fromNString, getDirectoryContentsRecursive, searchPath, errorExit)
+module Yst.Util (stripBlanks, parseAsDate, stripStExt, getStrAttrMaybe, getStrAttrWithDefault, getStrListWithDefault, fromNString, getDirectoryContentsRecursive, searchPath, errorExit)
where
import Yst.Types
import System.Exit
@@ -52,12 +52,16 @@ stripStExt f =
then dropExtension f
else f
+getStrAttrMaybe :: String -> [(String, Node)] -> Maybe String
+getStrAttrMaybe attr xs =
+ case lookup attr xs of
+ Just (NString s) -> Just s
+ Just _ -> error $ attr ++ " must have string value."
+ Nothing -> Nothing
+
getStrAttrWithDefault :: String -> String -> [(String, Node)] -> String
getStrAttrWithDefault attr def xs =
- case lookup attr xs of
- Just (NString s) -> s
- Just _ -> error $ attr ++ " must have string value."
- Nothing -> def
+ maybe def id $ getStrAttrMaybe attr xs
getStrListWithDefault :: String -> String -> [(String, Node)] -> [String]
getStrListWithDefault attr def xs =
View
2  yst.cabal
@@ -57,7 +57,7 @@ Executable yst
build-depends: base >=3 && < 5, HStringTemplate >= 0.6.1, HsSyck, csv,
filepath, containers, directory, utf8-string, time,
old-locale, old-time, parsec, xhtml, pandoc, bytestring,
- split, HDBC, HDBC-sqlite3
+ split, HDBC, HDBC-sqlite3, process, json
extensions: CPP
if impl(ghc >= 6.12)
ghc-options: -Wall -threaded -fno-warn-orphans -fno-warn-unused-do-bind

No commit comments for this range

Something went wrong with that request. Please try again.