{- This file is part of Vervis.
 -
 - Written in 2016, 2018, 2019, 2020, 2022
 - 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.Web.Darcs
    ( getDarcsRepoSource
    , getDarcsRepoChanges
    , getDarcsPatch
    )
where

import Control.Monad.IO.Class (liftIO)
import Data.List (inits)
import Data.Maybe
import Data.Text (Text, unpack)
import Data.Text.Encoding
import Data.Text.Encoding.Error (lenientDecode)
import Data.Traversable (for)
import Database.Esqueleto
import Network.HTTP.Types
import System.FilePath ((</>), joinPath)
import System.Directory (doesFileExist)
import Text.Blaze.Html (Html)
import Yesod.Core hiding (joinPath)
import Yesod.Core.Content (TypedContent, typeOctet)
import Yesod.Core.Handler (selectRep, provideRep, sendFile, notFound)
import Yesod.Persist.Core (runDB, get404)
import Yesod.AtomFeed (atomFeed)
import Yesod.RssFeed (rssFeed)

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

import Data.MediaType
import Development.PatchMediaType
import Network.FedURI
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite
import Yesod.RenderSource

import qualified Web.ActivityPub as AP

import Data.ByteString.Char8.Local (takeLine)
import Data.Paginate.Local
import Data.Patch.Local
import Text.FilePath.Local (breakExt)

import Vervis.ActivityPub
import Vervis.ChangeFeed (changeFeed)
import Vervis.Changes
import Vervis.Foundation
import Vervis.Path
import Vervis.Model
import Vervis.Paginate
import Vervis.Readme
import Vervis.Settings
import Vervis.SourceTree
import Vervis.Style
import Vervis.Time
import Vervis.Web.Repo
import Vervis.Widget
import Vervis.Widget.Person
import Vervis.Widget.Repo

import qualified Vervis.Darcs as D

getDarcsRepoSource
    :: Repo -> Actor -> KeyHashid Repo -> [Text] -> [LoomId] -> Handler Html
getDarcsRepoSource repository actor repo dir loomIDs = do
    path <- askRepoDir 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)
            looms <- runDB $ for loomIDs $ \ loomID -> do
                loom <- getJust loomID
                (loomID,) <$> getJust (loomActor loom)
            defaultLayout $ do
                hashLoom <- getEncodeKeyHashid
                host <- asksSite siteInstanceHost
                ms <- lookupGetParam "style"
                style <-
                    case ms of
                        Nothing -> getsYesod $ appHighlightStyle . appSettings
                        Just s -> return s
                addStylesheet $ HighlightStyleR style
                $(widgetFile "repo/source-darcs")
    where
    followButton =
        followW (RepoFollowR repo) (RepoUnfollowR repo) (actorFollowers actor)

getDarcsRepoChanges :: KeyHashid Repo -> Handler TypedContent
getDarcsRepoChanges repo = do
    path <- askRepoDir repo
    let here = RepoCommitsR repo
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    encodeRoutePageLocal <- getEncodeRoutePageLocal
    let pageUrl = encodeRoutePageLocal here
        getChanges o l = do
            mv <- liftIO $ D.readChangesView path o l
            case mv of
                Nothing -> notFound
                Just v  -> return v
    mpage <- getPageAndNavMaybe getChanges
    case mpage of
        Nothing -> do
            (total, pages, _, _) <- getPageAndNavTop getChanges
            let collection = AP.Collection
                    { AP.collectionId         = encodeRouteLocal here
                    , AP.collectionType       = AP.CollectionTypeOrdered
                    , AP.collectionTotalItems = Just total
                    , AP.collectionCurrent    = Nothing
                    , AP.collectionFirst      = Just $ pageUrl 1
                    , AP.collectionLast       = Just $ pageUrl pages
                    , AP.collectionItems      = [] :: [Text]
                    }
            provideHtmlAndAP collection $ redirectFirstPage here
        Just (_total, pages, items, navModel) ->
            let current = nmCurrent navModel
                page = AP.CollectionPage
                    { AP.collectionPageId         = pageUrl current
                    , AP.collectionPageType       = AP.CollectionPageTypeOrdered
                    , AP.collectionPageTotalItems = Nothing
                    , AP.collectionPageCurrent    = Just $ pageUrl current
                    , AP.collectionPageFirst      = Just $ pageUrl 1
                    , AP.collectionPageLast       = Just $ pageUrl pages
                    , AP.collectionPagePartOf     = encodeRouteLocal here
                    , AP.collectionPagePrev       =
                        if current > 1
                            then Just $ pageUrl $ current - 1
                            else Nothing
                    , AP.collectionPageNext       =
                        if current < pages
                            then Just $ pageUrl $ current + 1
                            else Nothing
                    , AP.collectionPageStartIndex = Nothing
                    , AP.collectionPageItems      =
                        map (encodeRouteHome . RepoCommitR repo . leHash)
                            items
                    }
                feed = changeFeed repo Nothing VCSDarcs items
            in  provideHtmlFeedAndAP page feed $
                    let changes = changesW repo items
                        pageNav = navWidget navModel
                    in  $(widgetFile "repo/changes-darcs")

getDarcsPatch :: KeyHashid Repo -> Text -> Handler TypedContent
getDarcsPatch hash ref = do
    path <- askRepoDir hash
    mpatch <- liftIO $ D.readPatch path ref
    case mpatch of
        Nothing -> notFound
        Just patch -> serveCommit hash ref patch []