[darcs-devel] [patch1147] Resolve Issue2244: darcs tag should warn about duplica...

[Alejandro Gadea]

Alejandro Gadea <alex.aegf at gmail.com> added the comment:

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

__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch1147>
__________________________________
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.osuosl.org/pipermail/darcs-devel/attachments/20140430/3a3b9383/attachment.html>