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] -> [FilePath] -> [FilePath] -> IO [Issue]
findIssues as fps xs =
        (fmap concat $ PP.toListM
                       (prodFilePaths fps xs as >-> issLoop)) >>= \r ->
        perrEph "\r" >> -- clean progress bar
        return r
    where issLoop = issueFinder as >> issLoop
    -- todo: [refactor] [duct] apparently toListM is not idiomatic

-- Filepaths to be parsed, as a Producer
prodFilePaths :: [FilePath] -> [FilePath] ->
                 [Alias] -> Producer FilePathC IO ()
prodFilePaths fps xs as = liftIO (fmap concat (mapM fc fps))   >>= \is ->
                          let is' = zip3 is [1..] (repeat $ length is) in
                          each is'
    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