{-# LANGUAGE StrictData       #-}
{-# LANGUAGE TypeApplications #-}

{-|
Module      : Data.VCS.Ignore.Core
Description : Core operations over the repository
Copyright   : (c) 2020-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains core operations you can perform over the scanned 'Repo'.
-}

module Data.VCS.Ignore.Core
  ( findRepo
  , listRepo
  , walkRepo
  )
where

import           Control.Exception              ( try )
import           Control.Monad.IO.Class         ( MonadIO
                                                , liftIO
                                                )
import qualified Data.List                     as L
import           Data.Maybe                     ( catMaybes
                                                , fromMaybe
                                                )
import           Data.VCS.Ignore.FileSystem     ( walkPaths )
import           Data.VCS.Ignore.Repo           ( Repo(..) )
import           Data.VCS.Ignore.Types          ( VCSIgnoreError )
import           System.FilePath                ( pathSeparator
                                                , takeDirectory
                                                )


-- | Attempts to find (and scan via 'scanRepo') repository at given path.
-- If given path doesn't contain valid repository, it recursively tries in every
-- parent directory until the root directory (e.g. @C:@ or @/@) is reached.
findRepo :: (MonadIO m, Repo r)
         => FilePath
         -- ^ path where to start scanning
         -> m (Maybe r)
         -- ^ scanned 'Repo' (if found)
findRepo :: FilePath -> m (Maybe r)
findRepo = IO (Maybe r) -> m (Maybe r)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe r) -> m (Maybe r))
-> (FilePath -> IO (Maybe r)) -> FilePath -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe r)
forall a. Repo a => FilePath -> IO (Maybe a)
go
 where
  go :: FilePath -> IO (Maybe a)
go FilePath
dir = do
    let parent :: FilePath
parent = FilePath -> FilePath
takeDirectory FilePath
dir
    Either VCSIgnoreError a
maybeRepo <- IO a -> IO (Either VCSIgnoreError a)
forall e a. Exception e => IO a -> IO (Either e a)
try @VCSIgnoreError (FilePath -> IO a
forall r (m :: * -> *).
(Repo r, MonadIO m, MonadThrow m) =>
FilePath -> m r
scanRepo FilePath
dir)
    case Either VCSIgnoreError a
maybeRepo of
      Left VCSIgnoreError
_ | FilePath
parent FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      Left  VCSIgnoreError
_                -> FilePath -> IO (Maybe a)
go FilePath
parent
      Right a
repo             -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> (a -> Maybe a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> IO (Maybe a)) -> a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
repo


-- | Resursively lists all non-ignored paths withing the given repository
-- (both files and directories).
listRepo :: (MonadIO m, Repo r)
         => r
         -- ^ repository to list
         -> m [FilePath]
         -- ^ list of non-ignored paths within the repository
listRepo :: r -> m [FilePath]
listRepo r
repo = r -> (FilePath -> m FilePath) -> m [FilePath]
forall (m :: * -> *) r a.
(MonadIO m, Repo r) =>
r -> (FilePath -> m a) -> m [a]
walkRepo r
repo FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Similar to 'listRepo', but allows to perform any action on every
-- non-ignored path within the repository.
walkRepo :: (MonadIO m, Repo r)
         => r
         -- ^ repository to walk
         -> (FilePath -> m a)
         -- ^ action to perform on every non-excluded filepath
         -> m [a]
         -- ^ list of paths transformed by the action function
walkRepo :: r -> (FilePath -> m a) -> m [a]
walkRepo r
repo FilePath -> m a
fn = do
  let search :: FilePath -> m (Maybe a)
search FilePath
path | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null FilePath
path = Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
                  | Bool
otherwise   = FilePath -> m (Maybe a)
doSearch FilePath
path
  [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> m [Maybe a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> (FilePath -> m (Maybe a)) -> m [Maybe a]
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m [a]
walkPaths FilePath
root' (FilePath -> m (Maybe a)
search (FilePath -> m (Maybe a))
-> (FilePath -> FilePath) -> FilePath -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
relativePath)
 where
  ps :: FilePath
ps           = [Char
pathSeparator]
  root :: FilePath
root         = r -> FilePath
forall r. Repo r => r -> FilePath
repoRoot r
repo
  root' :: FilePath
root'        = if FilePath
ps FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
root then FilePath
root else FilePath
root FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ps
  relativePath :: FilePath -> FilePath
relativePath = FilePath -> FilePath -> FilePath
dropPrefix FilePath
root'
  dropPrefix :: FilePath -> FilePath -> FilePath
dropPrefix   = \FilePath
prefix FilePath
t -> FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
t (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix FilePath
prefix FilePath
t)
  doSearch :: FilePath -> m (Maybe a)
doSearch     = \FilePath
path -> r -> FilePath -> m Bool
forall r (m :: * -> *).
(Repo r, MonadIO m) =>
r -> FilePath -> m Bool
isIgnored r
repo FilePath
path m Bool -> (Bool -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Bool -> m (Maybe a)
process FilePath
path
  process :: FilePath -> Bool -> m (Maybe a)
process      = \FilePath
path Bool
x -> if Bool
x then Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m a
fn FilePath
path