Layout.hs

-- | Language to express directory layouts
module System.Directory.Layout
  ( -- * Layout declaration
    Node, Layout, file, file_, directory, directory_
    -- * Layout construction
  , fromDirectory
    -- * Layout traverses
  , make, check
    -- * Errors
  , LayoutException(..)
  ) where

import           Control.Lens
import           Control.Monad ((>=>))
import qualified Control.Exception as E
import           Data.Default (def)
import           Data.Monoid (mconcat)
import           Data.Text (Text)
import qualified System.Directory as D
import           System.FilePath (combine)
import           System.FilePath.Lens (filename)

import System.Directory.Layout.Internal (Node(..), Layout)
import System.Directory.Layout.Traverse (make, check)
import System.Directory.Layout.Errored (LayoutException(..))


-- | Declare file with specified contents
file :: FilePath -> Text -> Layout
file x t = F x (T t ()) def
{-# INLINE file #-}


-- | Declare empty file
file_ :: FilePath -> Layout
file_ x = F x def def
{-# INLINE file_ #-}


-- | Declare directory with specified listing
directory :: FilePath -> Layout -> Layout
directory x d = D x d def
{-# INLINE directory #-}


-- | Declare empty directory
directory_ :: FilePath -> Layout
directory_ x = D x def def
{-# INLINE directory_ #-}


-- | Create layout from directory
--
-- Canonicalizes path before traversing, generally understands only
-- regular files and directories and ignores anything else it could not understand
fromDirectory :: FilePath -> IO (Either E.IOException Layout)
fromDirectory = E.try . (D.canonicalizePath >=> traverseDirectory)
 where
  traverseDirectory :: FilePath -> IO Layout
  traverseDirectory path = getDirectoryContents path >>=
    traverse (traverseFilePath . combine path) <&> directory (path^.filename) . mconcat

  traverseFilePath :: FilePath -> IO Layout
  traverseFilePath path = do
    isFile      <- D.doesFileExist path
    isDirectory <- D.doesDirectoryExist path
    case (isFile, isDirectory) of
      (True, _) -> return (file_ (path^.filename))
      (_, True) -> traverseDirectory path
      -- Should be pretty rare in practice: broken symlinks and stuff
      (_, _)    -> return def

  getDirectoryContents :: FilePath -> IO [FilePath]
  getDirectoryContents = fmap (filter (not . (`elem` [".", ".."]))) . D.getDirectoryContents