{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData          #-}
{-# LANGUAGE TupleSections       #-}

{-|
Module      : Data.VCS.Ignore.Repo.Git
Description : Implementation of 'Repo' for /GIT/
Copyright   : (c) 2020-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains implementation of 'Repo' /type class/ for the /GIT/ content
versioning system. Most of the public functions is exported only to make them
visible for tests, end user of this library really shouldn't need to use them.
-}

module Data.VCS.Ignore.Repo.Git
  ( Git(..)
  , Pattern(..)
  , compilePattern
  , matchesPattern
  , parsePatterns
  , loadPatterns
  , findGitIgnores
  , gitIgnorePatterns
  , repoPatterns
  , globalPatterns
  , scanRepo'
  , isIgnored'
  , isGitRepo
  )
where

import           Control.Exception              ( SomeException
                                                , catch
                                                )
import           Control.Monad.Catch            ( MonadThrow
                                                , throwM
                                                )
import           Control.Monad.IO.Class         ( MonadIO
                                                , liftIO
                                                )
import qualified Data.List                     as L
import           Data.Maybe                     ( fromMaybe
                                                , maybeToList
                                                )
import           Data.String                    ( IsString(..) )
import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import           Data.VCS.Ignore.FileSystem     ( findPaths
                                                , toPosixPath
                                                )
import           Data.VCS.Ignore.Repo           ( Repo(..)
                                                , Repo(..)
                                                , RepoError(..)
                                                )
import           System.Directory               ( XdgDirectory(XdgConfig)
                                                , canonicalizePath
                                                , doesDirectoryExist
                                                , getXdgDirectory
                                                , makeAbsolute
                                                )
import           System.FilePath                ( makeRelative
                                                , (</>)
                                                )
import qualified System.FilePath.Glob          as G


-- | Data type representing scanned instance of /GIT/ repository.
data Git = Git
  { Git -> FilePath
gitRepoRoot :: FilePath
  -- ^ absolute path to the repository root
  , Git -> [(FilePath, [Pattern])]
gitPatterns :: [(FilePath, [Pattern])]
  -- ^ patterns ignored at given repository paths
  }
  deriving (Git -> Git -> Bool
(Git -> Git -> Bool) -> (Git -> Git -> Bool) -> Eq Git
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Git -> Git -> Bool
$c/= :: Git -> Git -> Bool
== :: Git -> Git -> Bool
$c== :: Git -> Git -> Bool
Eq, Int -> Git -> ShowS
[Git] -> ShowS
Git -> FilePath
(Int -> Git -> ShowS)
-> (Git -> FilePath) -> ([Git] -> ShowS) -> Show Git
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Git] -> ShowS
$cshowList :: [Git] -> ShowS
show :: Git -> FilePath
$cshow :: Git -> FilePath
showsPrec :: Int -> Git -> ShowS
$cshowsPrec :: Int -> Git -> ShowS
Show)

instance Repo Git where
  repoName :: Git -> Text
repoName  = Text -> Git -> Text
forall a b. a -> b -> a
const Text
"Git"
  repoRoot :: Git -> FilePath
repoRoot  = Git -> FilePath
gitRepoRoot
  scanRepo :: FilePath -> m Git
scanRepo  = m [Pattern]
-> (FilePath -> m [Pattern])
-> (FilePath -> m [(FilePath, [Pattern])])
-> (FilePath -> m Bool)
-> FilePath
-> m Git
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
m [Pattern]
-> (FilePath -> m [Pattern])
-> (FilePath -> m [(FilePath, [Pattern])])
-> (FilePath -> m Bool)
-> FilePath
-> m Git
scanRepo' m [Pattern]
forall (m :: * -> *). MonadIO m => m [Pattern]
globalPatterns FilePath -> m [Pattern]
forall (m :: * -> *). MonadIO m => FilePath -> m [Pattern]
repoPatterns FilePath -> m [(FilePath, [Pattern])]
forall (m :: * -> *).
MonadIO m =>
FilePath -> m [(FilePath, [Pattern])]
gitIgnorePatterns FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
isGitRepo
  isIgnored :: Git -> FilePath -> m Bool
isIgnored = Git -> FilePath -> m Bool
forall (m :: * -> *). MonadIO m => Git -> FilePath -> m Bool
isIgnored'

-- | Represents single pattern to be used as a rule for ignoring paths.
data Pattern = Pattern
  { Pattern -> [Pattern]
pPatterns  :: [G.Pattern]
  -- ^ underlying implementation
  , Pattern -> Text
pRaw       :: Text
  -- ^ raw textual representation of the pattern
  , Pattern -> Bool
pIsNegated :: Bool
  -- ^ whether the pattern is the negation (starts with @!@)
  }
  deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> FilePath
(Int -> Pattern -> ShowS)
-> (Pattern -> FilePath) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> FilePath
$cshow :: Pattern -> FilePath
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

instance IsString Pattern where
  fromString :: FilePath -> Pattern
fromString = Text -> Pattern
compilePattern (Text -> Pattern) -> (FilePath -> Text) -> FilePath -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Compiles pattern.
compilePattern :: Text
               -- ^ raw pattern as text
               -> Pattern
               -- ^ compiled pattern
compilePattern :: Text -> Pattern
compilePattern Text
raw =
  let woPrefix :: Text
woPrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
raw (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"!" Text
raw
      patterns :: [Text]
patterns = Text -> [Text]
r2 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
r1 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
woPrefix
  in  Pattern :: [Pattern] -> Text -> Bool -> Pattern
Pattern { pPatterns :: [Pattern]
pPatterns  = (Text -> Pattern) -> [Text] -> [Pattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Pattern
G.compile (FilePath -> Pattern) -> (Text -> FilePath) -> Text -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) [Text]
patterns
              , pRaw :: Text
pRaw       = Text
raw
              , pIsNegated :: Bool
pIsNegated = Text
raw Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
woPrefix
              }
 where
  r1 :: Text -> Text
r1 Text
p | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
p) [Text
"/", Text
"*"] = Text
p
       | [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
p) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
"**/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
       | Bool
otherwise                         = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
  r2 :: Text -> [Text]
r2 Text
p | Text
"/" Text -> Text -> Bool
`T.isSuffixOf` Text
p = [Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"]
       | Bool
otherwise            = [Text
p, Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/**"]


-- | Tests whether given path matches against the pattern.
matchesPattern :: Pattern
               -- ^ pattern to match against
               -> FilePath
               -- ^ path to check
               -> Bool
               -- ^ check result
matchesPattern :: Pattern -> FilePath -> Bool
matchesPattern Pattern
ptn FilePath
path = (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> FilePath -> Bool
`G.match` FilePath
path) (Pattern -> [Pattern]
pPatterns Pattern
ptn)


-- | Parses /Glob/ patterns from given text source. Each line in input text is
-- considered to be single pattern. Lines starting with @#@ (comments) and blank
-- lines are skipped.
--
-- >>> parsePatterns "*.xml\n.DS_Store"
-- [Pattern {pPatterns = [compile "*.xml",compile "*.xml/*"], pRaw = "*.xml", pIsNegated = False},Pattern {pPatterns = [compile "**/.DS_Store",compile "**/.DS_Store/*"], pRaw = ".DS_Store", pIsNegated = False}]
parsePatterns :: Text
              -- ^ text to parse
              -> [Pattern]
              -- ^ parsed patterns
parsePatterns :: Text -> [Pattern]
parsePatterns = (Text -> Pattern) -> [Text] -> [Pattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Pattern
compilePattern ([Text] -> [Pattern]) -> (Text -> [Text]) -> Text -> [Pattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
excluded) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
 where
  excluded :: Text -> Bool
excluded = \Text
line -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Text -> Bool) -> Bool) -> [Text -> Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart Text
line) [Text -> Bool
comment, Text -> Bool
T.null]
  comment :: Text -> Bool
comment  = \Text
line -> Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
line


-- | Loads /Glob/ patterns from given text file. If the fille cannot be read for
-- any reason, empty list is returned. See 'parsePatterns' for more details
-- about parsing.
loadPatterns :: MonadIO m
             => FilePath
             -- ^ path to text file to parse
             -> m [Pattern]
             -- ^ parsed /Glob/ patterns
loadPatterns :: FilePath -> m [Pattern]
loadPatterns FilePath
path = Text -> [Pattern]
parsePatterns (Text -> [Pattern]) -> m Text -> m [Pattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
content
 where
  content :: IO Text
content = IO Text -> (SomeException -> IO Text) -> IO Text
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FilePath -> IO Text
T.readFile FilePath
path) (\(SomeException
_ :: SomeException) -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty)


-- | Recursively finds all @.gitignore@ files within the given directory path.
findGitIgnores :: MonadIO m
               => FilePath
               -- ^ path to the directory to search in
               -> m [FilePath]
               -- ^ paths of found @.gitignore@ files
findGitIgnores :: FilePath -> m [FilePath]
findGitIgnores FilePath
repoDir = FilePath -> (FilePath -> m Bool) -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> (FilePath -> m Bool) -> m [FilePath]
findPaths FilePath
repoDir FilePath -> m Bool
forall (f :: * -> *). Applicative f => FilePath -> f Bool
isGitIgnore
  where isGitIgnore :: FilePath -> f Bool
isGitIgnore FilePath
path = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool) -> Bool -> f Bool
forall a b. (a -> b) -> a -> b
$ FilePath
".gitignore" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
path


-- | Recursively finds all @.gitignore@ files within the given directory path
-- and parses them into /Glob/ patterns. See 'loadPatterns' and 'findGitIgnores'
-- for more details.
gitIgnorePatterns :: MonadIO m
                  => FilePath
                  -- ^ path to the directory to search @.gitignore@ files in
                  -> m [(FilePath, [Pattern])]
                  -- ^ list of @.gitignore@ paths and parsed /Glob/ patterns
gitIgnorePatterns :: FilePath -> m [(FilePath, [Pattern])]
gitIgnorePatterns FilePath
repoDir = do
  [FilePath]
gitIgnores <- FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
findGitIgnores FilePath
repoDir
  (FilePath -> m (FilePath, [Pattern]))
-> [FilePath] -> m [(FilePath, [Pattern])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
p -> (ShowS
toPosixPath ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
path ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
p, ) ([Pattern] -> (FilePath, [Pattern]))
-> m [Pattern] -> m (FilePath, [Pattern])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m [Pattern]
forall (m :: * -> *). MonadIO m => FilePath -> m [Pattern]
loadPatterns FilePath
p) [FilePath]
gitIgnores
  where path :: ShowS
path FilePath
p = FilePath -> ShowS
stripSuffix' FilePath
".gitignore" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
stripPrefix' FilePath
repoDir FilePath
p


-- | Loads /GIT/ repository specific ignore patterns, present in
-- @REPO_ROOT\/info\/exclude@ file.
repoPatterns :: MonadIO m
             => FilePath
             -- ^ path to the /GIT/ repository root
             -> m [Pattern]
             -- ^ parsed /Glob/ patterns
repoPatterns :: FilePath -> m [Pattern]
repoPatterns FilePath
repoDir = FilePath -> m [Pattern]
forall (m :: * -> *). MonadIO m => FilePath -> m [Pattern]
loadPatterns (FilePath -> m [Pattern]) -> FilePath -> m [Pattern]
forall a b. (a -> b) -> a -> b
$ FilePath
repoDir FilePath -> ShowS
</> FilePath
"info" FilePath -> ShowS
</> FilePath
"exclude"


-- | Loads global /GIT/  ignore patterns, present in
-- @XDG_CONFIG_GOME\/git\/ignore@ file.
globalPatterns :: MonadIO m => m [Pattern]
               -- ^ parsed /Glob/ patterns
globalPatterns :: m [Pattern]
globalPatterns =
  (IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath
"git" FilePath -> ShowS
</> FilePath
"ignore")) m FilePath -> (FilePath -> m [Pattern]) -> m [Pattern]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> m [Pattern]
forall (m :: * -> *). MonadIO m => FilePath -> m [Pattern]
loadPatterns


-- | Internal version of 'scanRepo', where individual functions needs to be
-- explicitly provided, which is useful mainly for testing purposes.
scanRepo' :: (MonadIO m, MonadThrow m)
          => m [Pattern]
          -- ^ reference to 'globalPatterns' function (or similar)
          -> (FilePath -> m [Pattern])
          -- ^ reference to 'repoPatterns' function (or similar)
          -> (FilePath -> m [(FilePath, [Pattern])])
          -- ^ reference to 'gitIgnorePatterns' function (or similar)
          -> (FilePath -> m Bool)
          -- ^ reference to 'isGitRepo' function (or similar)
          -> FilePath
          -- ^ path to /GIT/ repository root
          -> m Git
          -- ^ scanned /Git/ repository
scanRepo' :: m [Pattern]
-> (FilePath -> m [Pattern])
-> (FilePath -> m [(FilePath, [Pattern])])
-> (FilePath -> m Bool)
-> FilePath
-> m Git
scanRepo' m [Pattern]
globalPatternsFn FilePath -> m [Pattern]
repoPatternsFn FilePath -> m [(FilePath, [Pattern])]
gitIgnoresFn FilePath -> m Bool
isGitRepoFn FilePath
repoDir = do
  FilePath
absRepoDir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
makeAbsolute FilePath
repoDir
  Bool
gitRepo    <- FilePath -> m Bool
isGitRepoFn FilePath
absRepoDir
  (if Bool
gitRepo then FilePath -> m Git
proceed else FilePath -> m Git
forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
abort) FilePath
absRepoDir
 where
  abort :: FilePath -> m a
abort FilePath
repoDir' = RepoError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RepoError -> m a) -> RepoError -> m a
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> RepoError
InvalidRepo FilePath
repoDir' Text
"not a valid GIT repository"
  proceed :: FilePath -> m Git
proceed FilePath
repoDir' = do
    [Pattern]
globalPatterns' <- m [Pattern]
globalPatternsFn
    [Pattern]
repoPatterns'   <- FilePath -> m [Pattern]
repoPatternsFn FilePath
repoDir'
    [(FilePath, [Pattern])]
gitIgnores      <- FilePath -> m [(FilePath, [Pattern])]
gitIgnoresFn FilePath
repoDir'
    let ([Pattern]
r, [(FilePath, [Pattern])]
o)   = [(FilePath, [Pattern])] -> ([Pattern], [(FilePath, [Pattern])])
forall a a. (Eq a, IsString a) => [(a, [a])] -> ([a], [(a, [a])])
sep [(FilePath, [Pattern])]
gitIgnores
        patterns :: [(FilePath, [Pattern])]
patterns = [(FilePath
"/", [Pattern]
globalPatterns' [Pattern] -> [Pattern] -> [Pattern]
forall a. Semigroup a => a -> a -> a
<> [Pattern]
repoPatterns' [Pattern] -> [Pattern] -> [Pattern]
forall a. Semigroup a => a -> a -> a
<> [Pattern]
r)] [(FilePath, [Pattern])]
-> [(FilePath, [Pattern])] -> [(FilePath, [Pattern])]
forall a. Semigroup a => a -> a -> a
<> [(FilePath, [Pattern])]
o
    Git -> m Git
forall (f :: * -> *) a. Applicative f => a -> f a
pure Git :: FilePath -> [(FilePath, [Pattern])] -> Git
Git { gitRepoRoot :: FilePath
gitRepoRoot = FilePath
repoDir', gitPatterns :: [(FilePath, [Pattern])]
gitPatterns = [(FilePath, [Pattern])]
patterns }
  sep :: [(a, [a])] -> ([a], [(a, [a])])
sep [(a, [a])]
xs =
    let predicate :: (a, b) -> Bool
predicate = \(a
p, b
_) -> a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"/"
        woRoot :: [(a, [a])]
woRoot    = ((a, [a]) -> Bool) -> [(a, [a])] -> [(a, [a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, [a]) -> Bool) -> (a, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> Bool
forall b. (a, b) -> Bool
predicate) [(a, [a])]
xs
        root :: [a]
root      = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> (Maybe [a] -> [[a]]) -> Maybe [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [a] -> [[a]]
forall a. Maybe a -> [a]
maybeToList (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((a, [a]) -> [a]) -> Maybe (a, [a]) -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, [a]) -> Bool) -> [(a, [a])] -> Maybe (a, [a])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (a, [a]) -> Bool
forall b. (a, b) -> Bool
predicate [(a, [a])]
xs
    in  ([a]
root, [(a, [a])]
woRoot)


-- | Internal version of 'isIgnored' function.
isIgnored' :: MonadIO m
           => Git
           -- ^ scanned /GIT/ repository
           -> FilePath
           -- ^ path to check if ignored
           -> m Bool
           -- @True@ if given path is ignored
isIgnored' :: Git -> FilePath -> m Bool
isIgnored' git :: Git
git@(Git FilePath
_ [(FilePath, [Pattern])]
patterns) FilePath
path = do
  FilePath
np <- ShowS
toPosixPath ShowS -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> m FilePath
normalize (Git -> FilePath
forall r. Repo r => r -> FilePath
repoRoot Git
git) FilePath
path
  let ignored :: Bool
ignored = ((FilePath, [Pattern]) -> Bool) -> [(FilePath, [Pattern])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> Bool -> (FilePath, [Pattern]) -> Bool
check2 FilePath
np Bool
False) (FilePath -> [(FilePath, [Pattern])]
filtered FilePath
np)
      negated :: Bool
negated = ((FilePath, [Pattern]) -> Bool) -> [(FilePath, [Pattern])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> Bool -> (FilePath, [Pattern]) -> Bool
check2 FilePath
np Bool
True) (FilePath -> [(FilePath, [Pattern])]
filtered FilePath
np)
  Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
ignored Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
negated
 where
  sanitized :: ShowS
sanitized  = FilePath -> ShowS
addPrefix FilePath
"/"
  asRepoPath :: FilePath -> ShowS
asRepoPath = \FilePath
np -> (FilePath -> ShowS
`stripPrefix'` ShowS
sanitized FilePath
np)
  filtered :: FilePath -> [(FilePath, [Pattern])]
filtered   = \FilePath
np -> ((FilePath, [Pattern]) -> Bool)
-> [(FilePath, [Pattern])] -> [(FilePath, [Pattern])]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> (FilePath, [Pattern]) -> Bool
forall b. FilePath -> (FilePath, b) -> Bool
onPath FilePath
np) [(FilePath, [Pattern])]
patterns
  onPath :: FilePath -> (FilePath, b) -> Bool
onPath     = \FilePath
np (FilePath
p, b
_) -> FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` ShowS
sanitized FilePath
np
  check2 :: FilePath -> Bool -> (FilePath, [Pattern]) -> Bool
check2     = \FilePath
np Bool
negated (FilePath
prefix, [Pattern]
ptns) ->
    (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> FilePath -> Bool
`matchesPattern` FilePath -> ShowS
asRepoPath FilePath
np FilePath
prefix)
      ([Pattern] -> Bool)
-> ([Pattern] -> [Pattern]) -> [Pattern] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Bool) -> [Pattern] -> [Pattern]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern
p -> Pattern -> Bool
pIsNegated Pattern
p Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
negated)
      ([Pattern] -> Bool) -> [Pattern] -> Bool
forall a b. (a -> b) -> a -> b
$ [Pattern]
ptns


-- | Checks whether given directory path is valid /GIT/ repository.
isGitRepo :: MonadIO m
          => FilePath
          -- ^ path to the directory to check
          -> m Bool
          -- ^ @True@ if the given directory is valid /GIT/ repository
isGitRepo :: FilePath -> m Bool
isGitRepo FilePath
path = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> (FilePath -> IO Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesDirectoryExist (FilePath -> m Bool) -> FilePath -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> ShowS
</> FilePath
".git"


------------------------------  PRIVATE FUNCTIONS  -----------------------------

addPrefix :: String -> String -> String
addPrefix :: FilePath -> ShowS
addPrefix FilePath
prefix FilePath
str | FilePath
prefix FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` FilePath
str = FilePath
str
                     | Bool
otherwise                 = FilePath
prefix FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
str


stripPrefix' :: String -> String -> String
stripPrefix' :: FilePath -> ShowS
stripPrefix' FilePath
prefix FilePath
str =
  FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
str Text -> FilePath
T.unpack (Text -> Text -> Maybe Text
T.stripPrefix (FilePath -> Text
T.pack FilePath
prefix) (FilePath -> Text
T.pack FilePath
str))


stripSuffix' :: String -> String -> String
stripSuffix' :: FilePath -> ShowS
stripSuffix' FilePath
suffix FilePath
str =
  FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
str Text -> FilePath
T.unpack (Text -> Text -> Maybe Text
T.stripSuffix (FilePath -> Text
T.pack FilePath
suffix) (FilePath -> Text
T.pack FilePath
str))


normalize :: MonadIO m => FilePath -> FilePath -> m FilePath
normalize :: FilePath -> FilePath -> m FilePath
normalize FilePath
repoDir FilePath
path = do
  FilePath
canonicalized <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
repoDir FilePath -> ShowS
</> FilePath -> ShowS
stripPrefix' FilePath
"/" FilePath
path
  Bool
isDir         <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
canonicalized
  let suffix :: FilePath
suffix = if Bool
isDir Bool -> Bool -> Bool
|| FilePath
"/" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
path then FilePath
"/" else FilePath
""
  FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
makeRelative FilePath
repoDir FilePath
canonicalized FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix