vervis/src/Vervis/Handler/Repo/Darcs.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/>.
 -}

module Vervis.Handler.Repo.Darcs
    ( getDarcsRepoSource
    , getDarcsRepoHeadChanges
    , getDarcsRepoChanges
    , getDarcsDownloadR
    )
where

import Prelude

import Control.Monad.IO.Class (liftIO)
import Data.List (inits)
import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Database.Esqueleto
import System.FilePath ((</>), joinPath)
import System.Directory (doesFileExist)
import Text.Blaze.Html (Html)
import Yesod.Core (defaultLayout, setTitle)
import Yesod.Core.Content (TypedContent, typeOctet)
import Yesod.Core.Handler (sendFile, notFound)

import qualified Data.DList as D
import qualified Data.Set as S (member)
import qualified Data.Text as T (unpack)
import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)

import Data.ByteString.Char8.Local (takeLine)
import Text.FilePath.Local (breakExt)
import Vervis.Form.Repo
import Vervis.Foundation
import Vervis.Path
import Vervis.MediaType (chooseMediaType)
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Repo
import Vervis.Paginate
import Vervis.Readme
import Vervis.Render
import Vervis.Settings
import Vervis.SourceTree
import Vervis.Style
import Vervis.Widget.Repo

import qualified Darcs.Local.Repository as D (createRepo)
import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Vervis.Darcs as D (readSourceView, readChangesView)

getDarcsRepoSource :: Repo -> ShrIdent -> RpIdent -> [Text] -> Handler Html
getDarcsRepoSource repository user repo dir = do
    path <- askRepoDir user repo
    msv <- liftIO $ D.readSourceView path dir
    case msv of
        Nothing -> notFound
        Just sv -> do
            let parent = if null dir then [] else init dir
                dirs = zip parent (tail $ inits parent)
            defaultLayout $(widgetFile "repo/source-darcs")

getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler Html
getDarcsRepoHeadChanges shar repo = do
    path <- askRepoDir shar repo
    (entries, navModel) <- getPageAndNav $
        \ o l -> do
            mv <- liftIO $ D.readChangesView path o l
            case mv of
                Nothing -> notFound
                Just v  -> return v
    let changes = changesW entries
        pageNav = navWidget navModel
    defaultLayout $(widgetFile "repo/changes-darcs")

getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler Html
getDarcsRepoChanges shar repo tag = notFound

getDarcsDownloadR :: ShrIdent -> RpIdent -> [Text] -> Handler TypedContent
getDarcsDownloadR shar repo dir = do
    path <- askRepoDir shar repo
    let darcsDir = path </> "_darcs"
        filePath = darcsDir </> joinPath (map T.unpack dir)
    exists <- liftIO $ doesFileExist filePath
    if exists
        then sendFile typeOctet filePath
        else notFound