Restore State and Undo Effects of a Transformer

I am having trouble defining an interface for restoring the state and undoing the writes upon failure for a monad transformer.

I have a transformer FileT that wraps file Handles, a class Try that restores the state and discards the writes from putText upon failure, and a class PutText that is like MonadWriter with only tell to accepts data to write to file.

newtype FileT (mode :: IOMode) text m a = FileT (ReaderT (FilePath, Handle) m a)

class Try m where try :: m a -> m a

class PutText text m where putText :: text -> m ()

This definition of Try works well with most monad transformers, but I have found an edge case, FileT AppendMode, that it has low compatibility with. Unlike the other IOModes, AppendMode cannot seek and the text must be buffered until success. I have come up with following bad solutions.

  1. Redefine Try to
    class Try m n | n -> m where try :: m a -> n a
    
    -- writer buffers the text until success
    instance Try (FileT AppendMode text (WriterT text m))
                 (FileT AppendMode text               m)
    
    This is terrible since it makes composition is very hard because: constraints must be defined for both m and n, and try is going to be used in m which exacerbates the previous problem that now has a new monad for every try used.
  2. Use the original interface and define the transformer FileAppendT with specialized instances for Try and PutText
    -- state holds the text to putText while in try
    -- the list is a stack for recursive trys
    newtype FileAppendT text m a = FileAppendT
      (FileT AppendMode text (StateT [text] m) a)
    
    -- add a new empty text to the top of the stack
    -- run the given computation
    -- pop the text off
    -- write it to file if the stack is now empty
    -- or append it to the text at the top of the stack
    instance (Try m, Monoid text) => Try (FileAppendT text m) where
      try x = do
        modify (mempty :)
        y <- try x
        get >>= \case
          [z] -> FileAppendT (putText z) *> put []
          z:zs -> put zs *> putText z
        return y
    
    instance (PutText text m, Semigroup text) => PutText text (FileAppendT text m) where
      putText x = get >>= \case
        [] -> FileAppendT $ putText x
        y:ys -> put $ y <> x : ys
    
    This is better for composition but adds adds overhead of having a null check every time putText is called.

Is there a better way to handle this edge case?

Do you mean you want to undo writes to a file when an exception is thrown?

Yes, but only when operating in a appending fashion.

With WriteMode and ReadWriteMode I can just seek and truncate the file.

However with Append mode, I cannot seek, which is problematic.

If you view these pure updates as a stream of events, where only the successful ones are committed to “disk”, you don’t (AFAICS) need to undo anything, but to be sure I’d need to see your full implementation.