1 patch for repository http://darcs.net:

Sat Apr 26 20:15:34 ART 2014  Ale Gadea <alex.aegf@gmail.com>
  * Resolve Issue2244: darcs tag should warn about duplicate tags
  Make darcs tag t, with t already an existing tag, cause a error message and the command fail.

Attachments

• patch-preview.txt
• resolve-issue2244_-darcs-tag-should-warn-about-duplicate-tags.dpatch
• unnamed

issue2244 suggested this should be a warning, not an error. There are 
cases for tags where you do want to duplicate them (e.g. tagging repo 
states that build ok), so I think that would be a better approach. The 
user can then obliterate the tag if it was actually a mistake.

1 patch for repository http://darcs.net:

Tue Apr 29 02:58:51 ART 2014  Ale Gadea <alex.aegf@gmail.com>
  * Resolve Issue2244: darcs tag should warn about duplicate tags
  Make darcs tag t, with t already an existing tag, cause a warning message.
  Adding test case; issue2244-dup-tag-warning.

Attachments

• patch-preview.txt
• resolve-issue2244_-darcs-tag-should-warn-about-duplicate-tags.dpatch
• unnamed

Almost good to go in.


> hunk ./src/Darcs/Repository/Util.hs 29
>      , maybeApplyToTree
>      , defaultToks
>      , getMovesPs
> +    , patchSetfMap
>      ) where
>  
>  import Prelude hiding ( catch )
> hunk ./src/Darcs/Repository/Util.hs 62

(imports)

> hunk ./src/Darcs/Repository/Util.hs 296
>  maybeApplyToTree patch tree =
>      (Just `fmap` applyToTree patch tree) `catch` (\(_ :: IOException)
-> return Nothing)
>  
> +patchSetfMap:: (forall wW wZ . PatchInfoAnd p wW wZ -> IO a) ->
PatchSet p wW' wZ' -> IO [a]
> +patchSetfMap f = sequence . mapRL f . newset2RL
> +

I'm wondering if this is the best place for this function, but grepping
throught
Darcs/Patch didn't help so maybe it's good enough here.


> hunk ./src/Darcs/UI/Commands/ShowTags.hs 22
> hunk ./src/Darcs/UI/Commands/ShowTags.hs 26
> hunk ./src/Darcs/UI/Commands/ShowTags.hs 31

Imports.

> hunk ./src/Darcs/UI/Commands/ShowTags.hs 68
>  tagsCmd _ opts _ = let repodir = fromMaybe "." (getRepourl opts) in
>      withRepositoryDirectory (useCache opts) repodir $ RepoJob $ \repo
-> do
>          patches <- readRepo repo
> -        sequence_ $ mapRL process $ newset2RL patches
> -  where
> -    process hp = case piTag $ info hp of
> -                     Just t -> normalize t t False >>= putStrLn
> -                     Nothing -> return ()
> -    normalize :: String -> String -> Bool -> IO String
> -    normalize _ [] _ = return []
> -    normalize t (x : xs) flag =
> -        if x == '\t' then do
> -            unless flag $
> -                hPutStrLn stderr $ "warning: tag with TAB character:
" ++ t
> -            rest <- normalize t xs True
> -            return $ ' ' : rest
> -        else do
> -            rest <- normalize t xs flag
> -            return $ x : rest
> +        printTags patches
> +
> +printTags :: MaybeInternal p => PatchSet p wW wZ -> IO ()
> +printTags = join . fmap (sequence_ . map process) . getTags
> +    where
> +        process :: String -> IO ()
> +        process t = normalize t t False >>= putStrLn
> +        normalize :: String -> String -> Bool -> IO String
> +        normalize _ [] _ = return []
> +        normalize t (x : xs) flag =
> +            if x == '\t' then do
> +                unless flag $
> +                    hPutStrLn stderr $ "warning: tag with TAB
character: " ++ t
> +                rest <- normalize t xs True
> +                return $ ' ' : rest
> +            else do
> +                rest <- normalize t xs flag
> +                return $ x : rest


I guess you had to do this because the compiler complained about
unprecise types?

Can you define 'printTags' as a where-scoped function, and add its type
there, in order to have a smaller hunk?

> hunk ./src/Darcs/UI/Commands/Tag.hs 18
>  --  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
>  --  Boston, MA 02110-1301, USA.
>  
> -module Darcs.UI.Commands.Tag ( tag ) where
> +module Darcs.UI.Commands.Tag ( tag, getTags ) where
>  import Control.Monad ( when )
> hunk ./src/Darcs/UI/Commands/Tag.hs 20
> hunk ./src/Darcs/UI/Commands/Tag.hs 32
> hunk ./src/Darcs/UI/Commands/Tag.hs 34
> hunk ./src/Darcs/UI/Commands/Tag.hs 40

