mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-01-09 13:56:46 +09:00
d8d2d160a0
At the beginning the rendering was invalid because it parsed the entire content as a single line. For some reason, when I read the ticket description from the DB, all newlines are returned as CRLF. I don't know why yet or whether it can or should be changed, but as a quick fix, I made the handler function filter out the CRs from the text. Then the rendering is correct. This matches the documentation of Pandoc, which mentions the readers assume newlines are encoded as LF.
68 lines
2.4 KiB
Haskell
68 lines
2.4 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ 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
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
-- | Tools for rendering README files in repository tree view.
|
|
module Vervis.Readme
|
|
( findReadme
|
|
, renderReadme
|
|
)
|
|
where
|
|
|
|
import Prelude hiding (takeWhile)
|
|
|
|
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, takeWhile, unpack)
|
|
import Data.Text.Encoding (decodeUtf8With)
|
|
import Data.Text.Encoding.Error (strictDecode)
|
|
import System.FilePath (isExtSeparator)
|
|
|
|
import Vervis.Foundation (Widget)
|
|
import Vervis.MediaType (chooseMediaType)
|
|
import Vervis.Render (renderSourceBL)
|
|
import Text.FilePath.Local (breakExt)
|
|
|
|
-- | Check if the given filename should be considered as README file. Assumes
|
|
-- a flat filename which doesn't contain a directory part.
|
|
isReadme :: Text -> Bool
|
|
isReadme file =
|
|
let basename = takeWhile (not . isExtSeparator) file
|
|
in toCaseFold "readme" == toCaseFold basename
|
|
|
|
-- | 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 isReadme 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] -> Text -> ByteString -> Widget
|
|
renderReadme dir name content =
|
|
let (base, ext) = breakExt name
|
|
mediaType = chooseMediaType dir base ext () ()
|
|
in renderSourceBL mediaType content
|