From 05f537d28861a1be25d762d4c1c82497043fc8f0 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Tue, 12 Apr 2016 11:21:14 +0000 Subject: [PATCH] Syntax highlighting suppport, but no colors in CSS yet --- src/Vervis/Handler/Repo.hs | 32 ++++++++++++++++++++++++++++---- stack.yaml | 1 + templates/repo/source.hamlet | 6 ++++-- vervis.cabal | 1 + 4 files changed, 34 insertions(+), 6 deletions(-) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 7fdfd64..e044270 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/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] diff --git a/stack.yaml b/stack.yaml index 700b7dd..5a4440f 100644 --- a/stack.yaml +++ b/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 diff --git a/templates/repo/source.hamlet b/templates/repo/source.hamlet index 92a7b7f..da27047 100644 --- a/templates/repo/source.hamlet +++ b/templates/repo/source.hamlet @@ -28,9 +28,11 @@ $forall RefName tag <- tags

Files for #{ref} $case display - $of Left file + $of Left (Left plain)
-      #{file}
+      #{plain}
+  $of Left (Right highlighted)
+    #{highlighted}
   $of Right rows
     
diff --git a/vervis.cabal b/vervis.cabal
index 67597f3..bf9f9c4 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -103,6 +103,7 @@ library
                      , file-embed
                      , filepath
                      , hashable
+                     , highlighter2
                      , hit
                      , hit-graph >= 0.1
                      , hjsmin