(imports)

> hunk ./src/Darcs/UI/Commands/Tag.hs 101
>    withRepoLock NoDryRun (useCache opts) YesUpdateWorking (umask opts)
$ RepoJob $ \(repository :: Repository p wR wU wR) -> do
>      date <- getDate opts
>      the_author <- getAuthor opts
> -    deps <- (getUncovered . filterNonInternal) `fmap` readRepo repository
> -    (name, long_comment)  <- get_name_log (NilFL :: FL (PrimOf p) wA
wA) opts args
> +    patches <- readRepo repository
> +    tags <- getTags patches
> +    let deps = (getUncovered . filterNonInternal) patches
> +    (name, long_comment)  <- get_name_log (NilFL :: FL (PrimOf p) wA
wA) opts args tags
>      myinfo <- patchinfo date name the_author long_comment
>      let mypatch = infopatch myinfo NilFL
>      _ <- tentativelyAddPatch repository (compression opts) (verbosity
opts) YesUpdateWorking

Naming 'tags' to pass them to get_name_log, ok.


> hunk ./src/Darcs/UI/Commands/Tag.hs 111
>               $ n2pia $ adddeps mypatch deps
>      finalizeRepositoryChanges repository YesUpdateWorking
(compression opts)
>      putStrLn $ "Finished tagging patch '"++name++"'"
> -  where  get_name_log ::(Patchy prim, PrimPatch prim) => FL prim wA
wA -> [DarcsFlag] -> [String] -> IO (String, [String])
> -         get_name_log nilFL o a
> +    where  
> +         get_name_log ::(Patchy prim, PrimPatch prim) => FL prim wA
wA -> [DarcsFlag] -> [String] -> [String] -> IO (String, [String])
> +         get_name_log nilFL o a tags
>                            = do let o2 = if null a then o else
add_patch_name o (unwords a)
>                                 (name, comment, _) <- getLog o2
Nothing nilFL
>                                 when (length name < 2) $ hPutStr stderr $

I'd have called 'tags' 'existing', but it's okay.

> hunk ./src/Darcs/UI/Commands/Tag.hs 119
>                                   "Do you really want to tag '"
>                                   ++name++"'? If not type: darcs
obliterate --last=1\n"
> +                               when (name `elem` tags) $
> +                                  putStrLn $ "WARNING: The tag "  ++ 
> +                                             "\"" ++ name ++ "\"" ++
> +                                             " already exists."
>                                 return ("TAG " ++ name, comment)
>           add_patch_name :: [DarcsFlag] -> String -> [DarcsFlag]
>           add_patch_name o a| has_patch_name o = o

Good.

> hunk ./src/Darcs/UI/Commands/Tag.hs 131
>           has_patch_name (_:fs) = has_patch_name fs
>           has_patch_name [] = False
>  
> +getTags :: MaybeInternal p => PatchSet p wW wR -> IO [String]
> +getTags = fmap catMaybes . patchSetfMap (return . piTag . info)
> +
>  -- This may be useful for developers, but users don't care about
>  -- internals:
>  --

I think the following is less surprising (see other uses of
fmap in the source of darcs):

    getTags ps = catMaybes `fmap` patchSetfMap (return . piTag . info) ps

> addfile ./tests/issue2244-dup-tag-warning.sh
> hunk ./tests/issue2244-dup-tag-warning.sh 1
> +#!/usr/bin/env bash
> +. lib                           # Load some portability helpers.
> +
> +t=`(dd if=/dev/urandom count=1 | tr -cd "a-zA-Z0-9" | head -c 10)` #
Create de tag name.
> +darcs init --repo R        # Create our test repos.
> +
> +# Test about issue 2244: darcs tag should warn about duplicate tags.
> +
> +cd R
> +darcs tag "$t"
> +darcs show tag | grep "$t"
> +darcs tag "$t" | grep 'WARNING'
> +cd ..

Cool.


Also the last line of the long description is unnecessary, resolve
patchs often come with tests or rename failing tests to working ones.

Hi hi,

some minor comments. Sending the amended patch.

> hunk ./src/Darcs/Repository/Util.hs 296
> >  maybeApplyToTree patch tree =
> >      (Just `fmap` applyToTree patch tree) `catch` (\(_ :: IOException)
> -> return Nothing)
> >
> > +patchSetfMap:: (forall wW wZ . PatchInfoAnd p wW wZ -> IO a) ->
> PatchSet p wW' wZ' -> IO [a]
> > +patchSetfMap f = sequence . mapRL f . newset2RL
> > +
>
> I'm wondering if this is the best place for this function, but grepping
> throught
> Darcs/Patch didn't help so maybe it's good enough here.
>

I don't quite decide neither :\ jeje.


