1-- Copyright (C) 2003 David Roundy 2-- 3-- This program is free software; you can redistribute it and/or modify 4-- it under the terms of the GNU General Public License as published by 5-- the Free Software Foundation; either version 2, or (at your option) 6-- any later version. 7-- 8-- This program is distributed in the hope that it will be useful, 9-- but WITHOUT ANY WARRANTY; without even the implied warranty of 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11-- GNU General Public License for more details. 12-- 13-- You should have received a copy of the GNU General Public License 14-- along with this program; see the file COPYING. If not, write to 15-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16-- Boston, MA 02110-1301, USA. 17 18module Darcs.Patch.Set 19 ( PatchSet(..) 20 , Tagged(..) 21 , SealedPatchSet 22 , Origin 23 , progressPatchSet 24 , patchSetTags 25 , emptyPatchSet 26 , appendPSFL 27 , patchSet2RL 28 , patchSet2FL 29 , inOrderTags 30 , patchSetSnoc 31 , patchSetSplit 32 , patchSetDrop 33 ) where 34 35import Darcs.Prelude 36import Data.Maybe ( catMaybes ) 37 38import Darcs.Patch.Info ( PatchInfo, piTag ) 39import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info ) 40import Darcs.Patch.Witnesses.Sealed ( Sealed(..) ) 41import Darcs.Patch.Witnesses.Ordered 42 ( FL, RL(..), (+<+), (+<<+), (:>)(..), reverseRL, 43 mapRL_RL, concatRL, mapRL ) 44import Darcs.Patch.Witnesses.Show ( Show1, Show2 ) 45 46import Darcs.Util.Progress ( progress ) 47 48-- |'Origin' is a type used to represent the initial context of a repo. 49data Origin 50 51type SealedPatchSet rt p wStart = Sealed ((PatchSet rt p) wStart) 52 53-- |The patches in a repository are stored in chunks broken up at \"clean\" 54-- tags. A tag is clean if the only patches before it in the current 55-- repository ordering are ones that the tag depends on (either directly 56-- or indirectly). Each chunk is stored in a separate inventory file on disk. 57-- 58-- A 'PatchSet' represents a repo's history as the list of patches since the 59-- last clean tag, and then a list of patch lists each delimited by clean tags. 60-- 61-- Because the invariants about clean tags can only be maintained if a 62-- 'PatchSet' contains the whole history, the first witness is always forced 63-- to be 'Origin'. The type still has two witnesses so it can easily be used 64-- with combinators like ':>' and 'Fork'. 65-- 66-- The history is lazily loaded from disk so does not normally need to be all 67-- kept in memory. 68data PatchSet rt p wStart wY where 69 PatchSet :: RL (Tagged rt p) Origin wX -> RL (PatchInfoAnd rt p) wX wY 70 -> PatchSet rt p Origin wY 71 72deriving instance Show2 p => Show (PatchSet rt p wStart wY) 73 74instance Show2 p => Show1 (PatchSet rt p wStart) 75 76instance Show2 p => Show2 (PatchSet rt p) 77 78 79emptyPatchSet :: PatchSet rt p Origin Origin 80emptyPatchSet = PatchSet NilRL NilRL 81 82-- |A 'Tagged' is a single chunk of a 'PatchSet'. 83-- It has a 'PatchInfo' representing a clean tag, 84-- the hash of the previous inventory (if it exists), 85-- and the list of patches since that previous inventory. 86data Tagged rt p wX wZ where 87 Tagged :: PatchInfoAnd rt p wY wZ -> Maybe String 88 -> RL (PatchInfoAnd rt p) wX wY -> Tagged rt p wX wZ 89 90deriving instance Show2 p => Show (Tagged rt p wX wZ) 91 92instance Show2 p => Show1 (Tagged rt p wX) 93 94instance Show2 p => Show2 (Tagged rt p) 95 96 97-- |'patchSet2RL' takes a 'PatchSet' and returns an equivalent, linear 'RL' of 98-- patches. 99patchSet2RL :: PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX 100patchSet2RL (PatchSet ts ps) = concatRL (mapRL_RL ts2rl ts) +<+ ps 101 where 102 ts2rl :: Tagged rt p wY wZ -> RL (PatchInfoAnd rt p) wY wZ 103 ts2rl (Tagged t _ ps2) = ps2 :<: t 104 105-- |'patchSet2FL' takes a 'PatchSet' and returns an equivalent, linear 'FL' of 106-- patches. 107patchSet2FL :: PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX 108patchSet2FL = reverseRL . patchSet2RL 109 110-- |'appendPSFL' takes a 'PatchSet' and a 'FL' of patches that "follow" the 111-- PatchSet, and concatenates the patches into the PatchSet. 112appendPSFL :: PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wX wY 113 -> PatchSet rt p wStart wY 114appendPSFL (PatchSet ts ps) newps = PatchSet ts (ps +<<+ newps) 115 116-- |Runs a progress action for each tag and patch in a given PatchSet, using 117-- the passed progress message. Does not alter the PatchSet. 118progressPatchSet :: String -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX 119progressPatchSet k (PatchSet ts ps) = 120 PatchSet (mapRL_RL progressTagged ts) (mapRL_RL prog ps) 121 where 122 prog = progress k 123 124 progressTagged :: Tagged rt p wY wZ -> Tagged rt p wY wZ 125 progressTagged (Tagged t h tps) = Tagged (prog t) h (mapRL_RL prog tps) 126 127-- | The tag names of /all/ tags of a given 'PatchSet'. 128patchSetTags :: PatchSet rt p wX wY -> [String] 129patchSetTags = catMaybes . mapRL (piTag . info) . patchSet2RL 130 131inOrderTags :: PatchSet rt p wS wX -> [PatchInfo] 132inOrderTags (PatchSet ts _) = go ts 133 where go :: RL(Tagged rt t1) wT wY -> [PatchInfo] 134 go (ts' :<: Tagged t _ _) = info t : go ts' 135 go NilRL = [] 136 137patchSetSnoc :: PatchSet rt p wX wY -> PatchInfoAnd rt p wY wZ -> PatchSet rt p wX wZ 138patchSetSnoc (PatchSet ts ps) p = PatchSet ts (ps :<: p) 139 140-- | Split a 'PatchSet' /before/ the latest known clean tag. The left part 141-- is what comes before the tag, the right part is the tag and its 142-- non-dependencies. 143patchSetSplit :: PatchSet rt p wX wY 144 -> (PatchSet rt p :> RL (PatchInfoAnd rt p)) wX wY 145patchSetSplit (PatchSet (ts :<: Tagged t _ ps') ps) = 146 PatchSet ts ps' :> ((NilRL :<: t) +<+ ps) 147patchSetSplit (PatchSet NilRL ps) = PatchSet NilRL NilRL :> ps 148 149-- | Drop the last @n@ patches from the given 'PatchSet'. 150patchSetDrop :: Int 151 -> PatchSet rt p wStart wX 152 -> SealedPatchSet rt p wStart 153patchSetDrop n ps | n <= 0 = Sealed ps 154patchSetDrop n (PatchSet (ts :<: Tagged t _ ps) NilRL) = 155 patchSetDrop n $ PatchSet ts (ps :<: t) 156patchSetDrop _ (PatchSet NilRL NilRL) = Sealed $ PatchSet NilRL NilRL 157patchSetDrop n (PatchSet ts (ps :<: _)) = patchSetDrop (n - 1) $ PatchSet ts ps 158