{- 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.Git ( readSourceView ) where import Prelude import Data.Foldable (find) import Data.Git import Data.Git.Harder import Data.Git.Storage (getObject_) import Data.Git.Storage.Object (Object (..)) import Data.Set (Set) import Data.String (fromString) import Data.Text (Text, unpack, pack) import Data.Text.Encoding (encodeUtf8) import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.Set as S (member, mapMonotonic) import Data.Git.Local import Vervis.Foundation (Widget) import Vervis.Readme import Vervis.SourceTree matchReadme :: (ModePerm, ObjId, Text, EntObjType) -> Bool matchReadme (_, _, name, EntObjBlob) = isReadme name matchReadme _ = False -- | Find a README file in a directory. Return the filename and the file -- content. findReadme :: Git -> TreeRows -> IO (Maybe (Text, BL.ByteString)) findReadme git rows = case find matchReadme rows of Nothing -> return Nothing Just (_perm, oid, name, _etype) -> do obj <- getObject_ git (unObjId oid) True return $ case obj of ObjBlob b -> Just (name, blobGetContent b) _ -> Nothing matchType :: EntObjType -> EntryType matchType EntObjBlob = TypeBlob matchType EntObjTree = TypeTree rowToEntry :: (ModePerm, ObjId, Text, EntObjType) -> DirEntry rowToEntry (_, _, name, etype) = DirEntry (matchType etype) name loadSourceView :: Git -> Text -> [Text] -> IO (Set RefName, Set RefName, Maybe (SourceView BL.ByteString)) loadSourceView git refT dir = do branches <- branchList git tags <- tagList git let refS = unpack refT refN = RefName refS msv <- if refN `S.member` branches || refN `S.member` tags then do tipOid <- resolveName git refS mtree <- resolveTreeish git $ unObjId tipOid case mtree of Nothing -> return Nothing Just tree -> do let dir' = map (entName . encodeUtf8) dir view <- viewPath git tree dir' Just <$> case view of RootView rows -> do mreadme <- findReadme git rows let ents = map rowToEntry rows return $ SourceDir $ DirectoryView Nothing ents mreadme TreeView name _ rows -> do mreadme <- findReadme git rows let ents = map rowToEntry rows return $ SourceDir $ DirectoryView (Just name) ents mreadme BlobView name _ body -> return $ SourceFile $ FileView name body else return Nothing return (branches, tags, msv) readSourceView :: FilePath -- ^ Repository path -> Text -- ^ Name of branch or tag -> [Text] -- ^ Path in the source tree pointing to a file or directory -> IO (Set Text, Set Text, Maybe (SourceView Widget)) -- ^ Branches, tags, view of the selected item readSourceView path ref dir = do (bs, ts, msv) <- withRepo (fromString path) $ \ git -> loadSourceView git ref dir let toTexts = S.mapMonotonic $ pack . refNameRaw return (toTexts bs, toTexts ts, renderSources dir <$> msv)