1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2025-01-06 07:16:45 +09:00
vervis/src/Vervis
2016-05-25 21:10:41 +00:00
..
Field Add group routes 2016-05-24 21:48:21 +00:00
Form Add group routes 2016-05-24 21:48:21 +00:00
Handler Libravatar support \o/ 2016-05-25 21:10:41 +00:00
Import Build with LTS-5.13 2016-04-19 06:38:52 +00:00
Model Add group roles and make a group's creator its admin 2016-05-25 15:52:15 +00:00
Settings Put all modules under a new Vervis module 2016-02-23 08:45:03 +00:00
Widget Add group routes 2016-05-24 21:48:21 +00:00
Application.hs Add group routes 2016-05-24 21:48:21 +00:00
Avatar.hs Libravatar support \o/ 2016-05-25 21:10:41 +00:00
BinaryBody.hs Binary request body decoder 2016-04-24 18:48:07 +00:00
Changes.hs Explore friendly rendering of event time 2016-05-05 22:20:11 +00:00
Content.hs Send raw pack as git-upload-pack-result 2016-04-29 04:32:32 +00:00
Darcs.hs Compressed inventory parser and DarcsRev TH utils 2016-05-17 20:34:22 +00:00
Discussion.hs Pass AppDB action instead of DiscussionId 2016-05-19 22:40:54 +00:00
Formatting.hs Finish route change, it builds now 2016-05-23 20:46:54 +00:00
Foundation.hs Add group members page and breadcrumbs for group routes 2016-05-25 16:03:58 +00:00
Git.hs Minimal pagination for git and darcs change log 2016-05-13 08:49:19 +00:00
GitOld.hs Refactor git source view code and implement the same for Darcs 2016-05-05 07:29:19 +00:00
Import.hs Put all modules under a new Vervis module 2016-02-23 08:45:03 +00:00
MediaType.hs Use Pandoc for document rendering, for now just Markdown 2016-04-17 17:55:23 +00:00
Model.hs Add group roles and make a group's creator its admin 2016-05-25 15:52:15 +00:00
Paginate.hs Minimal pagination for git and darcs change log 2016-05-13 08:49:19 +00:00
Path.hs Start big route change, doesn't build yet 2016-05-23 12:24:14 +00:00
Readme.hs Refactor git source view code and implement the same for Darcs 2016-05-05 07:29:19 +00:00
Render.hs Render ticket description as Markdown 2016-05-02 21:20:25 +00:00
Settings.hs Add settings option to disable registration 2016-04-19 16:03:27 +00:00
SourceTree.hs Refactor git source view code and implement the same for Darcs 2016-05-05 07:29:19 +00:00
Ssh.hs Enable darcs-push-over-SSH using the darcs executable 2016-05-05 07:58:45 +00:00
Style.hs Put all modules under a new Vervis module 2016-02-23 08:45:03 +00:00
TicketFilter.hs Ticket filtering 2016-05-22 14:31:56 +00:00
Time.hs Show creation date in group page 2016-05-25 07:50:10 +00:00
Widget.hs Libravatar support \o/ 2016-05-25 21:10:41 +00:00

{- 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
    ( isReadme
    , renderReadme
    )
where

import Prelude hiding (takeWhile)

import Data.ByteString.Lazy (ByteString)
import Data.Git.Harder (ObjId (..))
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 System.FilePath (isExtSeparator)

import Data.Git.Local (TreeRows)
import Text.FilePath.Local (breakExt)
import Vervis.Foundation (Widget)
import Vervis.MediaType (chooseMediaType)
import Vervis.Render (renderSourceBL)

-- | 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

-- | 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