[darcs-devel] [patch481] disentangle Darcs.Patch.Named from Darcs... (and 4 more)

Florent Becker bugs at darcs.net
Wed Jan 12 20:02:39 UTC 2011


Florent Becker <florent.becker at ens-lyon.org> added the comment:

Here is a review of the first 4 patches. The 4th actually depends on 
patch 484.

disentangle Darcs.Patch.Named from Darcs.Patch.Viewing
------------------------------------------------------
Ganesh Sittampalam <ganesh at earth.li>**20101122064253

hunk ./src/Darcs/Patch/Named.lhs 39

hunk ./src/Darcs/Patch/Named.lhs 47

hunk ./src/Darcs/Patch/Named.lhs 53

[imports]

hunk ./src/Darcs/Patch/Named.lhs 207
>      listConflictedFiles (NamedP _ _ p) = listConflictedFiles p
>      resolveConflicts (NamedP _ _ p) = resolveConflicts p
>      isInconsistent (NamedP _ _ p) = isInconsistent p
> +
> +instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic 
(Named p) where
> +    showPatch (NamedP n [] p) = showPatchInfo n <> showPatch p
> +    showPatch (NamedP n d p) = showNamedPrefix n d <+> showPatch p
> +
> +instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
ShowPatch (Named p) where
> +    showContextPatch (NamedP n [] p) = showContextPatch p >>= return 
. (showPatchInfo n <>)
> +    showContextPatch (NamedP n d p) = showContextPatch p >>= return . 
(showNamedPrefix n d <+>)
> +    description (NamedP n _ _) = humanFriendly n
> +    summary p = description p $$ text "" $$
> +                prefix "    " (plainSummary p) -- this isn't summary 
because summary does the
> +                                            -- wrong thing with 
(Named (FL p)) so that it can
> +                                            -- get the summary of a 
sequence of named patches
> +                                            -- right.
> +    showNicely p@(NamedP _ _ pt) = description p $$
> +                                   prefix "    " (showNicely pt)
> +
> +instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show (Named p C(x y)) where
> +    show = renderString . showPatch
> +
> +instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show1 (Named p C(x)) where
> +    showDict1 = ShowDictClass
> +
> +instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show2 (Named p) where
> +    showDict2 = ShowDictClass
> +
>  \end{code}

hunk ./src/Darcs/Patch/Viewing.hs 39

hunk ./src/Darcs/Patch/Viewing.hs 47

hunk ./src/Darcs/Patch/Viewing.hs 49

hunk ./src/Darcs/Patch/Viewing.hs 53
[imports]

hunk ./src/Darcs/Patch/Viewing.hs 255
>  dropDotSlash ('.':'/':str) = dropDotSlash str
>  dropDotSlash str = str
>  
> -instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic 
(Named p) where
> -    showPatch (NamedP n [] p) = showPatchInfo n <> showPatch p
> -    showPatch (NamedP n d p) = showNamedPrefix n d <+> showPatch p
> -
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
ShowPatch (Named p) where
> -    showContextPatch (NamedP n [] p) = showContextPatch p >>= return 
. (showPatchInfo n <>)
> -    showContextPatch (NamedP n d p) = showContextPatch p >>= return . 
(showNamedPrefix n d <+>)
> -    description (NamedP n _ _) = humanFriendly n
> -    summary p = description p $$ text "" $$
> -                prefix "    " (plainSummary p) -- this isn't summary 
because summary does the
> -                                            -- wrong thing with 
(Named (FL p)) so that it can
> -                                            -- get the summary of a 
sequence of named patches
> -                                            -- right.
> -    showNicely p@(NamedP _ _ pt) = description p $$
> -                                   prefix "    " (showNicely pt)
> -
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show (Named p C(x y)) where
> -    show = renderString . showPatch
> -
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show1 (Named p C(x)) where
> -    showDict1 = ShowDictClass
> -
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show2 (Named p) where
> -    showDict2 = ShowDictClass
> -
>  instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL 
p) where
>      showPatch = showPatchInternal patchListFormat
>        where showPatchInternal :: ListFormat p -> FL p C(x y) -> Doc

Moving instances from Viewing to Named. This means that Viewing no
longer imports Named.

break out Summary code into separate module
-------------------------------------------
Ganesh Sittampalam <ganesh at earth.li>**20101122064255

hunk ./darcs.cabal 224
> +                      Darcs.Patch.Summary


hunk ./src/Darcs/Patch.lhs 102

hunk ./src/Darcs/Patch/Named.lhs 48

