File.hs

{-# 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 always (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]


-- -- 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