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.Helpers
import Lentil.Types
import Lentil.Parse.Run
import Lentil.Parse.Syntaxes

import System.FilePath
import System.FilePath.Find
import Data.Monoid
import Control.Applicative
import Pipes

import qualified Data.List as L
import qualified Pipes.Prelude as PP


---------------
-- 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] -> [FlagWord] ->
              [FilePath] -> [FilePath] -> IO [Issue]
findIssues as fws fps xs =
        findFiles as fps xs                       >>= \fl ->
        (fmap concat $ PP.toListM $ finalPipe fl) >>= \r  ->
        perrEph "\r" >> -- clean progress bar
        return r
    where
          finalPipe fl = prod fl >-> issLoop fl

          prod fl    = each (zip fl [1..])
          issLoop fl = issueFinder as fws (length fl) >> issLoop fl
    -- todo: [refactor] [duct] apparently toListM is not idiomatic

-- actual find function for IO ()
findFiles :: [Alias] -> [FilePath] -> [FilePath] -> IO [FilePath]
findFiles as fps xs = fmap concat (mapM fc fps)
    where
          fc i = find recPred (findClause (xs' i) as) i -- search pattern

          xs' "." = map (combine ".") xs -- trick to exclude on '.'
          xs' _   = xs

          -- TODO: use pipes-files when released [feature:intermediate]


-- fp to exclude, clause (+ aliases, to include)
findClause :: [FilePath] -> [Alias] -> FindClause Bool
findClause xs as = let xc = mconcat $ map fp2fc xs
                   in fileType ==? RegularFile &&?
                      extCheck                 &&?
                      (not <$> fmap getAny xc)
    where
          fp2fc :: FilePath -> FindClause Any
          fp2fc f = Any . L.isPrefixOf f <$> filePath
          -- TODO: combine funziona su windows? [feature:intermediate]

          extCheck = (fmap getAny . mconcat)
                     (map (fmap Any . (extension ==?)) (extensionList as))



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