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