{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Lentil.File -- Copyright : © 2015 Francesco Ariis, Tomislav -- License : GPLv3 (see the LICENSE file) -- -- File operations ----------------------------------------------------------------------------- module Lentil.File where import Lentil.Types import Lentil.Parse.Run import System.FilePath import System.FilePath.Find import Data.Monoid import Control.Applicative import qualified Data.List as L -- import Data.Either -- import System.Directory -- import Control.Exception.Base --------------- -- INSTANCES -- --------------- instance Monoid a => Monoid (FindClause a) where mempty = pure mempty mappend = liftA2 mappend -------------- -- FILESCAN -- -------------- -- todo: not using canonised paths because it is extremely slow on big -- repositories (like darcs). Explore different possibilities -- (conduit, new Filepath, unix program). [u:2] [duct] findIssues :: [Alias] -> [FilePath] -> [FilePath] -> IO [Issue] findIssues as is xs = mapM fc is >>= (issueFinder as) . concat where fc i = find recPred (findClause (xs' i)) i xs' "." = map (combine ".") xs -- trick to exclude on '.' xs' _ = xs -- fp to exclude, clause findClause :: [FilePath] -> FindClause Bool findClause x = let xc = mconcat $ map fp2fc x in fileType ==? RegularFile &&? (not <$> fmap getAny xc) where fp2fc :: FilePath -> FindClause Any fp2fc f = Any . L.isPrefixOf f <$> filePath -- TODO: combine funziona su windows? [feature:intermediate] -- recursion predicate: excludes dot ('.') or _ folders recPred :: RecursionPredicate recPred = (not . isDotFolder) <$> fileName where isDotFolder "." = False -- not curr dir! isDotFolder fp | length fp == 0 = False | L.elem (head fp) ['.', '_'] = True isDotFolder _ = False -- -- canonicalizePath with exceptions to stderr -- canonPaths :: [FilePath] -> IO [FilePath] -- canonPaths ps = (mapM (try . canonicalizePath) ps -- :: IO [Either SomeException FilePath]) >>= \ecs -> -- let (ls, rs) = partitionEithers ecs in -- mapM_ (perr . ("canonPath: " ++) . show) ls >> -- return rs