Undo.hs

{-# LANGUAGE BangPatterns, OverloadedStrings #-}

module Text.LDIF.Undo (
        undoLDIF
)
where
import Data.Maybe
import Text.LDIF.Types

-- | Warning message when undo can not be calculated
type Warning = String

-- | Calculate undo LDIF
undoLDIF :: LDIF -> (LDIF,[[Warning]])
undoLDIF (LDIF v xs) = let (ys,w) = let zs = map undoRecord $ reverse xs
                                    in (map fst zs, map snd zs)
                       in (LDIF v ys, filter (not . null) w)

-- | Calculate undo Record with possible warnings
undoRecord :: LDIFRecord -> (LDIFRecord,[Warning])
undoRecord (ContentRecord dn _) = (ChangeRecord dn ChangeDelete,[])
undoRecord (ChangeRecord  dn (ChangeAdd _))     = (ChangeRecord dn ChangeDelete,[])
undoRecord (ChangeRecord  dn ChangeDelete)      = (ChangeRecord dn (ChangeAdd []), [wrnO dn "delete"])
undoRecord (ChangeRecord  dn (ChangeModify xs)) = let (x, w) = let ys = map undoMod $ reverse xs
                                                               in (map fst ys, map snd ys)
                                                  in (ChangeRecord dn (ChangeModify x), catMaybes w)
undoRecord x = (x, ["Unsupported operation"])

-- | Calculate undo Modification with possible warning
undoMod :: Modify -> (Modify,Maybe Warning)
undoMod (ModAdd a v)     = (ModDelete a v, Nothing)
undoMod (ModDelete a [])  = (ModAdd a [], Just $ wrnA a "delete")
undoMod (ModDelete a zs)  = (ModAdd a zs, Nothing)
undoMod (ModReplace a _) = (ModReplace a [], Just $ wrnA a "replace")

wrnA :: Attribute -> String -> String
wrnA a op = concat [show $ aName a, " ", op]

wrnO :: DN -> String -> String
wrnO dn op = concat [show dn, " ", op]