vervis/src/Vervis/Readme.hs

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

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