From 5c8907143a0ae0ad694780dae861b70657d7d588 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@hasufell.de>
Date: Thu, 24 Dec 2015 17:45:04 +0100
Subject: [PATCH] LIB: add symlink helpers

---
 src/Data/DirTree.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/src/Data/DirTree.hs b/src/Data/DirTree.hs
index 8f422ea..8659938 100644
--- a/src/Data/DirTree.hs
+++ b/src/Data/DirTree.hs
@@ -667,11 +667,34 @@ removeNonexistent = filter isOkConstructor
     isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err
 
 
+---- SYMLINK HELPERS: ----
+
+
+-- |Follows a chain of symlinks until it finds a non-symlink. Note that
+-- this can be caught in an infinite loop if the symlinks haven't been
+-- constructed properly. This module however ensures that this cannot
+-- happen.
+followSymlink :: File FileInfo -> File FileInfo
+followSymlink (SymLink _ _ (_ :/ b@(SymLink {}))) = followSymlink b
+followSymlink af                                  = af
+
+
+-- |Checks if a symlink is broken by examining the constructor of the
+-- symlink destination. This also follows the symlink chain.
+--
+-- When called on a non-symlink, returns False.
+isBrokenSymlink :: File FileInfo -> Bool
+isBrokenSymlink af@(SymLink {})
+  = case followSymlink af of
+      (Failed {}) -> True
+      _           -> False
+isBrokenSymlink _ = False
 
 
 ---- OTHER: ----
 
 
+
 fullPath :: AnchoredFile a -> FilePath
 fullPath (bp :/ f) = bp </> name f