{-# LANGUAGE TemplateHaskell #-}
module HMGit.Internal.Parser.Pathspecs (
pathspecs
, lsMatches
) where
import HMGit.Internal.Core.Runner.API (HMGitT, hmGitDBPath,
hmGitRoot)
import HMGit.Internal.Exceptions (MonadThrowable (..))
import qualified HMGit.Internal.Parser.Pathspecs.Glob as G
import HMGit.Internal.Utils (foldChoiceM, foldMapM,
makeRelativeEx, (?*>))
import Control.Applicative (Alternative (..))
import Control.Exception.Safe (MonadCatch, catchAny,
throwString)
import Control.Monad.Extra (filterM, ifM, orM)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Functor ((<&>))
import qualified Data.Set as S
import Data.Void (Void)
import Path (Dir, Rel)
import qualified Path as P
import qualified Path.IO as P
import Text.Printf (printf)
pathspec :: (MonadCatch m, MonadIO m, Alternative m)
=> P.Path P.Abs P.Dir
-> P.Path P.Abs P.File
-> String
-> m FilePath
pathspec :: Path Abs Dir -> Path Abs File -> String -> m String
pathspec Path Abs Dir
cDir Path Abs File
fpath [] = String -> String -> m String
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
String -> String -> m String
makeRelativeEx (Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
cDir) (Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath)
pathspec Path Abs Dir
cDir Path Abs File
fpath String
pat = m String
pathspec' m String -> (SomeException -> m String) -> m String
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny`
m String -> SomeException -> m String
forall a b. a -> b -> a
const (String -> m String
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s does not match in pattern %s" (Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath) String
pat)
where
pathspec' :: m String
pathspec' = do
Path Abs Dir
x <- Path Abs Dir -> String -> m (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
P.resolveDir Path Abs Dir
cDir String
pat
GlobIR
ir <- String -> m GlobIR
forall (m :: * -> *). MonadThrow m => String -> m GlobIR
G.transpile (String -> m GlobIR) -> String -> m GlobIR
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
x
if GlobIR -> Bool
G.isLiteral GlobIR
ir then
(Path Abs Dir -> Path Abs File -> Bool
forall b t. Path b Dir -> Path b t -> Bool
P.isProperPrefixOf Path Abs Dir
x Path Abs File
fpath Bool -> Bool -> Bool
|| Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
forall a. [a] -> [a]
init (Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
x))
Bool -> m String -> m String
forall (f :: * -> *) a. Alternative f => Bool -> f a -> f a
?*> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
String -> String -> m String
makeRelativeEx (Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
cDir) (Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath)
else
String -> GlobIR -> Bool
G.match (Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath) GlobIR
ir
Bool -> m String -> m String
forall (f :: * -> *) a. Alternative f => Bool -> f a -> f a
?*> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
String -> String -> m String
makeRelativeEx (Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
cDir) (Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath Path Abs File
fpath)
pathspecs :: (MonadCatch m, MonadIO m, Alternative m)
=> P.Path P.Abs P.Dir
-> P.SomeBase P.File
-> [String]
-> HMGitT m FilePath
pathspecs :: Path Abs Dir -> SomeBase File -> [String] -> HMGitT m String
pathspecs Path Abs Dir
cDir (P.Abs Path Abs File
fpath) [] = Path Abs Dir -> Path Abs File -> String -> HMGitT m String
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
Path Abs Dir -> Path Abs File -> String -> m String
pathspec Path Abs Dir
cDir Path Abs File
fpath []
pathspecs Path Abs Dir
cDir (P.Rel Path Rel File
fpath) [] = HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot
HMGitT m (Path Abs Dir)
-> (Path Abs Dir -> Path Abs File)
-> ReaderT HMGitConfig m (Path Abs File)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel File
fpath)
ReaderT HMGitConfig m (Path Abs File)
-> (Path Abs File -> HMGitT m String) -> HMGitT m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Path Abs File -> String -> HMGitT m String)
-> String -> Path Abs File -> HMGitT m String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Path Abs Dir -> Path Abs File -> String -> HMGitT m String
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
Path Abs Dir -> Path Abs File -> String -> m String
pathspec Path Abs Dir
cDir) []
pathspecs Path Abs Dir
cDir (P.Abs Path Abs File
fpath) [String]
pat = (String -> HMGitT m String) -> [String] -> HMGitT m String
forall (m :: * -> *) (f :: * -> *) (t :: * -> *) a b.
(Monad m, Alternative f, Foldable t) =>
(a -> m (f b)) -> t a -> m (f b)
foldChoiceM (Path Abs Dir -> Path Abs File -> String -> HMGitT m String
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
Path Abs Dir -> Path Abs File -> String -> m String
pathspec Path Abs Dir
cDir Path Abs File
fpath) [String]
pat
pathspecs Path Abs Dir
cDir (P.Rel Path Rel File
fpath) [String]
pat = (Path Abs Dir -> Path Abs File -> String -> HMGitT m String
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
Path Abs Dir -> Path Abs File -> String -> m String
pathspec
(Path Abs Dir -> Path Abs File -> String -> HMGitT m String)
-> HMGitT m (Path Abs Dir)
-> ReaderT
HMGitConfig m (Path Abs File -> String -> HMGitT m String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> HMGitT m (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs Dir
cDir
ReaderT HMGitConfig m (Path Abs File -> String -> HMGitT m String)
-> ReaderT HMGitConfig m (Path Abs File)
-> ReaderT HMGitConfig m (String -> HMGitT m String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel File
fpath) (Path Abs Dir -> Path Abs File)
-> HMGitT m (Path Abs Dir) -> ReaderT HMGitConfig m (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot))
ReaderT HMGitConfig m (String -> HMGitT m String)
-> ((String -> HMGitT m String) -> HMGitT m String)
-> HMGitT m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((String -> HMGitT m String) -> [String] -> HMGitT m String)
-> [String] -> (String -> HMGitT m String) -> HMGitT m String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> HMGitT m String) -> [String] -> HMGitT m String
forall (m :: * -> *) (f :: * -> *) (t :: * -> *) a b.
(Monad m, Alternative f, Foldable t) =>
(a -> m (f b)) -> t a -> m (f b)
foldChoiceM [String]
pat
lsMatch :: (MonadCatch m, MonadIO m)
=> P.Path P.Abs P.Dir
-> String
-> HMGitT m (S.Set (P.Path P.Abs P.File))
lsMatch :: Path Abs Dir -> String -> HMGitT m (Set (Path Abs File))
lsMatch Path Abs Dir
_ [] = Set (Path Abs File) -> HMGitT m (Set (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
S.empty
lsMatch Path Abs Dir
cDir String
pat = do
Path Abs Dir
root <- HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot
Path Abs Dir
x <- Path Abs Dir -> String -> HMGitT m (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
P.resolveDir Path Abs Dir
cDir String
pat
GlobIR
ir <- String -> ReaderT HMGitConfig m GlobIR
forall (m :: * -> *). MonadThrow m => String -> m GlobIR
G.transpile (String -> ReaderT HMGitConfig m GlobIR)
-> String -> ReaderT HMGitConfig m GlobIR
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
x
if GlobIR -> Bool
G.isLiteral GlobIR
ir then let mFile :: Maybe (Path Abs File)
mFile = String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
P.parseAbsFile (String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
P.toFilePath Path Abs Dir
x) in
ReaderT HMGitConfig m Bool
-> HMGitT m (Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (ReaderT HMGitConfig m Bool
-> (Path Abs File -> ReaderT HMGitConfig m Bool)
-> Maybe (Path Abs File)
-> ReaderT HMGitConfig m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ReaderT HMGitConfig m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Path Abs File -> ReaderT HMGitConfig m Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
P.doesFileExist Maybe (Path Abs File)
mFile)
(Maybe Void
-> Maybe (Path Abs File) -> ReaderT HMGitConfig m (Path Abs File)
forall (m :: * -> *) (n :: * -> *) e.
(MonadThrowable m, MonadThrow n, Exception e) =>
Maybe e -> m ~> n
fromMonad (Maybe Void
forall a. Maybe a
Nothing :: Maybe Void) Maybe (Path Abs File)
mFile ReaderT HMGitConfig m (Path Abs File)
-> (Path Abs File -> Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton) (HMGitT m (Set (Path Abs File)) -> HMGitT m (Set (Path Abs File)))
-> HMGitT m (Set (Path Abs File)) -> HMGitT m (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$
ReaderT HMGitConfig m Bool
-> HMGitT m (Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Path Abs Dir -> ReaderT HMGitConfig m Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
P.doesDirExist Path Abs Dir
x)
(Path Abs Dir
-> ReaderT HMGitConfig m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
P.listDirRecur Path Abs Dir
x ReaderT HMGitConfig m ([Path Abs Dir], [Path Abs File])
-> (([Path Abs Dir], [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Path Abs File] -> ReaderT HMGitConfig m [Path Abs File]
forall t. [Path Abs t] -> ReaderT HMGitConfig m [Path Abs t]
excludeDB ([Path Abs File] -> ReaderT HMGitConfig m [Path Abs File])
-> (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
-> ([Path Abs Dir], [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path Abs Dir], [Path Abs File]) -> [Path Abs File]
forall a b. (a, b) -> b
snd ReaderT HMGitConfig m [Path Abs File]
-> ([Path Abs File] -> Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Path Abs File] -> Set (Path Abs File)
forall a. Ord a => [a] -> Set a
S.fromList)
(Set (Path Abs File) -> HMGitT m (Set (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
S.empty)
else
Path Abs Dir
-> ReaderT HMGitConfig m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
P.listDirRecur Path Abs Dir
root
ReaderT HMGitConfig m ([Path Abs Dir], [Path Abs File])
-> (([Path Abs Dir], [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Path Abs File] -> ReaderT HMGitConfig m [Path Abs File]
forall t. [Path Abs t] -> ReaderT HMGitConfig m [Path Abs t]
excludeDB ([Path Abs File] -> ReaderT HMGitConfig m [Path Abs File])
-> (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
-> ([Path Abs Dir], [Path Abs File])
-> ReaderT HMGitConfig m [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path Abs Dir], [Path Abs File]) -> [Path Abs File]
forall a b. (a, b) -> b
snd
ReaderT HMGitConfig m [Path Abs File]
-> ([Path Abs File] -> Set (Path Abs File))
-> HMGitT m (Set (Path Abs File))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Path Abs File] -> Set (Path Abs File)
forall a. Ord a => [a] -> Set a
S.fromList ([Path Abs File] -> Set (Path Abs File))
-> ([Path Abs File] -> [Path Abs File])
-> [Path Abs File]
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> GlobIR -> Bool) -> GlobIR -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> GlobIR -> Bool
G.match GlobIR
ir (String -> Bool)
-> (Path Abs File -> String) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
P.toFilePath)
where
excludeDB :: [Path Abs t] -> ReaderT HMGitConfig m [Path Abs t]
excludeDB = (Path Abs t -> ReaderT HMGitConfig m Bool)
-> [Path Abs t] -> ReaderT HMGitConfig m [Path Abs t]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Path Abs t -> ReaderT HMGitConfig m Bool)
-> [Path Abs t] -> ReaderT HMGitConfig m [Path Abs t])
-> (Path Abs t -> ReaderT HMGitConfig m Bool)
-> [Path Abs t]
-> ReaderT HMGitConfig m [Path Abs t]
forall a b. (a -> b) -> a -> b
$ \Path Abs t
f -> Bool -> Bool
not (Bool -> Bool)
-> ReaderT HMGitConfig m Bool -> ReaderT HMGitConfig m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ReaderT HMGitConfig m Bool] -> ReaderT HMGitConfig m Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM [
Path Abs Dir -> Path Abs t -> Bool
forall b t. Path b Dir -> Path b t -> Bool
P.isProperPrefixOf
(Path Abs Dir -> Path Abs t -> Bool)
-> HMGitT m (Path Abs Dir)
-> ReaderT HMGitConfig m (Path Abs t -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitDBPath
ReaderT HMGitConfig m (Path Abs t -> Bool)
-> ReaderT HMGitConfig m (Path Abs t) -> ReaderT HMGitConfig m Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path Abs t -> ReaderT HMGitConfig m (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs t
f
, Path Abs Dir -> Path Abs t -> Bool
forall b t. Path b Dir -> Path b t -> Bool
P.isProperPrefixOf
(Path Abs Dir -> Path Abs t -> Bool)
-> HMGitT m (Path Abs Dir)
-> ReaderT HMGitConfig m (Path Abs t -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot HMGitT m (Path Abs Dir)
-> (Path Abs Dir -> Path Abs Dir) -> HMGitT m (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> $(P.mkRelDir ".stack-work")))
ReaderT HMGitConfig m (Path Abs t -> Bool)
-> ReaderT HMGitConfig m (Path Abs t) -> ReaderT HMGitConfig m Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path Abs t -> ReaderT HMGitConfig m (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs t
f
, Path Abs Dir -> Path Abs t -> Bool
forall b t. Path b Dir -> Path b t -> Bool
P.isProperPrefixOf
(Path Abs Dir -> Path Abs t -> Bool)
-> HMGitT m (Path Abs Dir)
-> ReaderT HMGitConfig m (Path Abs t -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HMGitT m (Path Abs Dir)
forall (m :: * -> *). Monad m => HMGitT m (Path Abs Dir)
hmGitRoot HMGitT m (Path Abs Dir)
-> (Path Abs Dir -> Path Abs Dir) -> HMGitT m (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> $(P.mkRelDir "test/external")))
ReaderT HMGitConfig m (Path Abs t -> Bool)
-> ReaderT HMGitConfig m (Path Abs t) -> ReaderT HMGitConfig m Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path Abs t -> ReaderT HMGitConfig m (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs t
f
]
lsMatches :: (MonadCatch m, MonadIO m)
=> P.Path P.Abs P.Dir
-> [String]
-> HMGitT m (S.Set (P.Path P.Abs P.File))
lsMatches :: Path Abs Dir -> [String] -> HMGitT m (Set (Path Abs File))
lsMatches Path Abs Dir
cDir = (String -> HMGitT m (Set (Path Abs File)))
-> [String] -> HMGitT m (Set (Path Abs File))
forall (m :: * -> *) w (t :: * -> *) a.
(Monad m, Monoid w, Foldable t) =>
(a -> m w) -> t a -> m w
foldMapM (Path Abs Dir -> String -> HMGitT m (Set (Path Abs File))
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Path Abs Dir -> String -> HMGitT m (Set (Path Abs File))
lsMatch Path Abs Dir
cDir)