mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-12 18:45:08 +09:00
88 lines
2.9 KiB
Haskell
88 lines
2.9 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/>.
|
|
-}
|
|
|
|
module Vervis.Handler.Repo.Darcs
|
|
( getDarcsRepoSource
|
|
, getDarcsRepoHeadChanges
|
|
, getDarcsRepoChanges
|
|
)
|
|
where
|
|
|
|
import ClassyPrelude.Conduit hiding (last, unpack)
|
|
import Yesod hiding (Header, parseTime, (==.))
|
|
import Yesod.Auth
|
|
|
|
import Prelude (init, last, tail)
|
|
|
|
import Data.List (inits)
|
|
import Data.Text (unpack)
|
|
import Data.Text.Encoding (decodeUtf8With)
|
|
import Data.Text.Encoding.Error (lenientDecode)
|
|
import Database.Esqueleto
|
|
import System.Directory (createDirectoryIfMissing)
|
|
|
|
import qualified Data.DList as D
|
|
import qualified Data.Set as S (member)
|
|
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.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 -> Text -> Text -> [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 $ do
|
|
setTitle $ toHtml $ intercalate " > "
|
|
["Vervis", "People", user, "Repos", repo]
|
|
$(widgetFile "repo/source-darcs")
|
|
|
|
getDarcsRepoHeadChanges :: Text -> Text -> 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 :: Text -> Text -> Text -> Handler Html
|
|
getDarcsRepoChanges shar repo tag = notFound
|