diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Change log + +projectile uses [Semantic Versioning][1]. +The change log is available [on GitHub][2]. + +[1]: http://semver.org/spec/v2.0.0.html +[2]: https://github.com/roman/projectile/releases + +## v0.0.0.1 + +* Initially created. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2017, Roman Gonzalez + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,59 @@ +[![Hackage](https://img.shields.io/hackage/v/projectile.svg)](https://img.shields.io/hackage/v/projectile.svg) +[![Stackage LTS](http://stackage.org/package/projectile/badge/lts)](http://stackage.org/lts/package/projectile) +[![Stackage Nightly](http://stackage.org/package/projectile/badge/nightly)](http://stackage.org/nightly/package/projectile) +# Projectile + +> Utility functions to gather information about project directories + +## Table Of Contents + +* [Raison d'etre](#raison-detre) +* [Development](#development) +* [License](#license) + +## Raison d'etre + +Inspired by [bbatsov's](https://github.com/bbatsov/projectile) work, this library was created with +the purpose of reliably access to _project_ resources in a somewhat unified way when developing CLI +tools or [Turtle](https://github.com/Gabriel439/Haskell-Turtle-Library) scripts. + +## Development +[![Build Status](https://travis-ci.org/roman/Haskell-projectile}.svg?branch=master)](https://travis-ci.org/roman/Haskell-projectile) +[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/projectile.svg)](https://http://packdeps.haskellers.com/feed?needle=projectile) +[![Github](https://img.shields.io/github/commits-since/roman/haskell-projectile/v0.0.0.1.svg)](https://img.shields.io/github/commits-since/roman/haskell-projectile/v0.0.0.1.svg) + +This library is intended to be minimal, providing a few functions that work +reliably among many different kind of projects. If you want to contribute, +Pull Request are very welcome! Please try to follow these simple rules: + +* Please create a topic branch for every separate change you make. +* Update the README.md file if necessary. +* Please _do not_ change the version number. + +### Open Commit Bit + +projectile has an open commit bit policy: Anyone with an accepted pull request +gets added as a repository collaborator. Please try to follow these simple +rules: + +* Commit directly onto the master branch only for typos, improvements to the + README and documentation. +* Create a feature branch and open a pull-request early for any new features to + get feedback. +* Make sure you adhere to the general pull request rules above. + +## License + +Copyright (c) 2017, Roman Gonzalez + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/projectile.cabal b/projectile.cabal new file mode 100644 --- /dev/null +++ b/projectile.cabal @@ -0,0 +1,77 @@ +-- This file has been generated from package.yaml by hpack version 0.17.0. +-- +-- see: https://github.com/sol/hpack + +name: projectile +version: 0.0.0.1 +synopsis: Go to README.md +description: Utility functions to gather information about project directories +category: TODO +stability: alpha (experimental) +homepage: https://github.com/roman/Haskell-projectile#readme +bug-reports: https://github.com/roman/Haskell-projectile/issues +author: Roman Gonzalez +maintainer: romanandreg@gmail.com +copyright: © 2017 Roman Gonzalez +license: MIT +license-file: LICENSE +tested-with: GHC==7.10.3 GHC==8.0.1 GHC==8.0.2 +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGELOG.md + README.md + test/fixtures/recurring-mark-file/.svn/.keep + test/fixtures/recurring-mark-file/config/.svn/.keep + test/fixtures/recurring-mark-file/src/.svn/.keep + test/fixtures/recurring-mark-file/src/Foo/.svn/.keep + test/fixtures/recurring-mark-file/src/Foo/Bar/.svn/.keep + test/fixtures/recurring-mark-file/test/.svn/.keep + test/fixtures/top-mark-file/.projectile + +source-repository head + type: git + location: https://github.com/roman/Haskell-projectile + +library + hs-source-dirs: + src + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates + build-depends: + base >=4.8 && <5.0 + , protolude >=0.1 && <0.2 + , text >=1.2 && <1.3 + , deepseq >=1.4 && <2.0 + , safe-exceptions >=0.1 && <0.2 + , path >=0.5 && <0.6 + , path-io >=1.1 && <1.3 + , vector >=0.11 && <1.0 + exposed-modules: + Projectile + other-modules: + Paths_projectile + default-language: Haskell2010 + +test-suite projectile-test + type: exitcode-stdio-1.0 + main-is: TestSuite.hs + hs-source-dirs: + test + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.8 && <5.0 + , protolude >=0.1 && <0.2 + , text >=1.2 && <1.3 + , deepseq >=1.4 && <2.0 + , safe-exceptions >=0.1 && <0.2 + , path >=0.5 && <0.6 + , path-io >=1.1 && <1.3 + , vector >=0.11 && <1.0 + , tasty >=0.11 && <0.12 + , tasty-hunit >=0.9 && <0.10 + , tasty-rerun >=1.1 && <1.2 + , projectile + other-modules: + DocTest + default-language: Haskell2010 diff --git a/src/Projectile.hs b/src/Projectile.hs new file mode 100644 --- /dev/null +++ b/src/Projectile.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- +Module: Projectile + +This module provides utility functions to gather various paths of a project +-} +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 + -- | Error thrown when calling project function from + -- a path that does not not belong to any project + = 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 + +-- | A list of files considered to mark the root of a project. The top-most +-- match has precedence. +projectRootTopLangMarkFiles :: Vector FilePath +projectRootTopLangMarkFiles = + V.fromList + [ + "rebar.config" -- Rebar project file + , "project.clj" -- Leiningen project file + , "build.boot" -- Boot-clj project file + , "SConstruct" -- Scons project file + , "pom.xml" -- Maven project file + , "build.sbt" -- SBT project file + , "gradlew" -- Gradle wrapper script + , "build.gradle" -- Gradle project file + , ".ensime" -- Ensime configuration file + , "Gemfile" -- Bundler file + , "requirements.txt" -- Pip file + , "setup.py" -- Setuptools file + , "tox.ini" -- Tox file + , "composer.json" -- Composer project file + , "Cargo.toml" -- Cargo project file + , "mix.exs" -- Elixir mix project file + , "stack.yaml" -- Haskell's stack tool based project + , "stack.yml" -- Haskell's stack tool based project + , "info.rkt" -- Racket package description file + , "DESCRIPTION" -- R package description file + , "TAGS" -- etags/ctags are usually in the root of project + , "GTAGS" -- GNU Global tags + ] + +-- | A list of files considered to mark the root of a project. The top-most +-- match has precedence. +projectRootTopMarkFiles :: Vector FilePath +projectRootTopMarkFiles = + V.fromList + [ + ".projectile" -- projectile project marker + , ".git" -- Git VCS root dir + , ".hg" -- Mercurial VCS root dir + , ".fslckout" -- Fossil VCS root dir + , "_FOSSIL_" -- Fossil VCS root DB on Windows + , ".bzr" -- Bazaar VCS root dir + , "_darcs" -- Darcs VCS root dir + ] + +-- | A list of files considered to mark the root of a project. This +-- file must be in all sub-directories of a project. +projectRecurringMarkFiles :: Vector FilePath +projectRecurringMarkFiles = + V.fromList + [ + ".svn" -- Svn VCS root dir + , "CVS" -- Csv VCS root dir + , "Makefile" + ] + +-- | Iterate from the current path to parent paths until the match function +-- returns a value for finishing the traversal +locateDominatingFile + :: (MonadIO m, MonadThrow m) + => Path Abs Dir -- ^ Directory to start from + -> (Path Abs Dir -> m WalkAction) -- ^ Match function that will return what to do next on the iteration + -> m (Path Abs Dir) -- ^ The path where the match function returns @WalkFinish@ +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 + +-- | Returns a @WalkAction@ that indicates a finish of iteration when any of the +-- given relative paths is contained on the given directory +doesContainAny + :: MonadIO m + => Vector (Path Rel t) -- ^ Relative path that should be contained in directory input + -> Path b Dir -- ^ Directory path that should contain any of the relative paths + -> 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 + -- return check of parent directory not containing one of the + -- recurring project files + parentContains <- doesContainAny files (parent dir) + if parentContains == WalkFinish then + return WalkContinue + else + return WalkFinish + -- if the path doesn't contain the recurring marking file, then + -- this is not a project that can be recognizable + else + return WalkInvalid + + in do + files <- mapM parseRelFile projectRecurringMarkFiles + locateDominatingFile currentDir (parentDoesNotContainOneOf files) + +-- | Retrieves the root of the current project if available. +-- A @ProjectRootNotFound@ error is returned otherwise. +-- +getProjectRootDir + :: (MonadCatch m, MonadIO m) + => Path Abs Dir -- ^ Directory from where to look the root of the project + -> m (Path Abs Dir) -- ^ Root of the project directory +getProjectRootDir dir = + catch (getDirWithRecurringProjectFile dir) + (\(_ :: ProjectileException) -> getDirWithRootProjectFile dir) diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,7 @@ +module Main where + +import System.FilePath.Glob +import Test.DocTest + +main :: IO () +main = glob "src/**/*.hs" >>= doctest diff --git a/test/TestSuite.hs b/test/TestSuite.hs new file mode 100644 --- /dev/null +++ b/test/TestSuite.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Main where + +import Protolude + +import qualified Data.Text as T + +import Path (reldir, toFilePath, ()) +import Path.IO (getCurrentDir, listDirRecur) + +import Test.Tasty (TestTree, defaultMainWithIngredients, testGroup) +import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.Ingredients.Rerun (rerunningTests) +import Test.Tasty.Runners (consoleTestReporter, listingTests) + +import Projectile (getProjectRootDir) + +main :: IO () +main = + defaultMainWithIngredients + [ rerunningTests [listingTests, consoleTestReporter] ] + (testGroup "all-tests" tests) + +tests :: [TestTree] +tests = + [ + testGroup "getProjectRootDir" getProjectRootDirTests + ] + +-- scTests :: [TestTree] +-- scTests = +-- [ testProperty "inc == succ" prop_succ +-- , testProperty "inc . negate == negate . pred" prop_pred +-- ] + +getProjectRootDirTests :: [TestTree] +getProjectRootDirTests = + [ + testCase "every sub-folder file marker" $ do + root <- getCurrentDir + let + rootDirProject = + root [reldir|test/fixtures/recurring-mark-file|] + + (dirs, _files) <- listDirRecur rootDirProject + forM_ dirs $ \dir -> + unless (".svn/" `T.isSuffixOf` T.pack (toFilePath dir)) $ do + rootDirProject' <- getProjectRootDir dir + assertEqual ("doesn't return the root of the project: " <> show dir) + rootDirProject + rootDirProject' + + , testCase "top level folder marker" $ do + root <- getCurrentDir + let + rootDirProject = + root [reldir|test/fixtures/top-mark-file|] + + (dirs, _files) <- listDirRecur rootDirProject + forM_ dirs $ \dir -> do + rootDirProject' <- getProjectRootDir dir + assertEqual ("doesn't return the root of the project: " <> show dir) + rootDirProject + rootDirProject' + + ] diff --git a/test/fixtures/recurring-mark-file/.svn/.keep b/test/fixtures/recurring-mark-file/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/.svn/.keep diff --git a/test/fixtures/recurring-mark-file/config/.svn/.keep b/test/fixtures/recurring-mark-file/config/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/config/.svn/.keep diff --git a/test/fixtures/recurring-mark-file/src/.svn/.keep b/test/fixtures/recurring-mark-file/src/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/src/.svn/.keep diff --git a/test/fixtures/recurring-mark-file/src/Foo/.svn/.keep b/test/fixtures/recurring-mark-file/src/Foo/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/src/Foo/.svn/.keep diff --git a/test/fixtures/recurring-mark-file/src/Foo/Bar/.svn/.keep b/test/fixtures/recurring-mark-file/src/Foo/Bar/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/src/Foo/Bar/.svn/.keep diff --git a/test/fixtures/recurring-mark-file/test/.svn/.keep b/test/fixtures/recurring-mark-file/test/.svn/.keep new file mode 100644 --- /dev/null +++ b/test/fixtures/recurring-mark-file/test/.svn/.keep diff --git a/test/fixtures/top-mark-file/.projectile b/test/fixtures/top-mark-file/.projectile new file mode 100644 --- /dev/null +++ b/test/fixtures/top-mark-file/.projectile