Got view working for source and other files as well as pages.

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|
                          <h1 .title>#{page}
                          $maybe rev <- mbrev
                            <h2 .revision>#{rev}
-                         ^{toWikiPage htmlContents}
+                         ^{toWikiPage cont}
                        |]
 
 getIndexR :: HasGitit master => Dir -> GHandler Gitit master RepHtml
@@ -436,16 +467,19 @@ upDir toMaster fs = do
                      []     -> "\x2302"
   [whamlet|<a href=@{toMaster $ IndexR $ maybe (Dir "") id $ fromPathMultiPiece fs}>#{lastdir}/</a>|]
 
-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)
          $ do revid <- latest fs path
               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"

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)

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