Skip to content

Commit

Permalink
Updates to use latest yesod and pandoc.
Browse files Browse the repository at this point in the history
  • Loading branch information
jgm committed Mar 13, 2013
1 parent 64203d8 commit cbab439
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 46 deletions.
4 changes: 2 additions & 2 deletions Makefile
@@ -1,7 +1,7 @@
.PHONY : all

all :
cabal-dev configure --cabal-install-arg='-fblaze_html_0_5'; cabal-dev build
cabal-dev configure ; cabal-dev build

prep :
cabal-dev install-deps --cabal-install-arg='-fblaze_html_0_5'
cabal-dev install-deps
55 changes: 33 additions & 22 deletions Network/Gitit2.hs
Expand Up @@ -31,8 +31,9 @@ import Data.FileStore as FS
import Data.Char (toLower)
import System.FilePath
import Text.Pandoc
import Text.Pandoc.Writers.RTF (writeRTFWithEmbeddedImages)
import Text.Pandoc.PDF (tex2pdf)
import Text.Pandoc.Shared (stringify, inDirectory, readDataFile)
import Text.Pandoc.Shared (stringify, inDirectory, readDataFileUTF8)
import Text.Pandoc.SelfContained (makeSelfContained)
import Text.Pandoc.Builder (toList, text)
import Control.Applicative
Expand Down Expand Up @@ -64,6 +65,7 @@ import Data.Yaml
import System.Directory
import System.Time (ClockTime (..), getClockTime)
import Network.HTTP.Base (urlEncode, urlDecode)
import qualified Data.Set as Set

-- This is defined in GHC 7.04+, but for compatibility we define it here.
infixr 5 <>
Expand Down Expand Up @@ -636,7 +638,7 @@ getRawContents path rev = do