[imports]

addfile ./src/Darcs/Patch/Summary.hs

hunk ./src/Darcs/Patch/Summary.hs 1
[this used to be in Viewing.hs]

hunk ./src/Darcs/Patch/V1/Viewing.hs 6
>  
>  import Darcs.Patch.Prim ( primIsHunk )
>  import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..) )
> -import Darcs.Patch.Viewing ( plainSummary, showContextHunk )
> +import Darcs.Patch.Summary ( plainSummary )
> +import Darcs.Patch.Viewing ( showContextHunk )
>  
>  import Darcs.Patch.V1.Apply ()
>  import Darcs.Patch.V1.Core ( Patch(..) )

hunk ./src/Darcs/Patch/Viewing.hs 21
>  {-# OPTIONS_GHC -fno-warn-orphans #-}
>  {-# LANGUAGE CPP #-}
>  
> -module Darcs.Patch.Viewing ( xmlSummary, plainSummary,
> -                             showContextHunk, showContextSeries
> -                           )
> -             where
> +module Darcs.Patch.Viewing
> +    ( showContextHunk, showContextSeries
> +    )
> +    where
>  
>  import Prelude hiding ( pi, readFile )
>  import Control.Monad.State.Strict ( gets )

hunk ./src/Darcs/Patch/Viewing.hs 35
>  import ByteStringUtils (linesPS )
>  import qualified Data.ByteString as BS (null, concat)
>  import qualified Data.ByteString.Lazy as BL (toChunks)
> -import Darcs.Patch.FileName ( FileName, fn2fp )
> +import Darcs.Patch.FileName ( fn2fp )
>  import Printer ( Doc, empty, vcat,
>                   text, blueText, Color(Cyan,Magenta), lineColor,

hunk ./src/Darcs/Patch/Viewing.hs 38
> -                 minus, plus, ($$), (<+>), (<>),
> +                 ($$), (<+>), (<>),
>                   prefix,
>                   userchunkPS,
>                 )

hunk ./src/Darcs/Patch/Viewing.hs 43
>  import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..) )
> -import Darcs.Patch.Prim ( Prim(..), isHunk, formatFileName, showPrim, 
FileNameFormat(..), Conflict(..),
> -                          Effect, IsConflictedPrim(IsC), 
ConflictState(..),
> -                          DirPatchType(..), FilePatchType(..) )
> +import Darcs.Patch.Prim ( Prim(..), isHunk, formatFileName, showPrim, 
FileNameFormat(..),
> +                          Effect, FilePatchType(..) )
>  import Darcs.Patch.Patchy ( Apply, ShowPatch(..), identity )
>  import Darcs.Patch.Show ( ShowPatchBasic(..) )

hunk ./src/Darcs/Patch/Viewing.hs 47
> +import Darcs.Patch.Summary ( plainSummaryPrim )
>  import Darcs.Patch.Apply ( applyToTree )
>  #include "impossible.h"
>  #include "gadts.h"

hunk ./src/Darcs/Patch/Viewing.hs 63
>          do x <- showContextSeries ps
>             return $ blueText "(" $$ x <> blueText ")"
>      showContextPatch p = return $ showPatch p
> -    summary = vcat . map summChunkToLine . genSummary . (:[]) . IsC 
Okay
> +    summary = plainSummaryPrim
>      thing _ = "change"
>  

hunk ./src/Darcs/Patch/Viewing.hs 66
> -plainSummary :: (Conflict e, Effect e) => e C(x y) -> Doc
> -plainSummary = vcat . map summChunkToLine . genSummary . 
conflictedEffect
> -
>  showContextSeries :: (Apply p, ShowPatch p, Effect p) => FL p C(x y) 
-> TreeIO Doc
>  showContextSeries patches = scs identity patches
>      where scs :: (Apply p, ShowPatch p, Effect p) => Prim C(w x) -> 
FL p C(x y) -> TreeIO Doc

hunk ./src/Darcs/Patch/Viewing.hs 125
[All this ends in Summary.hs]

Just moving code around

get rid of a few more unnecessary superclasses
----------------------------------------------
Ganesh Sittampalam <ganesh at earth.li>**20101122064258

hunk ./src/Darcs/Patch/Named.lhs 225
>      showNicely p@(NamedP _ _ pt) = description p $$
>                                     prefix "    " (showNicely pt)
>  
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show (Named p C(x y)) where
> +instance (PatchListFormat p, ShowPatch p) => Show (Named p C(x y)) 
where
>      show = renderString . showPatch
>  
ok

