module Text.LDIF.Tree ( toTree, fromTree, sortTreeByName )
where
import Prelude
import Text.LDIF.Types
import Text.LDIF.Utils
import Data.Tree
import Data.Maybe
import Data.List
import qualified Data.Set as S
import qualified Data.Tree.Zipper as Z
fromTree :: Tree LDIFRecord -> LDIF
fromTree !xs = ys `seq` LDIF Nothing ys
where
ys = (filter (not . isFakeEntry) $ flatten xs)
where
isFakeEntry (ContentRecord _ []) = True
isFakeEntry _ = False
toTree :: LDIF -> Bool -> Tree LDIFRecord
toTree (LDIF _ xs) False = fromRecords xs
toTree (LDIF _ xs) True = fromRecords $ addFakeParents xs
addFakeParents :: [ LDIFRecord ] -> [ LDIFRecord ]
addFakeParents entries = fakeParents ++ entries
where
fakeParents = map fakeParent missingDNs
where
fakeParent dn = ContentRecord dn []
missingDNs = filter ((flip S.notMember) allDNs) $ S.toList parentDNs
where
allDNs = S.fromList $ map reDN entries
parentDNs = S.fromList $ map DN $ filter (not . null) $ concatMap (tails . dnAttrVals) $ S.toList allDNs
rootEntry :: Tree LDIFRecord
rootEntry = Node (ContentRecord (DN []) []) []
fromRecords :: [LDIFRecord] -> Tree LDIFRecord
fromRecords xs = Z.toTree $ foldl' addEntry (Z.fromTree rootEntry) $ sortBy compareByDNLen xs
where
compareByDNLen a b = (lengthOfDN $ reDN a) `compare` (lengthOfDN $ reDN b)
addEntry tree entry = Z.root $ Z.insert (Node entry []) $ findParent tree
where
findParent z | not $ Z.hasChildren z = Z.children z
| isNothing child = Z.children z
| otherwise = findParent $ fromJust child
where
child = findChild $ Z.firstChild z
where
findChild Nothing = Nothing
findChild (Just c) | (Z.label c) `isParentRecordOf` entry = Just c
| otherwise = findChild $ Z.next c
sortTreeByName :: Tree LDIFRecord -> Tree LDIFRecord
sortTreeByName (Node n []) = Node n []
sortTreeByName (Node n xs) = let ys = sortBy cmpDN xs
cmpDN a b = (reDN $ rootLabel a) `compare` (reDN $ rootLabel b)
in Node n (map sortTreeByName ys)