Syntax highlighting suppport, but no colors in CSS yet

src/Vervis/Handler/Repo.hs

@@ -32,11 +32,14 @@ where
 -- [x] write the git and mkdir parts that actually create the repo
 -- [x] make repo view that shows a table of commits
 
-import ClassyPrelude.Conduit       hiding (unpack)
+import ClassyPrelude.Conduit       hiding (last, toStrict, unpack)
 import Yesod                       hiding (Header, parseTime, (==.))
 import Yesod.Auth
 
+import Prelude (last)
+
 import Data.Byteable (toBytes)
+import Data.ByteString.Lazy (toStrict)
 import Data.Git.Graph
 import Data.Git.Graph.Util
 import Data.Git.Named (RefName (..))
@@ -54,6 +57,8 @@ import Database.Esqueleto
 import Data.Hourglass (timeConvert)
 import System.Directory (createDirectoryIfMissing)
 import System.Hourglass (dateCurrent)
+import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName))
+import Text.Highlighter.Formatters.Html (format)
 
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
@@ -181,9 +186,28 @@ getRepoSourceR user proj repo ref dir = do
                     ( if isTree then "[D]" else "[F]" :: Text
                     , toText $ toBytes name
                     )
-                display = case view of
-                    Left b  -> Left $ toTextL $ blobGetContent b
-                    Right v -> Right $ map mkrow v
+            display <- case view of
+                    Left b ->
+                        let lbs = blobGetContent b
+                            bs = toStrict lbs
+                        in  Left <$>
+                            case lexerFromFilename $ unpack $ last dir of
+                                Nothing    -> return $ Left $ toTextL lbs
+                                Just lexer ->
+                                    case runLexer lexer bs of
+                                        Left err -> do
+                                            $logWarn $ mconcat
+                                                [ "Failed to highlight "
+                                                , ref
+                                                , " :: "
+                                                , intercalate "/" dir
+                                                , " with lexer "
+                                                , pack $ lName lexer
+                                                ]
+                                            return $ Left $ toTextL lbs
+                                        Right tokens ->
+                                            return $ Right $ format True tokens
+                    Right v -> return $ Right $ map mkrow v
             defaultLayout $ do
                 setTitle $ toHtml $ intercalate " > " $
                     ["Vervis", "People", user, "Projects", proj, "Repos", repo]

stack.yaml

@@ -14,6 +14,7 @@ packages:
 # Packages to be pulled from upstream that are not in the resolver (e.g.,
 # acme-missiles-0.3)
 extra-deps:
+  - highlighter2-0.2.5
   - hit-graph-0.1
   - SimpleAES-0.4.2
 #  - ssh-0.3.2

templates/repo/source.hamlet

@@ -28,9 +28,11 @@ $forall RefName tag <- tags
 
 <h2>Files for #{ref}
 $case display
-  $of Left file
+  $of Left (Left plain)
     <pre>
-      <code>#{file}
+      <code>#{plain}
+  $of Left (Right highlighted)
+    #{highlighted}
   $of Right rows
     <table>
       <tr>

vervis.cabal

@@ -103,6 +103,7 @@ library
                      , file-embed
                      , filepath
                      , hashable
+                     , highlighter2
                      , hit
                      , hit-graph >= 0.1
                      , hjsmin