pageToHtml :: HasGitit master => WikiPage -> GH master Html
pageToHtml wikiPage = do
return $ writeHtml defaultWriterOptions{
return $ writeHtml def{
writerWrapText = False
, writerHtml5 = True
, writerHighlight = True
Expand Down Expand Up @@ -664,17 +666,21 @@ contentsToWikiPage page contents = do
then M.empty
else maybe M.empty id
$ decode $! BS.concat $ B.toChunks h
let def = defaultParserState{ stateSmart = True }
let formatStr = case M.lookup "format" metadata of
Just (String s) -> s
_ -> ""
let format = maybe (default_format conf) id $ readPageFormat formatStr
let readerOpts literate = def{ readerSmart = True
, readerExtensions =
if literate
then Set.insert Ext_literate_haskell pandocExtensions
else pandocExtensions }
let (reader, lhs) = case format of
Markdown l -> (readMarkdown def{stateLiterateHaskell = l},l)
Textile l -> (readTextile def{stateLiterateHaskell = l},l)
LaTeX l -> (readLaTeX def{stateLiterateHaskell = l},l)
RST l -> (readRST def{stateLiterateHaskell = l},l)
HTML l -> (readHtml def{stateLiterateHaskell = l},l)
Markdown l -> (readMarkdown (readerOpts l), l)
Textile l -> (readTextile (readerOpts l), l)
LaTeX l -> (readLaTeX (readerOpts l), l)
RST l -> (readRST (readerOpts l), l)
HTML l -> (readHtml (readerOpts l), l)
let fromBool (Bool t) = t
fromBool _ = False
let toc = maybe False fromBool (M.lookup "toc" metadata)
Expand Down Expand Up @@ -937,18 +943,21 @@ getDiffR fromRev toRev page = do
$ \e -> case e of
FS.NotFound -> diff fs filePath (Just fromRev) (Just toRev)
_ -> throw e
let classFor B = ("unchanged" :: Text)
classFor F = "deleted"
classFor S = "added"
makePage pageLayout{ pgName = Just page
, pgTabs = []
, pgSelectedTab = EditTab } $
[whamlet|
<h1 .title>#{page}
<h2 .revision>#{fromRev} &rarr; #{toRev}
<pre>
$forall (t,xs) <- rawDiff
<span .#{classFor t}>#{unlines xs}
$forall t <- rawDiff
$case t
$of Both xs _
<span .unchanged>#{unlines xs}</span>
$of First xs
<span .deleted>#{unlines xs}</span>
$of Second xs
<span .added>#{unlines xs}</span>
|]

getHistoryR :: HasGitit master
Expand Down Expand Up @@ -1125,7 +1134,8 @@ feed mbpage = do
}
entries <- mapM toEntry [rev | rev <- revs, not (null $ revChanges rev) ]
return Feed{
feedTitle = mr $ maybe MsgSiteFeedTitle MsgPageFeedTitle mbpage
feedAuthor = ""
, feedTitle = mr $ maybe MsgSiteFeedTitle MsgPageFeedTitle mbpage
, feedLinkSelf = toMaster $ maybe AtomSiteR AtomPageR mbpage
, feedLinkHome = toMaster HomeR
, feedDescription = undefined -- only used for rss
Expand Down Expand Up @@ -1181,7 +1191,7 @@ getExportFormats = do
writeHtmlString opts{ writerSlideVariant = DZSlides
, writerHtml5 = True }))
, ("EPUB", (".epub", basicExport "epub" "application/xhtml+xml" $ \opts ->
inDirectory repopath . writeEPUB Nothing [] opts))
inDirectory repopath . writeEPUB opts))
, ("Groff man", (".1", basicExport "man" typePlain $ pureWriter writeMan))
, ("HTML", (".html", basicExport "html" typeHtml $ \opts -> selfcontained . writeHtmlString opts))
, ("HTML5", (".html", basicExport "html5" typeHtml $ \opts ->
Expand All @@ -1190,7 +1200,7 @@ getExportFormats = do
, ("Markdown", (".txt", basicExport "markdown" typePlain $ pureWriter writeMarkdown))
, ("Mediawiki", (".wiki", basicExport "mediawiki" typePlain $ pureWriter writeMediaWiki))
, ("ODT", (".odt", basicExport "opendocument" "application/vnd.oasis.opendocument.text"
$ \opts -> inDirectory repopath . writeODT Nothing opts))
$ \opts -> inDirectory repopath . writeODT opts))
, ("OpenDocument", (".xml", basicExport "opendocument" "application/vnd.oasis.opendocument.text"
$ pureWriter writeOpenDocument))
, ("Org-mode", (".org", basicExport "org" typePlain $ pureWriter writeOrg)) ] ++
Expand All @@ -1202,8 +1212,7 @@ getExportFormats = do
Right pdf -> return pdf)) | isJust (latex_engine conf) ] ++
[ ("Plain text", (".txt", basicExport "plain" typePlain $ pureWriter writePlain))
, ("reStructuredText", (".txt", basicExport "rst" typePlain $ pureWriter writeRST))
, ("RTF", (".rtf", basicExport "rtf" "application/rtf" $ \opts d ->
writeRTF opts <$> bottomUpM rtfEmbedImage d))
, ("RTF", (".rtf", basicExport "rtf" "application/rtf" writeRTFWithEmbeddedImages))
, ("Textile", (".txt", basicExport "textile" typePlain $ pureWriter writeTextile))
, ("S5", (".html", basicExport "s5" typeHtml $ \opts ->
selfcontained . writeHtmlString opts{ writerSlideVariant = S5Slides }))
Expand All @@ -1212,7 +1221,7 @@ getExportFormats = do
, ("Texinfo", (".texi", basicExport "texinfo" "application/x-texinfo" $ pureWriter writeTexinfo))
, ("Word docx", (".docx", basicExport "docx"
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
$ \opts -> inDirectory repopath . writeDocx Nothing opts))
$ \opts -> inDirectory repopath . writeDocx opts))
]

