/ src /
/src/PersistentDocument.hs
1 {-| Module : PersistentDocument
2 Author : Arjan van IJzendoorn
3 License : do whatever you like with this
4
5 Maintainer : afie@cs.uu.nl
6
7 The persistent document abstraction takes care of dealing
8 with a document you want to open from and save to disk and
9 that supports undo. This functionality can be used by editors
10 of arbitrary documents and saves you a lot of quite subtle
11 coding. You only need to initialise a record with things like
12 your document, the file name and call-back functions. After
13 this, the framework takes care of the hard work. The framework
14 is highly parametrisable but there are defaults for many
15 parameters.
16
17 The features in detail:
18 - unlimited undo & redo buffers (or limited, if you choose to)
19 - undo and redo items show what will be undone / redone
20 (e.g. "Undo delete node")
21 - undo and redo items are disabled if there is nothing to undo or redo
22 - maintains a dirty bit that tells you whether the document has
23 changed with respect to the version on disk
24 - the save menu item can be disabled if the document is not dirty
25 - the title bar can be updated to show the program name, the file name
26 and whether the document is dirty (shown as "modified")
27 - when trying to close the document, the user is asked whether he/she
28 wants to save the changes (if needed)
29 - handles interaction between saving a document and the dirty bits
30 of the document and of the documents in the history and future
31 - properly handles Cancel or failure at any stage, e.g. the user
32 closes a dirty document with no file name, "Do you want to save
33 the changes" dialog is shown, user selects "Save", a Save as
34 dialog is opened, user selects a location that happens to be
35 read-only, saving fails and the closing of the document is
36 cancelled.
37 -}
38
39 module PersistentDocument
40 ( PersistentDocument, PDRecord(..)
41
42 , PersistentDocument.dummy
43 , initialise
44 , resetDocument
45
46 , setDocument, updateDocument
47 , superficialSetDocument, superficialUpdateDocument
48
49 , getDocument
50 , getFileName, setFileName
51 , setDirty
52
53 , undo, redo
54 , save, saveAs, isClosingOkay
55 ) where
56
57 import Data.IORef(IORef, newIORef, writeIORef, readIORef)
58 import Monad(when)
59
60 -- | A persistent document is a mutable variable. This way functions
61 -- operating on a document do not have to return the new value but
62 -- simply update it.
63 type PersistentDocument a = IORef (PDRecord a)
64
65 -- | The persistent document record maintains all information needed
66 -- for undo, redo and file management
67 data PDRecord a = PD
68 { document :: a
69
70 -- UNDO & REDO
71 , history :: [(String, Bool, a)]
72 -- ^ A history item contains a message (what will be undone),
73 -- the dirty bit and a copy of the document
74 , future :: [(String, Bool, a)]
75 -- ^ See history
76 , limit :: Maybe Int
77 -- ^ Maximum number of items of undo history. Or no limit
78 -- in the case of Nothing
79
80 -- FILE MANAGEMENT
81 , fileName :: Maybe String
82 -- ^ Nothing means no file name yet (untitled)
83 , dirty :: Bool
84 -- ^ Has the document changed since saving?
85
86 -- CALL-BACK FUNCTIONS
87 , updateUndo :: Bool -> String -> IO ()
88 -- ^ This callback is called when the undo status changes. First parameter
89 -- means enable (True) or disable (False). Second parameter is the message
90 -- of the first item in the history
91 , updateRedo :: Bool -> String -> IO ()
92 -- ^ See updateUndo
93 , updateSave :: Bool -> IO ()
94 -- ^ This call-back is called when the save status changes. The boolean
95 -- indicates whether save is enabled (dirty document) or disabled (not dirty)
96 , updateTitleBar :: Maybe String -> Bool -> IO ()
97 -- ^ This call-back is called when the title bar information changes:
98 -- file name and modified or not.
99 , saveToDisk :: String -> a -> IO Bool
100 -- ^ This callback should actually save the document to disk. It should
101 -- return False if saving fails (no permission, disk full...)
102 , saveChangesDialog :: IO (Maybe Bool)
103 -- ^ This call-back is called when the user should be prompted whether
104 -- he\/she wants to save the changes or not. Results:
105 -- Don\'t Save -> Just False, Save -> Just True, Cancel -> Nothing
106 , saveAsDialog :: Maybe String -> IO (Maybe String)
107 -- ^ This call-back is called when the user should specify a
108 -- location and a name for the file. The parameter is the current
109 -- file name of the document
110 }
111
112 -- | A dummy persistent document is needed because you need something to pass
113 -- to the command handlers of menu items BEFORE you can initialse the
114 -- persistent document with those menu items
115 dummy :: IO (PersistentDocument a)
116 dummy = newIORef (error $ "PersistentDocument.empty: call initialise before using "
117 ++ "the persistent document")
118
119 -- | Initialise the persistent document with menu items (undo, redo, save),
120 -- information needed for open & save dialogs, for saving and for updating the
121 -- title bar
122 initialise :: PersistentDocument a -> PDRecord a -> IO ()
123 initialise pDocRef pDoc =
124 do{ writeIORef pDocRef pDoc
125 ; updateGUI pDocRef
126 }
127
128 -- | Clear the document and start with a given document with given file name
129 -- This function is typically called when you open a new document from disk
130 -- or start a fresh document that should replace the current document
131 resetDocument :: Maybe String -> a -> PersistentDocument a -> IO ()
132 resetDocument theFileName doc pDocRef =
133 do{ updateIORef pDocRef (\pDoc -> pDoc
134 { document = doc
135 , history = []
136 , future = []
137 , fileName = theFileName
138 , dirty = False
139 })
140 ; updateGUI pDocRef
141 }
142
143 -- | Get the actual document stored within the persistent document
144 getDocument :: PersistentDocument a -> IO a
145 getDocument pDocRef =
146 do{ pDoc <- readIORef pDocRef
147 ; return (document pDoc)
148 }
149
150 -- | Get the file name stored within the persistent document
151 getFileName :: PersistentDocument a -> IO (Maybe String)
152 getFileName pDocRef =
153 do{ pDoc <- readIORef pDocRef
154 ; return (fileName pDoc)
155 }
156
157 -- | Get the file name stored within the persistent document
158 setFileName :: PersistentDocument a -> Maybe String -> IO ()
159 setFileName pDocRef maybeName =
160 do{ pDoc <- readIORef pDocRef
161 ; writeIORef pDocRef (pDoc { fileName = maybeName })
162 ; updateGUI pDocRef
163 }
164
165 setDirty :: PersistentDocument a -> Bool -> IO ()
166 setDirty pDocRef newDirtyBit =
167 do{ pDoc <- readIORef pDocRef
168 ; writeIORef pDocRef (pDoc { dirty = newDirtyBit })
169 ; updateGUI pDocRef
170 }
171
172 -- | Replace the document inside the persistent document. The current
173 -- document is remembered in the history list along with the given
174 -- message. The future list is cleared.
175 setDocument :: String -> a -> PersistentDocument a -> IO ()
176 setDocument message newDoc pDocRef =
177 do{ pDoc <- readIORef pDocRef
178 ; let applyLimit = case limit pDoc of
179 Nothing -> id
180 Just nr -> take nr
181 newPDoc =
182 pDoc
183 { document = newDoc
184 , history = applyLimit $ (message,dirty pDoc,document pDoc):history pDoc
185 , future = []
186 , dirty = True
187 }
188 ; writeIORef pDocRef newPDoc
189 ; updateGUI pDocRef
190 }
191
192
193 -- | Get document, apply function, set document
194 updateDocument :: String -> (a -> a) -> PersistentDocument a -> IO ()
195 updateDocument message fun pDocRef =
196 do{ doc <- getDocument pDocRef
197 ; setDocument message (fun doc) pDocRef
198 }
199
200 -- | Replace the document without remembering the old document in
201 -- the history. Superficial updates are useful if something as
202 -- volatile as a selection is part of your document. If the selection
203 -- changes you don't want to be able to undo it or to mark
204 -- the document as dirty
205 superficialSetDocument :: a -> PersistentDocument a -> IO ()
206 superficialSetDocument newDoc pDocRef =
207 updateIORef pDocRef (\pDoc -> pDoc { document = newDoc })
208
209 -- | Get document, apply function, superficial set document
210 superficialUpdateDocument :: (a -> a) -> PersistentDocument a -> IO ()
211 superficialUpdateDocument fun pDocRef =
212 do{ doc <- getDocument pDocRef
213 ; superficialSetDocument (fun doc) pDocRef
214 }
215
216 -- | Check whether closing the document is okay. If the document
217 -- is dirty, the user is asked whether he\/she wants to save the
218 -- changes. Returns False if this process is cancelled or fails
219 -- at any point.
220 isClosingOkay :: PersistentDocument a -> IO Bool
221 isClosingOkay pDocRef =
222 do{ pDoc <- readIORef pDocRef
223 ; if not (dirty pDoc) then return True else
224 do{ result <- saveChangesDialog pDoc
225 ; case result of
226 Nothing -> return False
227 Just True ->
228 do{ hasBeenSaved <- save pDocRef
229 ; return hasBeenSaved
230 }
231 Just False -> return True
232 }}
233
234 -- | Save should be called when "Save" is selected from the file menu.
235 -- If there is no file name yet, this function acts as if "Save as"
236 -- was called. It returns False if saving is cancelled or fails.
237 save :: PersistentDocument a -> IO Bool
238 save pDocRef =
239 do{ pDoc <- readIORef pDocRef
240 ; case fileName pDoc of
241 Nothing -> saveAs pDocRef
242 Just name -> performSave name pDocRef
243 }
244
245 -- | saveAs should be called when "Save As" is selected from the file menu.
246 -- A dialog is shown where the user can select a location to save document.
247 -- This function returns False if saving is cancelled or fails.
248 saveAs :: PersistentDocument a -> IO Bool
249 saveAs pDocRef =
250 do{ pDoc <- readIORef pDocRef
251 ; mbfname <- saveAsDialog pDoc (fileName pDoc)
252 ; case mbfname of
253 Just fname -> performSave fname pDocRef
254 Nothing -> return False
255 }
256
257
258 -- | The current document is stored in the future list
259 -- and the first element of the history list is taken
260 -- as the new document
261 undo :: PersistentDocument a -> IO ()
262 undo pDocRef =
263 do{ pDoc <- readIORef pDocRef
264 ; when (not (null (history pDoc))) $
265 do{ let (msg, newDirty, newDoc) = head (history pDoc)
266 newPDoc = pDoc
267 { document = newDoc
268 , dirty = newDirty
269 , history = tail (history pDoc)
270 , future = (msg, dirty pDoc, document pDoc) : future pDoc
271 }
272 ; writeIORef pDocRef newPDoc
273 ; updateGUI pDocRef
274 }}
275
276 -- | The current document is stored in the history list
277 -- and the first element of the future list is taken
278 -- as the new document
279 redo :: PersistentDocument a -> IO ()
280 redo pDocRef =
281 do{ pDoc <- readIORef pDocRef
282 ; when (not (null (future pDoc))) $
283 do{ let (msg, newDirty, newDoc) = head (future pDoc)
284 newPDoc = pDoc
285 { document = newDoc
286 , dirty = newDirty
287 , future = tail (future pDoc)
288 , history = (msg, dirty pDoc, document pDoc) : history pDoc
289 }
290 ; writeIORef pDocRef newPDoc
291 ; updateGUI pDocRef
292 }}
293
294 -- FUNCTIONS THAT ARE NOT EXPORTED
295
296 updateIORef :: IORef a -> (a -> a) -> IO ()
297 updateIORef var fun = do { x <- readIORef var; writeIORef var (fun x) }
298
299 -- Perform the actual save to disk. If this fails False is returned
300 -- otherwise the file name is set and the dirty bit is cleared. The
301 -- dirty bits of history and future documents are set.
302 performSave :: String -> PersistentDocument a -> IO Bool
303 performSave name pDocRef =
304 do{ pDoc <- readIORef pDocRef
305 ; hasBeenSaved <- (saveToDisk pDoc) name (document pDoc)
306 ; if not hasBeenSaved then return False else
307 do{ writeIORef pDocRef (pDoc { fileName = Just name })
308 ; updateDirtyBitsOnSave pDocRef
309 ; updateGUI pDocRef
310 ; return True
311 }}
312
313 -- updateDirtyBitsOnSave clears the dirty bit for the
314 -- current document and sets the dirty bits of all
315 -- documents in history and future lists
316 updateDirtyBitsOnSave :: PersistentDocument a -> IO ()
317 updateDirtyBitsOnSave pDocRef =
318 updateIORef pDocRef (\pDoc -> pDoc
319 { history = map makeDirty (history pDoc)
320 , future = map makeDirty (future pDoc)
321 , dirty = False
322 })
323 where
324 makeDirty (msg, _, doc) = (msg, True, doc)
325
326 -- Shorthand to call all call-backs that update the GUI
327 updateGUI :: PersistentDocument a -> IO ()
328 updateGUI pDocRef =
329 do{ pDoc <- readIORef pDocRef
330 ; case history pDoc of
331 [] -> updateUndo pDoc False ""
332 ((msg, _, _):_) -> updateUndo pDoc True msg
333 ; case future pDoc of
334 [] -> updateRedo pDoc False ""
335 ((msg, _, _):_) -> updateRedo pDoc True msg
336 ; updateSave pDoc (dirty pDoc)
337 ; updateTitleBar pDoc (fileName pDoc) (dirty pDoc)
338 }