hunk ./src/Darcs/Patch/Named.lhs 228
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show1 (Named p C(x)) where
> +instance (PatchListFormat p, ShowPatch p) => Show1 (Named p C(x)) 
where
>      showDict1 = ShowDictClass
>  
ok

hunk ./src/Darcs/Patch/Named.lhs 231
> -instance (Apply p, Conflict p, PatchListFormat p, ShowPatch p) => 
Show2 (Named p) where
> +instance (PatchListFormat p, ShowPatch p) => Show2 (Named p) where
>      showDict2 = ShowDictClass
>  
>  \end{code}
ok

move guts of Darcs.Patch.Prim into new Core module
--------------------------------------------------
Ganesh Sittampalam <ganesh at earth.li>**20101123072318

adddir ./src/Darcs/Patch/Prim

move ./src/Darcs/Patch/Prim.lhs ./src/Darcs/Patch/Prim/Core.lhs

hunk ./darcs.cabal 217
>                        Darcs.Patch.Patchy.Instances
>                        Darcs.Patch.Permutations
>                        Darcs.Patch.Prim
> +                      Darcs.Patch.Prim.Core
>                        Darcs.Patch.Read
>                        Darcs.Patch.ReadMonads
>                        Darcs.Patch.RegChars

hunk ./src/Darcs/Patch.lhs 126
>  \input{Darcs/Patch/Apply.lhs}
>  \input{Darcs/Patch/Named.lhs}
>  \input{Darcs/Patch/V1/Core.lhs}
> -\input{Darcs/Patch/Prim.lhs}
> +\input{Darcs/Patch/Prim/Core.lhs}
>  \input{Darcs/Patch/V1/Commute.lhs}
>  \input{Darcs/Patch/V1/Show.lhs}
>  \input{Darcs/Patch/Show.lhs}

Eventually, we'll get rid of all these lhs.

addfile ./src/Darcs/Patch/Prim.hs

hunk ./src/Darcs/Patch/Prim.hs 1
> +module Darcs.Patch.Prim
> +       ( Prim(..), showPrim, showPrimFL, showHunk,
> +         DirPatchType(..), FilePatchType(..),
> +         Perhaps(..),
> +         isIdentity,
> +         formatFileName, FileNameFormat(..),
> +         adddir, addfile, binary, changepref,
> +         hunk, move, rmdir, rmfile, tokreplace,
> +         primIsAddfile, primIsHunk, primIsBinary, primIsSetpref,
> +         primIsAdddir, is_filepatch,
> +         canonize, tryToShrink,
> +         subcommutes, WrappedCommuteFunction(..),
> +         sortCoalesceFL, join, canonizeFL,
> +         tryTokInternal,
> +         tryShrinkingInverse,
> +         FromPrim(..), FromPrims(..), ToFromPrim(..),
> +       )
> +       where
> +
> +import Darcs.Patch.Prim.Core
> +       ( Prim(..), showPrim, showPrimFL, showHunk,
> +         DirPatchType(..), FilePatchType(..),
> +         Perhaps(..),
> +         isIdentity,
> +         formatFileName, FileNameFormat(..),
> +         adddir, addfile, binary, changepref,
> +         hunk, move, rmdir, rmfile, tokreplace,
> +         primIsAddfile, primIsHunk, primIsBinary, primIsSetpref,
> +         primIsAdddir, is_filepatch,
> +         canonize, tryToShrink,
> +         subcommutes, WrappedCommuteFunction(..),
> +         sortCoalesceFL, join, canonizeFL,
> +         tryTokInternal,
> +         tryShrinkingInverse,
> +         FromPrim(..), FromPrims(..), ToFromPrim(..),
> +       )

This no longer exports Effect, which breaks
src/Darcs/Patch/Apply.lhs . In fact, this patch depends on 
the following:
Tue Nov 23 08:23:24 CET 2010  Ganesh Sittampalam <ganesh at earth.li>
  * move markupFile etc out of Darcs.Patch.Apply

Found in patch484.

hunk ./src/Darcs/Patch/Prim/Core.lhs 23
>  
>  #include "gadts.h"
>  
> -module Darcs.Patch.Prim
> +module Darcs.Patch.Prim.Core
>         ( Prim(..), IsConflictedPrim(IsC), ConflictState(..), 
showPrim, showPrimFL, showHunk,
>           DirPatchType(..), FilePatchType(..),
>           Perhaps(..),

ok

__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch481>
__________________________________


More information about the darcs-devel mailing list