Gatherers.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
-- Copyright (c) 2010-2018 Brett Lajzer
-- See LICENSE for license information.

-- | Module that exposes all of the various 'GatherStrategy' types and functions
-- for dealing with them.
module Dib.Gatherers(
  SingleFileGatherer(),
  DirectoryGatherer(),
  FileTreeGatherer(),
  Gatherer(),
  CommandGatherer(),
  wrapGatherStrategy,
  runGatherers,
  makeSingleFileGatherer,
  makeDirectoryGatherer,
  makeFileTreeGatherer,
  makeCommandGatherer,
  matchAll,
  matchExtension,
  matchExtensionExcluded,
  matchExtensions,
  matchExtensionsExcluded
  )where

import Control.Monad
import Dib.Types
import Data.List
import qualified Data.Text as T
import qualified System.Directory as D
import System.FilePath

instance GatherStrategy SingleFileGatherer where
  gather = singleFileGatherFunc

instance GatherStrategy DirectoryGatherer where
  gather = directoryGathererFunc

instance GatherStrategy FileTreeGatherer where
  gather = fileTreeGatherFunc

instance GatherStrategy CommandGatherer where
  gather = commandGatherFunc

-- | Runs a list of 'Gatherer's and returns the concatenation of their output.
runGatherers :: [Gatherer] -> IO [T.Text]
runGatherers gs = mapM (\(Gatherer s) -> gather s) gs >>= \x -> foldM (\a b -> return (a ++ b)) [] x

-- | Convenience function to turn a 'GatherStrategy' into a 'Gatherer'.
wrapGatherStrategy :: GatherStrategy s => s -> Gatherer
wrapGatherStrategy = Gatherer

-- | Constructs a 'Gatherer' that returns a single file.
makeSingleFileGatherer :: T.Text -> Gatherer
makeSingleFileGatherer = wrapGatherStrategy.SingleFileGatherer

-- | Constructs a 'Gatherer' that returns all files in a directory (but not its
-- subdirectories) that match a given filter.
makeDirectoryGatherer :: T.Text -> FilterFunc -> Gatherer
makeDirectoryGatherer d = wrapGatherStrategy.DirectoryGatherer d

-- | Constructs a 'Gatherer' that returns all files in a directory tree that
-- match a given filter.
makeFileTreeGatherer :: T.Text -> FilterFunc -> Gatherer
makeFileTreeGatherer d = wrapGatherStrategy.FileTreeGatherer d

-- | Constructs a 'Gatherer' that runs an arbitrary 'IO' action.
makeCommandGatherer :: IO () -> Gatherer
makeCommandGatherer = wrapGatherStrategy.CommandGatherer

singleFileGatherFunc :: SingleFileGatherer -> IO [T.Text]
singleFileGatherFunc (SingleFileGatherer f) = do
  exists <- D.doesFileExist $ T.unpack f
  return [f | exists]

directoryGathererFunc :: DirectoryGatherer -> IO [T.Text]
directoryGathererFunc (DirectoryGatherer d f) = do
  let unpackedDir = T.unpack d
  contents <- D.getDirectoryContents unpackedDir
  filtContents <- mapM filePathDeterminer $ fixFilePaths unpackedDir $ filePathFilter contents
  let (_, files) = directorySplitter filtContents
  return $ filter f $ map T.pack files

fileTreeGatherFunc :: FileTreeGatherer -> IO [T.Text]
fileTreeGatherFunc (FileTreeGatherer d f) = do
  files <- rGetFilesInDir $ T.unpack d
  return $ filter f $ map T.pack files

commandGatherFunc :: CommandGatherer -> IO [T.Text]
commandGatherFunc (CommandGatherer f) = do
  f
  return []

-- functions to handle recursively spidering a directory
filePathDeterminer :: FilePath -> IO (FilePath, Bool)
filePathDeterminer f = D.doesDirectoryExist f >>= \d -> return (f, d)

filePathFilter :: [FilePath] -> [FilePath]
filePathFilter = filter noSpecialOrHiddenDirs
    where noSpecialOrHiddenDirs (x:_) = x /= '.'
          noSpecialOrHiddenDirs [] = False

directorySplitter :: [(FilePath, Bool)] -> ([FilePath], [FilePath])
directorySplitter = foldl' splitter ([], [])
    where splitter (d, f) (path, dir) = if dir then (d ++ [path], f) else (d, f ++ [path])

fixFilePaths :: FilePath -> [FilePath] -> [FilePath]
fixFilePaths root = map (root </>)

-- | Recursively gets all files in the given directory and its subdirectories.
rGetFilesInDir :: FilePath -> IO [FilePath]
rGetFilesInDir dir = do
    contents <- D.getDirectoryContents dir
    filtContents <- mapM filePathDeterminer $ fixFilePaths dir $ filePathFilter contents
    let (dirs, files) = directorySplitter filtContents
    spideredDirs <- mapM rGetFilesInDir dirs
    return $ concat spideredDirs ++ files

-- | Filter function that returns all files.
matchAll :: FilterFunc
matchAll _ = True

-- | Filter function that returns files with a given extension.
matchExtension :: T.Text -> FilterFunc
matchExtension = T.isSuffixOf

-- | Filter function that returns files that match any of a list of extensions.
matchExtensions :: [T.Text] -> FilterFunc
matchExtensions exts file = foldl' foldFunc False exts
  where foldFunc True _ = True
        foldFunc False e = e `T.isSuffixOf` file

-- | Filter function that returns files with a given extension that don't match exclusion rules.
matchExtensionExcluded :: T.Text -> [T.Text -> Bool] -> FilterFunc
matchExtensionExcluded ext rules file = T.isSuffixOf ext file && (not.or $ map (\r -> r file) rules)

-- | Filter function that returns files that match any of a list of extensions, but don't match the exclusion rules.
matchExtensionsExcluded :: [T.Text] -> [T.Text -> Bool] -> FilterFunc
matchExtensionsExcluded exts rules file = foldl' foldFunc False exts
  where foldFunc True _ = True
        foldFunc False e = (e `T.isSuffixOf` file) && (not.or $ map (\r -> r file) rules)