DirTree.hs

    ----------------------------
    --[ BASE TYPES ]--
    ----------------------------


-- |Weak type to distinguish between FilePath and FileName.
type FileName = String


-- |A simple wrapper to hold a base directory name, which can be either an
-- absolute or relative path. This lets us give the DirTree a context, while
-- still letting us store only directory and file /names/ (not full paths) in
-- the DirTree. (uses an infix constructor; don't be scared)
data AnchoredDirTree a b =
  (:/) { anchor :: FilePath, dirTree :: DirTree a b }
  deriving (Show, Ord, Eq)


-- |The String in the name field is always a file name, never a full path.
-- The free type variable is used in the File/Dir constructor and can hold
-- Handles, Strings representing a file's contents or anything else you can
-- think of. We catch any IO errors in the Failed constructor. an Exception
-- can be converted to a String with 'show'.
data DirTree a b =
    Failed {
        name :: FileName
      , err  :: IOException
    }
  | Dir {
        name     :: FileName
      , contents :: [DirTree a b]
      , dir      :: a
    }
  | File {
        name :: FileName
      , file :: b
  } deriving Show


-- |All possible directory information we could ever need from a directory.
data DirInfo = MkDirInfo {
    permissionsD  :: Permissions
  , creationTimeD :: Maybe UTCTime
  , changeTimeD   :: Maybe UTCTime
  , modTimeD      :: UTCTime
  , accessTimeD   :: UTCTime
  , symD          :: Bool
  , hasSubDirs    :: Maybe Bool
  } deriving (Show, Eq)


-- |All possible file information we could ever need from a file.
data FileInfo = MkFileInfo {
    permissionsF  :: Permissions
  , creationTimeF :: Maybe UTCTime
  , changeTimeF   :: Maybe UTCTime
  , modTimeF      :: UTCTime
  , accessTimeF   :: UTCTime
  , symF          :: Bool
  , fileSize      :: Word64
  } deriving (Show, Eq)



    ----------------------------
    --[ ZIPPING ]--
    ----------------------------


-- |The zipper type, left is the (current) directory, right
-- are the breadcrumbs.
type DTZipper a b = (DirTree a b, [DirTree a b])


-- |The base zipper of a tree with empty crumbs element.
baseZipper :: DirTree a b -> DTZipper a b
baseZipper dt = (dt, [])


-- |Goes down the given subdir in a given directory. Returns `Nothing`
-- if the subdir does not exist.
goDown :: FileName -> DTZipper a b -> Maybe (DTZipper a b)
goDown fn (dtp@(Dir n cs d), xs) =
  case mcdt of
    Just cdt -> Just (cdt, Dir n crumb d : xs)
    Nothing  -> Nothing
  where
    crumb = foldr (\x y -> if equalFilePath fn (name x) then y else x : y)
                  [] cs
    mcdt  = DL.find (\x -> equalFilePath (name x) fn) cs
goDown _ _       = Nothing


-- |Goes down the given subpath in a given directory. Returns `Nothing`
-- if the subpath does not exist.
goDown' :: FilePath -> DTZipper a b -> Maybe (DTZipper a b)
goDown' fp dz = go (splitPath fp) dz
  where
    go []  dz      = Just dz
    go (fn:fns) dz = goDown fn dz >>= go fns


-- TODO: error handling if the parent of a file is a file too (wat?)
-- |Goes up one directory. This cannot fail. If you call it on the
-- root node of the zipper, you get it back untouched.
goUp :: DTZipper a b -> DTZipper a b
goUp dz@(_, [])            = dz
goUp (dt, Dir n cs d : xs) = (Dir n (dt:cs) d, xs)


-- |Goes up to the root directory/node of the zipper.
goRoot :: DTZipper a b -> DTZipper a b
goRoot dz@(_, []) = dz
goRoot dz         = goRoot (goUp dz)


-- |Gets the full path of the current directory in the zipper context.
-- This might not be a real absolute filesystem path, because it depends
-- on the zipper context.
getFullPath :: DTZipper a b -> FilePath
getFullPath dz@(dt, _:_) = getFullPath (goUp dz) </> name dt
getFullPath    (dt, [])  = name dt


-- |Retrieve the (current) directory component from the zipper.
unZip :: DTZipper a b -> DirTree a b
unZip = fst


-- |Retrieve the (current) directory component from the zipper and
-- transform it to an `AnchoredDirTree`.
unZip' :: DTZipper a b -> AnchoredDirTree a b
unZip' dz@(dt, _) = (takeDirectory . getFullPath $ dz) :/ dt


-- |Map a function over the (current) directory component of the zipper.
withZip :: (DirTree a b -> DirTree a b) -> DTZipper a b -> DTZipper a b
withZip = first