| By | fr33domlover |
| At | 2016-04-20 |
| Title | Move utils from RefDiscovery to new Data.Git.Local module |
| Description |
Edit file hit-network.cabal 0 → 0
+ 42 Data.Git.Local
+ 48 , containers
+ 49 , hit
+ 50 , hit-graph
… … … … Add file src/Data/Git 0
Add file src/Data/Git/Local.hs 0
Edit file src/Data/Git/Local.hs 0 → 0
+ 1 {- This file is part of hit-network.+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 {-# LANGUAGE OverloadedStrings #-}+ 17 + 18 module Data.Git.Local
+ 19 ( resolveHead
+ 20 , listBranches
+ 21 , listTags
+ 22 , peelTag
+ 23 )
+ 24 where
+ 25 + 26 import Prelude
+ 27 + 28 import Data.ByteString (ByteString)
+ 29 import Data.Git.Graph.Util (ObjId (..), resolveName, resolveNameMaybe)
+ 30 import Data.Git.Named (RefName (..))
+ 31 import Data.Git.Repository (branchList, tagList)
+ 32 import Data.Git.Storage (Git, getObject)
+ 33 import Data.Git.Storage.Object (Object (ObjTag))
+ 34 import Data.Git.Types (Tag (tagRef))
+ 35 import Data.Set (Set)
+ 36 + 37 import qualified Data.ByteString as B
+ 38 import qualified Data.ByteString.Char8 as BC (pack)
+ 39 import qualified Data.Set as S
+ 40 + 41 listHelper
+ 42 :: (Git -> IO (Set RefName))
+ 43 -> ByteString
+ 44 -> Git
+ 45 -> IO [(ObjId, ByteString)]
+ 46 listHelper get prefix git = do
+ 47 names <- S.mapMonotonic refNameRaw <$> get git
+ 48 let resolve name =
+ 49 let nameb = BC.pack name
+ 50 in if prefix `B.isPrefixOf` nameb
+ 51 then do
+ 52 oid <- resolveName git name
+ 53 return (oid, B.drop (B.length prefix) nameb)
+ 54 else error "found name which doesn't have expected prefix"
+ 55 traverse resolve $ S.toAscList names
+ 56 + 57 -- | Find the object ID for HEAD if it exists.
+ 58 resolveHead :: Git -> IO (Maybe ObjId)
+ 59 resolveHead git = resolveNameMaybe git "HEAD"
+ 60 + 61 -- | Get the IDs (i.e. SHA1) and names (e.g. master) of all branches, ordered
+ 62 -- alphabetically.
+ 63 listBranches :: Git -> IO [(ObjId, ByteString)]
+ 64 listBranches = listHelper branchList "refs/heads/"
+ 65 + 66 -- | Get the IDs (i.e. SHA1) and names (e.g. v0.1) of all tags, ordered
+ 67 -- alphabetically. This includes both lightweight tags (which point to commit
+ 68 -- objects) and annotated tags (which point to tag objects).
+ 69 listTags :: Git -> IO [(ObjId, ByteString)]
+ 70 listTags = listHelper tagList "refs/tags/"
+ 71 + 72 -- | If the given object ID refers to a tag object, i.e. an annotated tag,
+ 73 -- return the object ID of the commit it points to. Otherwise, return
+ 74 -- 'Nothing'.
+ 75 peelTag :: Git -> ObjId -> IO (Maybe ObjId)
+ 76 peelTag git oid = do
+ 77 mobj <- getObject git (unObjId oid) True
+ 78 case mobj of
+ 79 Just (ObjTag tag) -> return $ Just $ ObjId $ tagRef tag
+ 80 _ -> return Nothing
… … … … Edit file src/Network/Git/Fetch/RefDiscovery.hs 0 → 0
- 128 listHelper
- 129 :: (Git -> IO (S.Set RefName))
- 130 -> ByteString
- 131 -> Git
- 132 -> IO [(ObjId, ByteString)]
- 133 listHelper get prefix git = do
- 134 names <- S.mapMonotonic refNameRaw <$> get git
- 135 let resolve name =
- 136 let nameb = B.pack name
- 137 in if prefix `B.isPrefixOf` nameb
- 138 then do
- 139 oid <- resolveName git name
- 140 return (oid, B.drop (B.length prefix) nameb)
- 141 else error "found name which doesn't have expected prefix"
- 142 liftIO $ traverse resolve $ S.toAscList names
- 143 - 144 resolveHead :: Git -> IO (Maybe ObjId)
- 145 resolveHead git = resolveNameMaybe git "HEAD"
- 146 - 147 listBranches :: Git -> IO [(ObjId, String)]
- 148 listBranches = listHelper branchList "refs/heads/"
- 149 - 150 listTags :: Git -> IO [(ObjId, String)]
- 151 listTags = listHelper tagList "refs/tags/"
- 152 - 153 -- | If the given object ID refers to a tag object, i.e. an annotated tag,
- 154 -- return the object ID of the commit it points to. Otherwise, return
- 155 -- 'Nothing'.
- 156 peelRef :: Git -> ObjId -> IO (Maybe ObjId)
- 157 peelRef git oid = do
- 158 mobj <- getObject git $ unObjId oid
- 159 case mobj of
- 160 Just (ObjTag tag) -> return $ Just $ ObjId $ tagRef tag
- 161 _ -> return Nothing
- 162 … … … … Edit file stack.yaml 0 → 0
- 6 resolver: lts-5.10
+ 6 resolver: lts-5.13
- 14 extra-deps: []
+ 14 extra-deps:
+ 15 - hit-graph-0.1
+ 16 - unordered-containers-0.2.6.0
… … … …