unused: Add --used option, which can specify a set of refs to consider used, rather than the default of considering all refs used.
This commit is contained in:
parent
a2fd8be337
commit
86699ff861
6 changed files with 116 additions and 25 deletions
44
Types/RefSpec.hs
Normal file
44
Types/RefSpec.hs
Normal file
|
@ -0,0 +1,44 @@
|
|||
{- This is not the same as git's fetch/push refspecs.
|
||||
-
|
||||
- Copyright 2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Types.RefSpec where
|
||||
|
||||
import Common
|
||||
import Utility.Glob
|
||||
import Git.Types
|
||||
|
||||
import Data.Either
|
||||
|
||||
type RefSpec = [RefSpecPart]
|
||||
|
||||
data RefSpecPart = AddRef Ref | AddMatching Glob | RemoveMatching Glob
|
||||
|
||||
allRefSpec :: RefSpec
|
||||
allRefSpec = [AddMatching $ compileGlob "*" CaseSensative]
|
||||
|
||||
parseRefSpec :: String -> Either String RefSpec
|
||||
parseRefSpec v = case partitionEithers (map mk $ split ":" v) of
|
||||
([],refspec) -> Right refspec
|
||||
(e:_,_) -> Left e
|
||||
where
|
||||
mk ('+':s)
|
||||
| any (`elem` s) "*?" =
|
||||
Right $ AddMatching $ compileGlob s CaseSensative
|
||||
| otherwise = Right $ AddRef $ Ref s
|
||||
mk ('-':s) = Right $ RemoveMatching $ compileGlob s CaseSensative
|
||||
mk s = Left $ "bad refspec item \"" ++ s ++ "\" (expected + or - prefix)"
|
||||
|
||||
applyRefSpec :: RefSpec -> [Ref] -> [Ref]
|
||||
applyRefSpec refspec rs = go [] refspec
|
||||
where
|
||||
go c [] = reverse c
|
||||
go c (AddRef r : rest) = go (r:c) rest
|
||||
go c (AddMatching g : rest) =
|
||||
let add = filter (matchGlob g . fromRef) rs
|
||||
in go (add ++ c) rest
|
||||
go c (RemoveMatching g : rest) =
|
||||
go (filter (not . matchGlob g . fromRef) c) rest
|
Loading…
Add table
Add a link
Reference in a new issue