module Projectile (getProjectRootDir) where
import Protolude hiding (catch, (<>))
import Control.Exception.Safe (MonadCatch, MonadThrow, catch, throwM)
import Data.Monoid ((<>))
import Data.Vector (Vector)
import Path (Abs, Dir, Path, Rel, parent, parseRelFile, (</>))
import Path.IO (isLocationOccupied)
import qualified Data.Vector as V
data ProjectileException
= ProjectRootNotFound
deriving (Generic, NFData, Show, Eq)
instance Exception ProjectileException
data WalkAction
= WalkFinish
| WalkContinue
| WalkInvalid
deriving (Generic, NFData, Show, Eq)
isRoot :: Path Abs Dir -> Bool
isRoot path =
parent path == path
projectRootTopLangMarkFiles :: Vector FilePath
projectRootTopLangMarkFiles =
V.fromList
[
"rebar.config"
, "project.clj"
, "build.boot"
, "SConstruct"
, "pom.xml"
, "build.sbt"
, "gradlew"
, "build.gradle"
, ".ensime"
, "Gemfile"
, "requirements.txt"
, "setup.py"
, "tox.ini"
, "composer.json"
, "Cargo.toml"
, "mix.exs"
, "stack.yaml"
, "stack.yml"
, "info.rkt"
, "DESCRIPTION"
, "TAGS"
, "GTAGS"
]
projectRootTopMarkFiles :: Vector FilePath
projectRootTopMarkFiles =
V.fromList
[
".projectile"
, ".git"
, ".hg"
, ".fslckout"
, "_FOSSIL_"
, ".bzr"
, "_darcs"
]
projectRecurringMarkFiles :: Vector FilePath
projectRecurringMarkFiles =
V.fromList
[
".svn"
, "CVS"
, "Makefile"
]
locateDominatingFile
:: (MonadIO m, MonadThrow m)
=> Path Abs Dir
-> (Path Abs Dir -> m WalkAction)
-> m (Path Abs Dir)
locateDominatingFile dir continueP
| isRoot dir =
throwM ProjectRootNotFound
| otherwise = do
walkNext <- continueP dir
case walkNext of
WalkInvalid ->
throwM ProjectRootNotFound
WalkFinish ->
return dir
WalkContinue ->
locateDominatingFile (parent dir) continueP
doesContainAny
:: MonadIO m
=> Vector (Path Rel t)
-> Path b Dir
-> m WalkAction
doesContainAny files dir = do
matchesAnyFile <-
(not . V.null . V.dropWhile not)
<$> V.mapM (\file -> isLocationOccupied (dir </> file)) files
if matchesAnyFile then
return WalkFinish
else
return WalkContinue
getDirWithRootProjectFile
:: (MonadIO m, MonadThrow m)
=> Path Abs Dir
-> m (Path Abs Dir)
getDirWithRootProjectFile currentDir = do
files <-
mapM parseRelFile (projectRootTopMarkFiles
<> projectRootTopLangMarkFiles)
locateDominatingFile currentDir (doesContainAny files)
getDirWithRecurringProjectFile
:: (MonadIO m, MonadThrow m)
=> Path Abs Dir
-> m (Path Abs Dir)
getDirWithRecurringProjectFile currentDir =
let
parentDoesNotContainOneOf files dir = do
fileLocated <- doesContainAny files dir
if fileLocated == WalkFinish then do
parentContains <- doesContainAny files (parent dir)
if parentContains == WalkFinish then
return WalkContinue
else
return WalkFinish
else
return WalkInvalid
in do
files <- mapM parseRelFile projectRecurringMarkFiles
locateDominatingFile currentDir (parentDoesNotContainOneOf files)
getProjectRootDir
:: (MonadCatch m, MonadIO m)
=> Path Abs Dir
-> m (Path Abs Dir)
getProjectRootDir dir =
catch (getDirWithRecurringProjectFile dir)
(\(_ :: ProjectileException) -> getDirWithRootProjectFile dir)