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