> > hunk ./src/Darcs/UI/Commands/ShowTags.hs 68
> >  tagsCmd _ opts _ = let repodir = fromMaybe "." (getRepourl opts) in
> >      withRepositoryDirectory (useCache opts) repodir $ RepoJob $ \repo
> -> do
> >          patches <- readRepo repo
> > -        sequence_ $ mapRL process $ newset2RL patches
> > -  where
> > -    process hp = case piTag $ info hp of
> > -                     Just t -> normalize t t False >>= putStrLn
> > -                     Nothing -> return ()
> > -    normalize :: String -> String -> Bool -> IO String
> > -    normalize _ [] _ = return []
> > -    normalize t (x : xs) flag =
> > -        if x == '\t' then do
> > -            unless flag $
> > -                hPutStrLn stderr $ "warning: tag with TAB character:
> " ++ t
> > -            rest <- normalize t xs True
> > -            return $ ' ' : rest
> > -        else do
> > -            rest <- normalize t xs flag
> > -            return $ x : rest
> > +        printTags patches
> > +
> > +printTags :: MaybeInternal p => PatchSet p wW wZ -> IO ()
> > +printTags = join . fmap (sequence_ . map process) . getTags
> > +    where
> > +        process :: String -> IO ()
> > +        process t = normalize t t False >>= putStrLn
> > +        normalize :: String -> String -> Bool -> IO String
> > +        normalize _ [] _ = return []
> > +        normalize t (x : xs) flag =
> > +            if x == '\t' then do
> > +                unless flag $
> > +                    hPutStrLn stderr $ "warning: tag with TAB
> character: " ++ t
> > +                rest <- normalize t xs True
> > +                return $ ' ' : rest
> > +            else do
> > +                rest <- normalize t xs flag
> > +                return $ x : rest
>
>
> I guess you had to do this because the compiler complained about
> unprecise types?
>

Yes, exactly.


> Can you define 'printTags' as a where-scoped function, and add its type
> there, in order to have a smaller hunk?
>
> Oh! it's true :)


> > hunk ./src/Darcs/UI/Commands/Tag.hs 101
> >    withRepoLock NoDryRun (useCache opts) YesUpdateWorking (umask opts)
> $ RepoJob $ \(repository :: Repository p wR wU wR) -> do
> >      date <- getDate opts
> >      the_author <- getAuthor opts
> > -    deps <- (getUncovered . filterNonInternal) `fmap` readRepo
> repository
> > -    (name, long_comment)  <- get_name_log (NilFL :: FL (PrimOf p) wA
> wA) opts args
> > +    patches <- readRepo repository
> > +    tags <- getTags patches
> > +    let deps = (getUncovered . filterNonInternal) patches
> > +    (name, long_comment)  <- get_name_log (NilFL :: FL (PrimOf p) wA
> wA) opts args tags
> >      myinfo <- patchinfo date name the_author long_comment
> >      let mypatch = infopatch myinfo NilFL
> >      _ <- tentativelyAddPatch repository (compression opts) (verbosity
> opts) YesUpdateWorking
>
> Naming 'tags' to pass them to get_name_log, ok.


Passing 'tags' to get_name_log seems the best way to avoid have to
erase "TAG " from the head of name later outside get_name_log.

> hunk ./src/Darcs/UI/Commands/Tag.hs 131
> >           has_patch_name (_:fs) = has_patch_name fs
> >           has_patch_name [] = False
> >
> > +getTags :: MaybeInternal p => PatchSet p wW wR -> IO [String]
> > +getTags = fmap catMaybes . patchSetfMap (return . piTag . info)
> > +
> >  -- This may be useful for developers, but users don't care about
> >  -- internals:
> >  --
>
> I think the following is less surprising (see other uses of
> fmap in the source of darcs):
>
>     getTags ps = catMaybes `fmap` patchSetfMap (return . piTag . info) ps
>

I like the other way, without the arguments jeje, but it's ok :)

cheers!
-- 
Ale Gadea

Attachments

• unnamed

1 patch for repository http://darcs.net:

Wed Apr 30 02:00:29 ART 2014  Ale Gadea <alex.aegf@gmail.com>
  * Resolve Issue2244: darcs tag should warn about duplicate tags
  Make darcs tag t, with t already an existing tag, cause a warning message.

Attachments

• patch-preview.txt
• resolve-issue2244_-darcs-tag-should-warn-about-duplicate-tags.dpatch
• unnamed

Good to go.

I amended unnecessary indentation changes so that the hunks be as
minimal as possible, have a look at it Alejandro (and obliterate your
local version of it).

Attachments

• resolve-issue2244_-darcs-tag-should-warn-about-duplicate-tags.dpatch

This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/screened.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_screened.html#bundle-c8a618b977fb1a226d7ea105fc7f06c26b7bbe72

This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-c8a618b977fb1a226d7ea105fc7f06c26b7bbe72