diff --git a/Network/Gitit2.hs b/Network/Gitit2.hs
index f20496f..313f932 100644
--- a/Network/Gitit2.hs
+++ b/Network/Gitit2.hs
@@ -16,6 +16,7 @@ module Network.Gitit2 ( GititConfig (..)
) where
import Prelude hiding (catch)
+import qualified Data.Map as M
import Yesod hiding (MsgDelete)
import Yesod.Static
import Yesod.Default.Handlers -- robots, favicon
@@ -37,6 +38,7 @@ import Data.Monoid (Monoid, mappend)
import Data.Maybe (mapMaybe)
import System.Random (randomRIO)
import Control.Exception (throw, handle, try)
+import Text.Highlighting.Kate
-- This is defined in GHC 7.04+, but for compatibility we define it here.
infixr 5 <>
@@ -56,6 +58,7 @@ instance Yesod Gitit
-- | Configuration for a gitit wiki.
data GititConfig = GititConfig{
wiki_path :: FilePath -- ^ Path to the repository.
+ , mime_types :: M.Map String ContentType -- ^ Table of mime types
}
-- | Path to a wiki page. Pages can't begin with '_'.
@@ -299,6 +302,12 @@ isDiscussPageFile :: FilePath -> GHandler Gitit master Bool
isDiscussPageFile ('@':xs) = isPageFile xs
isDiscussPageFile _ = return False
+isSourceFile :: FilePath -> GHandler Gitit master Bool
+isSourceFile path' = do
+ let langs = languagesByFilename $ takeFileName path'
+ return $ not (null langs || takeExtension path' == ".svg")
+ -- allow svg to be served as image
+
-- TODO : make the front page configurable
getHomeR :: HasGitit master => GHandler Gitit master RepHtml
getHomeR = getViewR (Page "Front Page")
@@ -323,7 +332,12 @@ getRawR page = do
path <- pathForPage page
mbcont <- getRawContents path Nothing
case mbcont of
- Nothing -> notFound
+ Nothing -> do
+ path' <- pathForFile page
+ mbcont' <- getRawContents path' Nothing
+ case mbcont' of
+ Nothing -> notFound
+ Just (_,cont) -> return $ RepPlain $ toContent cont
Just (_,cont) -> return $ RepPlain $ toContent cont
getDeleteR :: HasGitit master => Page -> GHandler Gitit master RepHtml
@@ -380,20 +394,37 @@ view mbrev page = do
path <- pathForPage page
mbcont <- getRawContents path mbrev
case mbcont of
- Nothing -> do setMessageI (MsgNewPage page)
- redirect (toMaster $ EditR page)
Just (_,contents) -> do
- htmlContents <- contentsToHtml contents
+ htmlContents <- pageToHtml contents
+ layout [ViewTab,EditTab,HistoryTab,DiscussTab] htmlContents
+ Nothing -> do
+ path' <- pathForFile page
+ mbcont' <- getRawContents path' mbrev
+ is_source <- isSourceFile path'
+ case mbcont' of
+ Nothing -> do
+ setMessageI (MsgNewPage page)
+ redirect (toMaster $ EditR page)
+ Just (_,contents)
+ | is_source -> do
+ htmlContents <- sourceToHtml path' contents
+ layout [ViewTab,HistoryTab] htmlContents
+ | otherwise -> do
+ mimeTypes <- mime_types <$> config <$> getYesodSub
+ let ct = maybe "application/octet-stream" id
+ $ M.lookup (drop 1 $ takeExtension path') mimeTypes
+ sendResponse (ct, toContent contents)
+ where layout tabs cont =
makePage pageLayout{ pgName = Just page
, pgPageTools = True
- , pgTabs = [ViewTab,EditTab,HistoryTab,DiscussTab]
+ , pgTabs = tabs
, pgSelectedTab = ViewTab } $
do setTitle $ toMarkup page
[whamlet|
#{page}
$maybe rev <- mbrev
#{rev}
- ^{toWikiPage htmlContents}
+ ^{toWikiPage cont}
|]
getIndexR :: HasGitit master => Dir -> GHandler Gitit master RepHtml
@@ -436,7 +467,10 @@ upDir toMaster fs = do
[] -> "\x2302"
[whamlet|#{lastdir}/|]
-getRawContents :: HasGitit master => FilePath -> Maybe RevisionId -> GHandler Gitit master (Maybe (RevisionId, ByteString))
+getRawContents :: HasGitit master
+ => FilePath
+ -> Maybe RevisionId
+ -> GHandler Gitit master (Maybe (RevisionId, ByteString))
getRawContents path rev = do
fs <- filestore <$> getYesodSub
liftIO $ handle (\e -> if e == FS.NotFound then return Nothing else throw e)
@@ -444,8 +478,8 @@ getRawContents path rev = do
cont <- retrieve fs path rev
return $ Just (revid, cont)
-contentsToHtml :: HasGitit master => ByteString -> GHandler Gitit master Html
-contentsToHtml contents = do
+pageToHtml :: HasGitit master => ByteString -> GHandler Gitit master Html
+pageToHtml contents = do
let doc = readMarkdown defaultParserState{ stateSmart = True } $ toString contents
doc' <- sanitizePandoc <$> addWikiLinks doc
let rendered = writeHtml defaultWriterOptions{
@@ -455,6 +489,15 @@ contentsToHtml contents = do
, writerHTMLMathMethod = MathJax $ T.unpack mathjax_url } doc'
return rendered
+sourceToHtml :: HasGitit master
+ => FilePath -> ByteString -> GHandler Gitit master Html
+sourceToHtml path contents = do
+ let formatOpts = defaultFormatOpts { numberLines = True, lineAnchors = True }
+ return $ formatHtmlBlock formatOpts $
+ case languagesByExtension $ takeExtension path of
+ [] -> highlightAs "" $ toString contents
+ (l:_) -> highlightAs l $ toString contents
+
-- TODO replace with something in configuration.
mathjax_url :: Text
mathjax_url = "https://d3eoax9i5htok0.cloudfront.net/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"
diff --git a/gitit2.cabal b/gitit2.cabal
index 547ed24..404d488 100644
--- a/gitit2.cabal
+++ b/gitit2.cabal
@@ -61,7 +61,9 @@ library
, blaze-html >= 0.5 && < 0.6
, blaze-markup >= 0.5 && < 0.6
, random >= 1.0 && < 1.1
+ , containers >= 0.4 && < 0.5
, pandoc >= 1.9.3 && < 1.10
+ , highlighting-kate >= 0.5.0.6 && < 0.6
, xss-sanitize >= 0.3.2 && < 0.4
ghc-options: -Wall -threaded -fno-warn-unused-do-bind
@@ -73,6 +75,7 @@ executable gitit2
, yesod >= 1.0 && < 1.1
, yesod-static >= 1.0 && < 1.1
, filestore >= 0.4 && < 0.5
+ , containers >= 0.4 && < 0.5
, gitit2
ghc-options: -Wall -threaded -fno-warn-unused-do-bind
if flag(executable)
diff --git a/src/gitit2.hs b/src/gitit2.hs
index 44b5ba7..ff30bbc 100644
--- a/src/gitit2.hs
+++ b/src/gitit2.hs
@@ -4,6 +4,7 @@ import Network.Gitit2
import Yesod
import Yesod.Static
import Data.FileStore
+import qualified Data.Map as M
data Master = Master { getGitit :: Gitit }
mkYesod "Master" [parseRoutes|
@@ -38,9 +39,34 @@ instance HasGitit Master where
requireUser = return $ GititUser "Dummy" "dumb@dumber.org"
makePage = makeDefaultPage
+-- | Ready collection of common mime types. (Copied from
+-- Happstack.Server.HTTP.FileServe.)
+mimeTypes :: M.Map String ContentType
+mimeTypes = M.fromList
+ [("xml","application/xml")
+ ,("xsl","application/xml")
+ ,("js","text/javascript")
+ ,("html","text/html")
+ ,("htm","text/html")
+ ,("css","text/css")
+ ,("gif","image/gif")
+ ,("jpg","image/jpeg")
+ ,("png","image/png")
+ ,("txt","text/plain; charset=UTF-8")
+ ,("doc","application/msword")
+ ,("exe","application/octet-stream")
+ ,("pdf","application/pdf")
+ ,("zip","application/zip")
+ ,("gz","application/x-gzip")
+ ,("ps","application/postscript")
+ ,("rtf","application/rtf")
+ ,("wav","application/x-wav")
+ ,("hs","text/plain")]
+
main :: IO ()
main = do
- let conf = GititConfig{ wiki_path = "wikidata" }
+ let conf = GititConfig{ wiki_path = "wikidata"
+ , mime_types = mimeTypes }
let fs = gitFileStore $ wiki_path conf
st <- staticDevel "static"
warpDebug 3000 $ Master (Gitit{ config = conf