To review this patch, I read about type familes, as advised by Eric:
http://www.haskell.org/haskellwiki/GHC/Type_families
http://www.haskell.org/haskellwiki/Simonpj/Talk:FunWithTypeFuns
http://nattermorphisms.blogspot.com/2008/10/2-minute-intro-to-associated-types-type.html
I do not know Darcs's code that well to tell whether this patch is
*necessary* to make the Prim type easier to work with for a second
implementation, so I'm just going to browse the changes of this patch
and see that it just does what it says. Here we go.
The file src/Darcs/Patch/Prim/Class.hs is added and contains all
definitions of classes needed for the class PrimPatch. It also contains
the associated type synonym PrimOf advetised by Ganesh:
class PrimPatch (PrimOf p) => PrimPatchBase p where
type PrimOf (p :: PATCHKIND) :: PATCHKIND
The file src/Darcs/Patch/Prim/V1.hs is also added, it makes Prim an
instance of class PrimPatch and imports modules:
import Darcs.Patch.Prim.V1.Apply ()
import Darcs.Patch.Prim.V1.Coalesce ()
import Darcs.Patch.Prim.V1.Commute ()
import Darcs.Patch.Prim.V1.Core ( Prim )
import Darcs.Patch.Prim.V1.Details ()
import Darcs.Patch.Prim.V1.Read ()
import Darcs.Patch.Prim.V1.Show ()
These modules where moved from:
./src/Darcs/Patch/Prim/Apply.lhs ->
./src/Darcs/Patch/Prim/V1/Apply.lhs
./src/Darcs/Patch/Prim/Coalesce.lhs ->
./src/Darcs/Patch/Prim/V1/Coalesce.lhs
./src/Darcs/Patch/Prim/Commute.lhs ->
./src/Darcs/Patch/Prim/V1/Commute.lhs
./src/Darcs/Patch/Prim/Core.lhs ->
./src/Darcs/Patch/Prim/V1/Core.lhs
./src/Darcs/Patch/Prim/Details.lhs ->
./src/Darcs/Patch/Prim/V1/Details.lhs
./src/Darcs/Patch/Prim/Read.hs -> ./src/Darcs/Patch/Prim/V1/Read.hs
./src/Darcs/Patch/Prim/Show.lhs ->
./src/Darcs/Patch/Prim/V1/Show.lhs
That is, now the current definition of what is a primitive patch (this
definition is the same for both patch semantics we currently have in
Darcs) is called V1, and it is possible to add another kind of primitive
patch by reimplementing the above modules as some V2 (that's the
intention of this patch).
The changes in the above files:
M ./src/Darcs/Patch/Prim/V1/Apply.lhs -27 +26
M ./src/Darcs/Patch/Prim/V1/Coalesce.lhs -52 +32
M ./src/Darcs/Patch/Prim/V1/Commute.lhs -4 +4
M ./src/Darcs/Patch/Prim/V1/Core.lhs -82 +30
M ./src/Darcs/Patch/Prim/V1/Details.lhs -121 +119
M ./src/Darcs/Patch/Prim/V1/Read.hs -23 +20
M ./src/Darcs/Patch/Prim/V1/Show.lhs -17 +15
are mostly about moving the top-level functions into "instance" blocks.
For instance in /src/Darcs/Patch/Prim/V1/Apply.lhs:
------8<------
-applyPrimFL :: WriteableDirectory m => FL Prim C(x y) -> m ()
-applyPrimFL NilFL = return ()
-applyPrimFL ((FP f h@(Hunk _ _ _)):>:the_ps)
- = case spanFL f_hunk the_ps of
- (xs :> ps') ->
- do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs
- mModifyFilePS f $ hunkmod foo
- applyPrimFL ps'
- where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True
- f_hunk _ = False
- hunkmod :: WriteableDirectory m => FL FilePatchType C(x y)
- -> B.ByteString -> m B.ByteString
- hunkmod NilFL ps = return ps
- hunkmod (Hunk line old new:>:hs) ps
- = case applyHunkLines [(line,old,new)] ps of
- Just ps' -> hunkmod hs ps'
- Nothing -> fail $ "### Error applying:\n" ++
- (renderString $ showHunk NewFormat f
line old new) ++
- "\n### to file " ++ fn2fp f ++ ":\n"
++ BC.unpack ps
- hunkmod _ _ = impossible
-applyPrimFL (p:>:ps) = do apply p
- applyPrimFL ps
+instance PrimApply Prim where
+ applyPrimFL NilFL = return ()
+ applyPrimFL ((FP f h@(Hunk _ _ _)):>:the_ps)
+ = case spanFL f_hunk the_ps of
+ (xs :> ps') ->
+ do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs
+ mModifyFilePS f $ hunkmod foo
+ applyPrimFL ps'
+ where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True
+ f_hunk _ = False
+ hunkmod :: WriteableDirectory m => FL FilePatchType C(x y)
+ -> B.ByteString -> m B.ByteString
+ hunkmod NilFL ps = return ps
+ hunkmod (Hunk line old new:>:hs) ps
+ = case applyHunkLines [(line,old,new)] ps of
+ Just ps' -> hunkmod hs ps'
+ Nothing -> fail $ "### Error applying:\n" ++
+ (renderString $ showHunk
NewFormat f line old new) ++
+ "\n### to file " ++ fn2fp f ++
":\n" ++ BC.unpack ps
+ hunkmod _ _ = impossible
+ applyPrimFL (p:>:ps) = do apply p
+ applyPrimFL ps
------>8------
Well, surprisingly Commute.hs does not need that kind of changes, but
all the other modules' change are similar.
And that's it, here is a listing of all files changes by the patch and a
quick comment on what's changed:
Already mentioned:
A ./src/Darcs/Patch/Prim/V1/
./src/Darcs/Patch/Prim/Apply.lhs ->
./src/Darcs/Patch/Prim/V1/Apply.lhs
./src/Darcs/Patch/Prim/Coalesce.lhs ->
./src/Darcs/Patch/Prim/V1/Coalesce.lhs
./src/Darcs/Patch/Prim/Commute.lhs ->
./src/Darcs/Patch/Prim/V1/Commute.lhs
./src/Darcs/Patch/Prim/Core.lhs ->
./src/Darcs/Patch/Prim/V1/Core.lhs
./src/Darcs/Patch/Prim/Details.lhs ->
./src/Darcs/Patch/Prim/V1/Details.lhs
./src/Darcs/Patch/Prim/Read.hs -> ./src/Darcs/Patch/Prim/V1/Read.hs
./src/Darcs/Patch/Prim/Show.lhs ->
./src/Darcs/Patch/Prim/V1/Show.lhs
Declaring new modules, and use of the TypeFamilies GHC extension:
M ./darcs.cabal -7 +12
Changes in Darcs.Commands.XXXX modules, that are here to fix imports and
type signatures to make compiler happy. Nothing curious, except that in
Darcs.Commands.Tag it goes as far as passing a bogus argument (NilFl) to
the get_name_log function, most probably for typing reasons.
M ./src/Darcs/Commands/Add.lhs -4 +4
M ./src/Darcs/Commands/AmendRecord.lhs -3 +3
M ./src/Darcs/Commands/Changes.lhs -4 +7
M ./src/Darcs/Commands/Check.lhs -2 +2
M ./src/Darcs/Commands/MarkConflicts.lhs -2 +2
M ./src/Darcs/Commands/Move.lhs -2 +2
M ./src/Darcs/Commands/Record.lhs -5 +5
M ./src/Darcs/Commands/Remove.lhs -4 +4
M ./src/Darcs/Commands/Replace.lhs -3 +4
M ./src/Darcs/Commands/Rollback.lhs -3 +2
M ./src/Darcs/Commands/Tag.lhs -7 +10
M ./src/Darcs/Commands/Unrevert.lhs -4 +4
M ./src/Darcs/Commands/WhatsNew.lhs -7 +8
Same kind of fixes (import, types):
M ./src/Darcs/Diff.hs -3 +3
M ./src/Darcs/Match.lhs -1 +1
M ./src/Darcs/Patch.lhs -5 +7
M ./src/Darcs/Patch/Apply.lhs -2 +2
M ./src/Darcs/Patch/Conflict.hs -8 +7
M ./src/Darcs/Patch/ConflictMarking.hs -11 +12
Same + remove "instance Effect Prim":
M ./src/Darcs/Patch/Effect.hs -7 +3
Same:
M ./src/Darcs/Patch/Markup.hs -3 +3
M ./src/Darcs/Patch/Match.lhs -1 +1
Same + add "instance PrimPatchBase p => PrimPatchBase (Named p)":
M ./src/Darcs/Patch/Named.lhs -1 +5
Same + add "instance PrimPatchBase p => PrimPatchBase (PatchInfoAnd p)":
M ./src/Darcs/Patch/PatchInfoAnd.hs -1 +5
Same:
M ./src/Darcs/Patch/Patchy.hs -1 +1
Remove "instance Patchy Prim":
M ./src/Darcs/Patch/Patchy/Instances.hs -2 +1
Same:
M ./src/Darcs/Patch/Population.hs -4 +4
Already discussed:
M ./src/Darcs/Patch/Prim.hs -21 +11
A ./src/Darcs/Patch/Prim/Class.hs
A ./src/Darcs/Patch/Prim/V1.hs
M ./src/Darcs/Patch/Prim/V1/Apply.lhs -27 +26
M ./src/Darcs/Patch/Prim/V1/Coalesce.lhs -52 +32
M ./src/Darcs/Patch/Prim/V1/Commute.lhs -4 +4
M ./src/Darcs/Patch/Prim/V1/Core.lhs -82 +30
M ./src/Darcs/Patch/Prim/V1/Details.lhs -121 +119
M ./src/Darcs/Patch/Prim/V1/Read.hs -23 +20
M ./src/Darcs/Patch/Prim/V1/Show.lhs -17 +15
Same:
M ./src/Darcs/Patch/RepoPatch.hs -2 +5
M ./src/Darcs/Patch/Split.hs -5 +5
M ./src/Darcs/Patch/Summary.hs -8 +7
M ./src/Darcs/Patch/V1/Commute.lhs -1 +2
Same + add "instance PrimPatchBase Patch":
M ./src/Darcs/Patch/V1/Core.lhs -1 +5
Same + add "UndecidableInstances" pragma:
M ./src/Darcs/Patch/V2/Non.hs -22 +27
Same + add "instance PrimPatchBase RealPatch":
M ./src/Darcs/Patch/V2/Real.hs -8 +19
Same:
M ./src/Darcs/Patch/Viewing.hs -3 +2
M ./src/Darcs/Repository.hs -2 +2
M ./src/Darcs/Repository/DarcsRepo.lhs -2 +5
M ./src/Darcs/Repository/Internal.hs -21 +22
M ./src/Darcs/Repository/LowLevel.hs -9 +9
M ./src/Darcs/Repository/Merge.hs -4 +4
M ./src/Darcs/Repository/Repair.hs -4 +5
M ./src/Darcs/Repository/State.hs -6 +6
M ./src/Darcs/Resolution.lhs -7 +7
M ./src/Darcs/SelectChanges.hs -3 +3
M ./src/Darcs/Test/Patch.hs -2 +3
M ./src/Darcs/Test/Patch/Properties.lhs -1 +1
M ./src/Darcs/Test/Patch/QuickCheck.hs -18 +19
M ./src/Darcs/Test/Patch/Test.hs -3 +3
M ./src/Darcs/Test/Patch/Unit.hs -1 +2
M ./src/Darcs/Test/Patch/Unit2.hs -1 +2
Compiler and tests/quickchecks are happy, I'm pushing it.
|