diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 95c0505..79ed110 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -69,6 +69,7 @@ import Vervis.Foundation import Vervis.Git (timeAgo') import Vervis.Path import Vervis.Model +import Vervis.Readme import Vervis.Render import Vervis.Settings import Vervis.Style @@ -157,7 +158,14 @@ getRepoSource repository user repo ref dir = do _ -> error "expected tree or blob" view <- case target of Left b -> Left <$> return b - Right t -> Right <$> viewTree git t + Right t -> do + v <- viewTree git t + mreadme <- findReadme git t + let r = case mreadme of + Nothing -> Nothing + Just (t, b) -> + Just (t, renderReadme t b) + return $ Right (v, r) return $ Just (branches, tags, view) else return Nothing case minfo of @@ -170,7 +178,7 @@ getRepoSource repository user repo ref dir = do display <- case view of Left b -> return $ Left $ renderSource (unpack $ last dir) (blobGetContent b) - Right v -> return $ Right $ map mkrow v + Right (v, mr) -> return $ Right (map mkrow v, mr) let parent = if null dir then [] else init dir dirs = zip parent (tail $ inits parent) title = case (dir, display) of diff --git a/src/Vervis/Readme.hs b/src/Vervis/Readme.hs new file mode 100644 index 0000000..884dc73 --- /dev/null +++ b/src/Vervis/Readme.hs @@ -0,0 +1,55 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | Tools for rendering README files in repository tree view. +module Vervis.Readme + ( findReadme + , renderReadme + ) +where + +import Prelude + +import Data.Byteable (toBytes) +import Data.ByteString.Lazy (ByteString) +import Data.Git.Storage (Git, getObject_) +import Data.Git.Storage.Object (Object (..)) +import Data.Git.Types (Blob (..), Tree (..)) +import Data.Text (Text, toCaseFold, isPrefixOf, unpack) +import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding.Error (strictDecode) + +import Vervis.Foundation (Widget) +import Vervis.Render (renderSource) + +-- | Find a README file in a directory. Return the filename and the file +-- content. +findReadme :: Git -> Tree -> IO (Maybe (Text, ByteString)) +findReadme git tree = go $ treeGetEnts tree + where + go [] = return Nothing + go ((_perm, name, ref) : es) = + let nameT = decodeUtf8With strictDecode $ toBytes name + in if toCaseFold "readme" `isPrefixOf` toCaseFold nameT + then do + obj <- getObject_ git ref True + case obj of + ObjBlob b -> return $ Just (nameT, blobGetContent b) + _ -> go es + else go es + +-- | Render README content into a widget for inclusion in a page. +renderReadme :: Text -> ByteString -> Widget +renderReadme name content = renderSource (unpack name) content diff --git a/src/Vervis/Render.hs b/src/Vervis/Render.hs index 9127324..561732c 100644 --- a/src/Vervis/Render.hs +++ b/src/Vervis/Render.hs @@ -15,40 +15,59 @@ -- | Tools for rendering repository file contents and other source files. module Vervis.Render - ( renderSource + ( renderPlain + , renderHighlight + , renderSource ) where import Prelude -import Control.Monad.Logger (logWarn) +import Control.Monad.Logger (logDebug, logWarn) import Data.ByteString.Lazy (ByteString, toStrict) +import Data.Monoid ((<>)) import Data.Text (pack) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy.Encoding (decodeUtf8With) +import Formatting hiding (format) import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName)) import Text.Highlighter.Formatters.Html (format) import Yesod.Core.Widget (whamlet, toWidget) import Vervis.Foundation (Widget) +renderPlain :: ByteString -> Widget +renderPlain content = + [whamlet| + 
+            #{decodeUtf8With lenientDecode content}
+    |]
+
+renderHighlight
+    :: FilePath -> ByteString -> Either (Maybe Lexer) (Lexer, Widget)
+renderHighlight name content =
+    case lexerFromFilename name of
+        Nothing    -> Left Nothing
+        Just lexer ->
+            case runLexer lexer $ toStrict content of
+                Left err     -> Left $ Just lexer
+                Right tokens -> Right (lexer, toWidget $ format True tokens)
+
 renderSource :: FilePath -> ByteString -> Widget
 renderSource name content =
-    let raw =
-            [whamlet|
-              
-                #{decodeUtf8With lenientDecode content}
-            |]
-    in  case lexerFromFilename name of
-            Nothing    -> raw
-            Just lexer ->
-                case runLexer lexer $ toStrict content of
-                    Left err -> do
-                        $logWarn $ mconcat
-                            [ "Failed to highlight "
-                            , pack name
-                            , " with lexer "
-                            , pack $ lName lexer
-                            ]
-                        raw
-                    Right tokens -> toWidget $ format True tokens
+    let plain = renderPlain content
+    in  case renderHighlight name content of
+            Left Nothing -> do
+                $logDebug $ "No lexer found for " <> pack name
+                plain
+            Left (Just lexer) -> do
+                $logWarn $ sformat
+                    ( "Failed to highlight " % string % " with lexer "
+                    % string
+                    )
+                    name (lName lexer)
+                plain
+            Right (lexer, widget) -> do
+                $logDebug $ sformat
+                    ("Lexed " % string % " with " % string) name (lName lexer)
+                widget
diff --git a/templates/repo/source.hamlet b/templates/repo/source.hamlet
index 0916410..6ec8edb 100644
--- a/templates/repo/source.hamlet
+++ b/templates/repo/source.hamlet
@@ -41,7 +41,7 @@ $forall (piece, piecePath) <- dirs
 $case display
   $of Left source
     ^{source}
-  $of Right rows
+  $of Right (rows, mreadme)
     

       

         Type
@@ -52,3 +52,6 @@ $case display
           
             
               #{name}
+    $maybe (readmeName, readmeWidget) <- mreadme
+      
#{readmeName}
+      ^{readmeWidget}
diff --git a/vervis.cabal b/vervis.cabal
index 7cd528a..507a7d5 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -104,6 +104,7 @@ library
                      , fgl
                      , file-embed
                      , filepath
+                     , formatting
                      , hashable
                      , highlighter2
                      , hit