diff --git a/data/markup.DocBook b/data/markup.docbook similarity index 100% rename from data/markup.DocBook rename to data/markup.docbook diff --git a/data/markup.HTML b/data/markup.html similarity index 100% rename from data/markup.HTML rename to data/markup.html diff --git a/data/markup.LaTeX b/data/markup.latex similarity index 100% rename from data/markup.LaTeX rename to data/markup.latex diff --git a/data/markup.Markdown b/data/markup.markdown similarity index 100% rename from data/markup.Markdown rename to data/markup.markdown diff --git a/data/markup.RST b/data/markup.rst similarity index 100% rename from data/markup.RST rename to data/markup.rst diff --git a/data/markup.Textile b/data/markup.textile similarity index 100% rename from data/markup.Textile rename to data/markup.textile diff --git a/data/markupHelp/HTML b/data/markupHelp/html similarity index 100% rename from data/markupHelp/HTML rename to data/markupHelp/html diff --git a/data/markupHelp/LaTeX b/data/markupHelp/latex similarity index 100% rename from data/markupHelp/LaTeX rename to data/markupHelp/latex diff --git a/data/markupHelp/Markdown b/data/markupHelp/markdown similarity index 100% rename from data/markupHelp/Markdown rename to data/markupHelp/markdown diff --git a/data/markupHelp/Markdown+LHS b/data/markupHelp/markdown+lhs similarity index 100% rename from data/markupHelp/Markdown+LHS rename to data/markupHelp/markdown+lhs diff --git a/data/markupHelp/Org b/data/markupHelp/org similarity index 100% rename from data/markupHelp/Org rename to data/markupHelp/org diff --git a/data/markupHelp/RST b/data/markupHelp/rst similarity index 100% rename from data/markupHelp/RST rename to data/markupHelp/rst diff --git a/data/markupHelp/RST+LHS b/data/markupHelp/rst+lhs similarity index 100% rename from data/markupHelp/RST+LHS rename to data/markupHelp/rst+lhs diff --git a/src/Network/Gitit/Config.hs b/src/Network/Gitit/Config.hs index d39d8cf59..a53d88769 100644 --- a/src/Network/Gitit/Config.hs +++ b/src/Network/Gitit/Config.hs @@ -30,6 +30,7 @@ import Network.Gitit.Server (mimeTypes) import Network.Gitit.Framework import Network.Gitit.Authentication (formAuthHandlers, rpxAuthHandlers, httpAuthHandlers, githubAuthHandlers) import Network.Gitit.Util (parsePageType, readFileUTF8) +import System.Directory (doesFileExist) import System.Log.Logger (logM, Priority(..)) import qualified Data.Map as M import Data.ConfigFile hiding (readfile) @@ -133,13 +134,16 @@ extractConfig cp = do cfPandocUserData <- get cp "DEFAULT" "pandoc-user-data" cfXssSanitize <- get cp "DEFAULT" "xss-sanitize" cfRecentActivityDays <- get cp "DEFAULT" "recent-activity-days" - let (pt, lhs) = parsePageType cfDefaultPageType - let markupHelpFile = show pt ++ if lhs then "+LHS" else "" + let pt = parsePageType cfDefaultPageType + let markupHelpFile = show pt markupHelpPath <- liftIO $ getDataFileName $ "data" "markupHelp" markupHelpFile - markupHelp' <- liftIO $ readFileUTF8 markupHelpPath - markupHelpText <- liftIO $ handleError $ runPure $ do - helpDoc <- readMarkdown def{ readerExtensions = getDefaultExtensions "markdown" } markupHelp' - writeHtml5String def helpDoc + helpFileExists <- liftIO $ doesFileExist markupHelpPath + markupHelpText <- if helpFileExists then do + markupHelp' <- liftIO $ readFileUTF8 markupHelpPath + liftIO $ handleError $ runPure $ do + helpDoc <- readMarkdown def{ readerExtensions = getDefaultExtensions "markdown" } markupHelp' + writeHtml5String def helpDoc + else return T.empty mimeMap' <- liftIO $ readMimeTypesFile cfMimeTypesFile let authMethod = map toLower cfAuthenticationMethod @@ -166,7 +170,6 @@ extractConfig cp = do "mathjax" -> MathJax cfMathjaxScript "google" -> WebTeX "http://chart.apis.google.com/chart?cht=tx&chl=" _ -> RawTeX - , defaultLHS = lhs , showLHSBirdTracks = cfShowLHSBirdTracks , withUser = case authMethod of "form" -> withUserFromSession diff --git a/src/Network/Gitit/ContentTransformer.hs b/src/Network/Gitit/ContentTransformer.hs index 12e450a83..6817039ff 100644 --- a/src/Network/Gitit/ContentTransformer.hs +++ b/src/Network/Gitit/ContentTransformer.hs @@ -83,7 +83,6 @@ import Network.Gitit.Page (stringToPage) import Network.Gitit.Server import Network.Gitit.State import Network.Gitit.Types -import Network.Gitit.Util (getPageTypeDefaultExtensions) import Network.HTTP (urlDecode) import Network.URI (isUnescapedInURI) import Network.URL (encString) @@ -333,7 +332,7 @@ pageToPandoc page' = do modifyContext $ \ctx -> ctx{ ctxTOC = pageTOC page' , ctxCategories = pageCategories page' , ctxMeta = pageMeta page' } - either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageLHS page') (pageText page') + either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageText page') -- | Detects if the page is a redirect page and handles accordingly. The exact -- behaviour is as follows: @@ -669,23 +668,16 @@ updateLayout f = do -- Pandoc and wiki content conversion support -- -readerFor :: PageType -> Bool -> String -> Either PandocError Pandoc -readerFor pt lhs = - let defExts = getDefaultExtensions $ T.toLower $ T.pack $ show pt - defPS = def{ readerExtensions = defExts +readerFor :: PageType -> String -> Either PandocError Pandoc +readerFor (PageType { + pageTypeReader = TextReader reader, + pageTypeExtensions = ext +}) = + let defPS = def{ readerExtensions = ext <> extensionsFromList [Ext_emoji] - <> getPageTypeDefaultExtensions pt lhs <> readerExtensions def } - in runPure . (case pt of - RST -> readRST defPS - Markdown -> readMarkdown defPS - CommonMark -> readCommonMark defPS - LaTeX -> readLaTeX defPS - HTML -> readHtml defPS - Textile -> readTextile defPS - Org -> readOrg defPS - DocBook -> readDocBook defPS - MediaWiki -> readMediaWiki defPS) . T.pack + in runPure . reader defPS . T.pack +readerFor pt = const $ Left $ PandocAppError $ "Binary PageType unsupported: " <> T.pack (show pt) wikiLinksTransform :: Pandoc -> PluginM Pandoc wikiLinksTransform pandoc diff --git a/src/Network/Gitit/Initialize.hs b/src/Network/Gitit/Initialize.hs index 64a7f6ed7..f091dc67f 100644 --- a/src/Network/Gitit/Initialize.hs +++ b/src/Network/Gitit/Initialize.hs @@ -27,7 +27,6 @@ module Network.Gitit.Initialize ( initializeGititState , createTemplateIfMissing ) where import System.FilePath ((), (<.>)) -import Data.Semigroup ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.FileStore @@ -40,8 +39,9 @@ import Network.Gitit.Plugins import Network.Gitit.Layout (defaultRenderPage) import Paths_gitit (getDataFileName) import Control.Exception (throwIO, try) +import Control.Monad.Except (throwError) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist) -import Control.Monad ((<=<), unless, forM_, liftM) +import Control.Monad (unless, forM_, liftM) import Text.Pandoc hiding (getDataFileName, WARNING) import System.Log.Logger (logM, Priority(..)) import qualified Text.StringTemplate as ST @@ -131,29 +131,28 @@ createDefaultPages conf = do else writerExtensions def } -- note: we convert this (markdown) to the default page format - converter = handleError . runPure . case pt of - Markdown -> return - LaTeX -> writeLaTeX defOpts <=< toPandoc - HTML -> writeHtml5String defOpts <=< toPandoc - RST -> writeRST defOpts <=< toPandoc - Textile -> writeTextile defOpts <=< toPandoc - Org -> writeOrg defOpts <=< toPandoc - DocBook -> writeDocbook5 defOpts <=< toPandoc - MediaWiki -> writeMediaWiki defOpts <=< toPandoc - CommonMark -> writeCommonMark defOpts <=< toPandoc + converter input = handleError $ runPure $ do + (writer, exts) <- getWriter (T.pack $ pageTypeSpec pt) + pandoc <- toPandoc input + case writer of + TextWriter w -> w (defOpts { writerExtensions = exts <> writerExtensions defOpts }) pandoc + _ -> throwError $ PandocAppError $ "Binary PageType unsupported: " <> T.pack (show pt) welcomepath <- getDataFileName $ "data" "FrontPage" <.> "page" welcomecontents <- converter =<< readFileUTF8 welcomepath helppath <- getDataFileName $ "data" "Help" <.> "page" helpcontentsInitial <- converter =<< readFileUTF8 helppath markuppath <- getDataFileName $ "data" "markup" <.> show pt - helpcontentsMarkup <- converter =<< readFileUTF8 markuppath + markupExists <- doesFileExist markuppath + helpcontentsMarkup <- if markupExists then + converter =<< readFileUTF8 markuppath + else return T.empty let helpcontents = helpcontentsInitial <> "\n\n" <> helpcontentsMarkup usersguidepath <- getDataFileName "README.markdown" usersguidecontents <- converter =<< readFileUTF8 usersguidepath -- include header in case user changes default format: let header = "---\nformat: " <> - T.pack (show pt) <> (if defaultLHS conf then "+lhs" else "") <> + T.pack (show pt) <> "\n...\n\n" -- add front page, help page, and user's guide let auth = Author "Gitit" "" diff --git a/src/Network/Gitit/Page.hs b/src/Network/Gitit/Page.hs index 8c1b91fbf..cb8928d1d 100644 --- a/src/Network/Gitit/Page.hs +++ b/src/Network/Gitit/Page.hs @@ -106,7 +106,6 @@ stringToPage conf pagename raw = let (ls, rest) = parseMetadata raw page' = Page { pageName = pagename , pageFormat = defaultPageType conf - , pageLHS = defaultLHS conf , pageTOC = tableOfContents conf , pageTitle = pagename , pageCategories = [] @@ -116,8 +115,8 @@ stringToPage conf pagename raw = adjustPage :: (String, String) -> Page -> Page adjustPage ("title", val) page' = page' { pageTitle = val } -adjustPage ("format", val) page' = page' { pageFormat = pt, pageLHS = lhs } - where (pt, lhs) = parsePageType val +adjustPage ("format", val) page' = page' { pageFormat = pt } + where pt = parsePageType val adjustPage ("toc", val) page' = page' { pageTOC = map toLower val `elem` ["yes","true"] } adjustPage ("categories", val) page' = @@ -131,7 +130,6 @@ pageToString conf page' = let pagename = pageName page' pagetitle = pageTitle page' pageformat = pageFormat page' - pagelhs = pageLHS page' pagetoc = pageTOC page' pagecats = pageCategories page' metadata = filter @@ -141,11 +139,9 @@ pageToString conf page' = metadata' = (if pagename /= pagetitle then "title: " ++ pagetitle ++ "\n" else "") ++ - (if pageformat /= defaultPageType conf || - pagelhs /= defaultLHS conf + (if pageformat /= defaultPageType conf then "format: " ++ - map toLower (show pageformat) ++ - if pagelhs then "+lhs\n" else "\n" + map toLower (show pageformat) else "") ++ (if pagetoc /= tableOfContents conf then "toc: " ++ diff --git a/src/Network/Gitit/State.hs b/src/Network/Gitit/State.hs index 40da100b0..f8a99d56a 100644 --- a/src/Network/Gitit/State.hs +++ b/src/Network/Gitit/State.hs @@ -139,6 +139,3 @@ getFileStore = liftM wikiFileStore ask getDefaultPageType :: GititServerPart PageType getDefaultPageType = liftM defaultPageType getConfig - -getDefaultLHS :: GititServerPart Bool -getDefaultLHS = liftM defaultLHS getConfig diff --git a/src/Network/Gitit/Types.hs b/src/Network/Gitit/Types.hs index aa23ec1e1..925a332e8 100644 --- a/src/Network/Gitit/Types.hs +++ b/src/Network/Gitit/Types.hs @@ -69,7 +69,7 @@ import Control.Monad.Reader (ReaderT, runReaderT, mplus) import Control.Monad.State (StateT, runStateT, get, modify) import Control.Monad (liftM) import System.Log.Logger (Priority(..)) -import Text.Pandoc.Definition (Pandoc) +import Text.Pandoc (Pandoc, Reader, PandocPure, Extensions) import Text.XHtml (Html) import qualified Data.Map as M import Data.Text (Text) @@ -86,16 +86,17 @@ import Text.HTML.TagSoup.Entity (lookupEntity) import Data.Char (isSpace) import Network.OAuth.OAuth2 -data PageType = Markdown - | CommonMark - | RST - | LaTeX - | HTML - | Textile - | Org - | DocBook - | MediaWiki - deriving (Read, Show, Eq) +data PageType = PageType { + pageTypeSpec :: String, + pageTypeReader :: Reader PandocPure, + pageTypeExtensions :: Extensions +} + +instance Show PageType where + show = pageTypeSpec + +instance Eq PageType where + (PageType spec1 _ _) == (PageType spec2 _ _) = spec1 == spec2 data FileStoreType = Git | Darcs | Mercurial deriving Show @@ -117,8 +118,6 @@ data Config = Config { defaultExtension :: String, -- | How to handle LaTeX math in pages? mathMethod :: MathMethod, - -- | Treat as literate haskell by default? - defaultLHS :: Bool, -- | Show Haskell code with bird tracks showLHSBirdTracks :: Bool, -- | Combinator to set @REMOTE_USER@ request header @@ -219,13 +218,12 @@ data Config = Config { data Page = Page { pageName :: String , pageFormat :: PageType - , pageLHS :: Bool , pageTOC :: Bool , pageTitle :: String , pageCategories :: [String] , pageText :: String , pageMeta :: [(String, String)] -} deriving (Read, Show) +} deriving (Show, Eq) newtype SessionKey = SessionKey Integer deriving (Read, Show, Eq, Ord) diff --git a/src/Network/Gitit/Util.hs b/src/Network/Gitit/Util.hs index 3d53d8769..63c6cffb5 100644 --- a/src/Network/Gitit/Util.hs +++ b/src/Network/Gitit/Util.hs @@ -26,7 +26,6 @@ module Network.Gitit.Util ( readFileUTF8 , yesOrNo , parsePageType , encUrl - , getPageTypeDefaultExtensions ) where import System.Directory @@ -34,12 +33,12 @@ import Control.Exception (bracket) import System.FilePath ((), (<.>)) import System.IO.Error (isAlreadyExistsError) import Control.Monad.Trans (liftIO) -import Data.Char (toLower, isAscii) +import Data.Char (isAscii) import Data.Text (Text) import Network.Gitit.Types import qualified Control.Exception as E import qualified Text.Pandoc.UTF8 as UTF8 -import Text.Pandoc (Extension(..), Extensions, getDefaultExtensions, enableExtension) +import Text.Pandoc (getReader, runPure) import Network.URL (encString) #if !MIN_VERSION_pandoc(2,12,0) @@ -101,39 +100,12 @@ yesOrNo :: Bool -> String yesOrNo True = "yes" yesOrNo False = "no" -parsePageType :: String -> (PageType, Bool) -parsePageType s = - case map toLower s of - "markdown" -> (Markdown,False) - "markdown+lhs" -> (Markdown,True) - "commonmark" -> (CommonMark,False) - "docbook" -> (DocBook,False) - "rst" -> (RST,False) - "rst+lhs" -> (RST,True) - "html" -> (HTML,False) - "textile" -> (Textile,False) - "latex" -> (LaTeX,False) - "latex+lhs" -> (LaTeX,True) - "org" -> (Org,False) - "mediawiki" -> (MediaWiki,False) - x -> error $ "Unknown page type: " ++ x - -getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions -getPageTypeDefaultExtensions pt lhs = - if lhs - then enableExtension Ext_literate_haskell defaults - else defaults - where defaults = getDefaultExtensions $ - case pt of - CommonMark -> "commonmark" - DocBook -> "docbook" - HTML -> "html" - LaTeX -> "latex" - Markdown -> "markdown" - MediaWiki -> "mediawiki" - Org -> "org" - RST -> "rst" - Textile -> "textile" +parsePageType :: String -> PageType +parsePageType s = case runPure $ getReader spec of + Right (r, e) -> PageType (T.unpack spec) r e + Left err -> error $ "Bad page type: " ++ show err + where + spec = T.toLower $ T.pack s encUrl :: String -> String encUrl = encString True isAscii