basicExport :: ToContent a
Expand All @@ -1232,18 +1241,20 @@ basicExport templ contentType writer = \wikiPage -> do
let vars = mapMaybe metadataToVar $ M.toList $ wpMetadata wikiPage
dzcore <- if templ == "dzslides"
then liftIO $ do
dztempl <- readDataFile (pandoc_user_data conf)
dztempl <- readDataFileUTF8 (pandoc_user_data conf)
$ "dzslides" </> "template.html"
return $ unlines
$ dropWhile (not . isPrefixOf "<!-- {{{{ dzslides core")
$ lines dztempl
else return ""
rendered <- liftIO
$ writer defaultWriterOptions{
$ writer def{
writerTemplate = template
, writerSourceDirectory = repository_path conf
, writerStandalone = True
, writerLiterateHaskell = wpLHS wikiPage
, writerExtensions = if wpLHS wikiPage
then Set.insert Ext_literate_haskell pandocExtensions
else pandocExtensions
, writerTableOfContents = wpTOC wikiPage
, writerHTMLMathMethod = MathML Nothing
, writerVariables = ("dzslides-core",dzcore):vars }
Expand Down
38 changes: 19 additions & 19 deletions gitit2.cabal
Expand Up @@ -53,40 +53,40 @@ library
, yesod-static >= 1.1 && < 1.2
, yesod-default >= 1.1 && < 1.2
, yesod-core >= 1.1 && < 1.2
, yesod-form >= 1.1 && < 1.2
, yesod-form >= 1.1 && < 1.3
, yesod-test >= 0.3 && < 0.4
, clientsession >= 0.8 && < 0.9
, bytestring >= 0.9 && < 0.10
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 0.12
, template-haskell
, hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1
, shakespeare-js >= 1.0 && < 1.1
, shakespeare-js >= 1.0 && < 1.2
, shakespeare-text >= 1.0 && < 1.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9
, conduit >= 0.5 && < 0.6
, http-conduit >= 1.6 && < 1.7
, directory >= 1.1 && < 1.2
, conduit >= 0.5 && < 1.1
, http-conduit >= 1.6 && < 2.0
, directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4
, filepath >= 1.3 && < 1.4
, filestore >= 0.5 && < 0.6
, filestore >= 0.5 && < 0.7
, utf8-string >= 0.3 && < 0.4
, blaze-html >= 0.5 && < 0.6
, blaze-html >= 0.5 && < 0.7
, blaze-markup >= 0.5 && < 0.6
, random >= 1.0 && < 1.1
, containers >= 0.4 && < 0.5
, pandoc >= 1.9.3 && < 1.10
, containers >= 0.4 && < 0.6
, pandoc >= 1.10 && < 1.12
, highlighting-kate >= 0.5.0.6 && < 0.6
, xss-sanitize >= 0.3.2 && < 0.4
, yesod-newsfeed >= 1.1 && < 1.2
, time >= 1.1 && < 1.5
, syb >= 0.3 && < 0.4
, directory >= 1.1 && < 1.2
, syb >= 0.3 && < 0.5
, directory >= 1.1 && < 1.3
, blaze-builder >= 0.3 && < 0.4
, pandoc-types >= 1.9.1 && < 1.10
, pandoc-types >= 1.10 && < 1.11
, HTTP >= 4000.2 && < 4000.3
, old-time >= 1.1 && < 1.2

Expand All @@ -98,16 +98,16 @@ executable gitit2
build-depends: base >= 4 && < 5
, yesod >= 1.1 && < 1.2
, yesod-static >= 1.1 && < 1.2
, filestore >= 0.5 && < 0.6
, containers >= 0.4 && < 0.5
, filestore >= 0.5 && < 0.7
, containers >= 0.4 && < 0.6
, yaml >= 0.8 && < 0.9
, bytestring >= 0.9 && < 1.0
, warp >= 1.3 && < 1.4
, text >= 0.11 && < 0.12
, directory >= 1.1 && < 1.2
, network >= 2.3 && < 2.4
, pandoc-types >= 1.9.1 && < 1.10
, syb >= 0.3 && < 0.4
, directory >= 1.1 && < 1.3
, network >= 2.3 && < 2.5
, pandoc-types >= 1.10 && < 1.11
, syb >= 0.3 && < 0.5
, gitit2
ghc-options: -Wall -threaded -fno-warn-unused-do-bind
if flag(executable)
Expand Down
Binary file removed src/.gitit2.hs.swp
Binary file not shown.
7 changes: 4 additions & 3 deletions src/gitit2.hs
Expand Up @@ -16,10 +16,10 @@ import System.IO
import System.Exit
import Data.Text (Text)
import qualified Data.Text as T

import Prelude hiding (catch)
import Control.Exception (catch, SomeException)
-- TODO only for samplePlugin
import Data.Generics
import Data.Char (toLower)
import Text.Pandoc.Definition

data Master = Master { getGitit :: Gitit, maxUploadSize :: Int }
Expand Down Expand Up @@ -55,7 +55,7 @@ instance HasGitit Master where
maybeUser = return $ Just $ GititUser "Dummy" "dumb@dumber.org"
requireUser = return $ GititUser "Dummy" "dumb@dumber.org"
makePage = makeDefaultPage
getPlugins = return [samplePlugin]
getPlugins = return [] -- [samplePlugin]

-- | Ready collection of common mime types. (Copied from
-- Happstack.Server.HTTP.FileServe.)
Expand Down Expand Up @@ -111,6 +111,7 @@ readMimeTypesFile f = catch
handleMimeTypesFileNotFound
where go [] m = m -- skip blank lines
go (x:xs) m = foldr (\ext -> M.insert ext $ B.pack x) m xs
handleMimeTypesFileNotFound :: SomeException -> IO (M.Map String ContentType)
handleMimeTypesFileNotFound e = do
warn $ "Could not parse mime types file.\n" ++ show e
return mimeTypes
Expand Down

0 comments on commit cbab439

Please sign in to comment.