ignore (empty) → 0.1.0.0

raw patch · 15 files changed

+571/−0 lines, 15 filesdep +Globdep +HTFdep +basesetup-changed

Dependencies added: Glob, HTF, base, directory, ignore, mtl, path, pcre-heavy, text

Files

• LICENSE +30/−0
• README.md +52/−0
• Setup.hs +2/−0
• app/Main.hs +38/−0
• ignore.cabal +65/−0
• src/Ignore.hs +8/−0
• src/Ignore/Builder.hs +68/−0
• src/Ignore/Core.hs +65/−0
• src/Ignore/Types.hs +33/−0
• src/Ignore/VCS/Darcs.hs +28/−0
• src/Ignore/VCS/Git.hs +26/−0
• src/Ignore/VCS/Mercurial.hs +31/−0
• test/Ignore/VCS/GitSpec.hs +55/−0
• test/Ignore/VCS/MercurialSpec.hs +61/−0
• test/Spec.hs +9/−0

@@ -0,0 +1,30 @@+Copyright (c) 2015 Alexander Thiemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexander Thiemann nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,52 @@+ignore+=====++[![Build Status](https://travis-ci.org/agrafix/ignore.svg)](https://travis-ci.org/agrafix/ignore)++## Intro++Hackage: [ignore](http://hackage.haskell.org/package/ignore)++Library and tiny tool for working with ignore files of different version control systems.++## Library Usage++```haskell+module Main where++import Ignore++import Path+import System.Environment+import System.Directory++main :: IO ()+main =+    do dir <- getCurrentDirectory >>= parseAbsDir+       ignoreFiles <- findIgnoreFiles [VCSGit, VCSMercurial, VCSDarcs] dir+       checker <- buildChecker ignoreFiles+       case checker of+           Left err -> error err+           Right (FileIgnoredChecker isFileIgnored) ->+           	  putStrLn $ +           	    "Main.hs is " +           	    ++ (if isFileIgnored "Main.hs" +           	        then "ignored" else "not ignored")+```++## Commandline Usage++Run in any project under version control to check if a file is ignored or not.++```bash+$ ignore foo~ dist/bar distinct+File foo~ IGNORED+File dist/foo IGNORED+File distinct not ignored+```++## Install++* Using cabal: `cabal install ignore`+* From Source: `git clone https://github.com/agrafix/ignore.git && cd ignore && cabal install`+* Using stack: `git clone https://github.com/agrafix/ignore.git && cd ignore && stack build`

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,38 @@+module Main where++import Ignore++import Path+import System.Environment+import System.Directory++main :: IO ()+main =+    do args <- getArgs+       case args of+         ("--help": _) -> help+         ("-h": _) -> help+         [] -> help+         files -> run files++help :: IO ()+help =+    do putStrLn "The ignore tool"+       putStrLn "(c) 2015 Alexander Thiemann"+       putStrLn ""+       putStrLn "Tiny tool to check if a file in a repo is ignored by a VCS"+       putStrLn ""+       putStrLn "Usage: ignore [--help|-h] file1 file2 file3 ... fileN"++run :: [FilePath] -> IO ()+run files =+    do dir <- getCurrentDirectory >>= parseAbsDir+       ignoreFiles <- findIgnoreFiles [VCSGit, VCSMercurial, VCSDarcs] dir+       case ignoreFiles of+         [] -> putStrLn "No ignore files found. Maybe add one? .gitignore, .hgignore, ...?"+         _ ->+             do checker <- buildChecker ignoreFiles+                case checker of+                  Left err -> putStrLn $ "Failed to handle ignore/boring file: " ++ err+                  Right (FileIgnoredChecker check) ->+                      mapM_ (\f -> putStrLn $ "File " ++ f ++ " " ++ if check f then "IGNORED" else "not ignored") files

@@ -0,0 +1,65 @@+name:                ignore+version:             0.1.0.0+synopsis:            Handle ignore files of different VCSes+description:         Library and tiny tool for working with ignore files of different version control systems+homepage:            http://github.com/agrafix/ignore+license:             BSD3+license-file:        LICENSE+author:              Alexander Thiemann <mail@athiemann.net>+maintainer:          Alexander Thiemann <mail@athiemann.net>+copyright:           (c) 2015 Alexander Thiemann+category:            System+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+                       Ignore+  other-modules:+                       Ignore.Types+                       Ignore.Core+                       Ignore.Builder+                       Ignore.VCS.Git+                       Ignore.VCS.Mercurial+                       Ignore.VCS.Darcs+  build-depends:+                       base >= 4 && < 5,+                       path >= 0.5.1,+                       pcre-heavy >=0.2,+                       Glob >=0.7,+                       text >=1.2.0.4,+                       mtl >=2.1.3.1,+                       directory >= 1.2.1.0+  default-language:    Haskell2010++executable ignore+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:+                       base,+                       ignore,+                       path >= 0.5.1,+                       directory >= 1.2.1.0+  default-language:    Haskell2010++test-suite ignore-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:+                       Ignore.VCS.GitSpec+                       Ignore.VCS.MercurialSpec+  build-depends:+                       base,+                       ignore,+                       text >=1.2.0.4,+                       HTF >=0.12.1+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/agrafix/ignore

@@ -0,0 +1,8 @@+module Ignore+    ( findIgnoreFiles, buildChecker+    , VCS(..), IgnoreFile(..), FileIgnoredChecker(..)+    )+where++import Ignore.Core+import Ignore.Types

@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+module Ignore.Builder+    ( CheckerBuilderT+    , runCheckerBuilder+    , registerGlob, registerGlobGit, registerRegex+    )+where++import Ignore.Types++import Control.Applicative+import Control.Monad.Writer+#if MIN_VERSION_mtl(2,2,0)+import Control.Monad.Except+#else+import Control.Monad.Error+#endif+import Text.Regex.PCRE.Heavy ((=~))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Text.Regex.PCRE.Heavy as Re+import qualified System.FilePath.Glob as G++#if MIN_VERSION_mtl(2,2,0)+type ErrorT = ExceptT+runErrorT :: ExceptT e m a -> m (Either e a)+runErrorT = runExceptT+#endif++newtype CheckerBuilderT m a+    = CheckerBuilderT { unCheckerBuilderT :: ErrorT String (WriterT FileIgnoredChecker m) a }+      deriving (Monad, Functor, Applicative, Alternative, MonadIO, MonadError String)++runCheckerBuilder :: Monad m => CheckerBuilderT m () -> m (Either String FileIgnoredChecker)+runCheckerBuilder cb =+    do (res, out) <- runWriterT (runErrorT $ unCheckerBuilderT cb)+       case res of+         Left err ->+             return $ Left err+         Right () ->+             return $ Right out++registerGlobGit :: Monad m => T.Text -> CheckerBuilderT m ()+registerGlobGit pat+    | not ("/" `T.isInfixOf` pat) =+        do registerGlob pat+           registerGlob ("**/" <> pat <> "/**")+           registerGlob ("**/" <> pat)+    | otherwise = registerGlob pat++registerGlob :: Monad m => T.Text -> CheckerBuilderT m ()+registerGlob globPattern =+    CheckerBuilderT $+    case G.tryCompileWith G.compDefault (T.unpack globPattern) of+      Left err -> throwError ("Failed to compile glob pattern " ++ T.unpack globPattern ++ ": " ++ err)+      Right pat ->+          do let simplified = G.simplify pat+             lift $ tell $ FileIgnoredChecker (G.matchWith G.matchPosix simplified)++registerRegex :: Monad m => T.Text -> CheckerBuilderT m ()+registerRegex rePattern =+    CheckerBuilderT $+    case Re.compileM (T.encodeUtf8 rePattern) [] of+      Left err -> throwError ("Failed to compile regex pattern " ++ T.unpack rePattern ++ ": " ++ err)+      Right pat ->+          lift $ tell $ FileIgnoredChecker (=~ pat)

@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+module Ignore.Core+    ( findIgnoreFiles+    , buildChecker+    )+where++import Ignore.Builder+import Ignore.Types+import qualified Ignore.VCS.Git as Git+import qualified Ignore.VCS.Mercurial as Hg+import qualified Ignore.VCS.Darcs as Darcs++#if MIN_VERSION_base(4,8,0)+#else+import Control.Applicative+#endif+import Control.Monad.Trans+import Data.Maybe+import Path+import System.Directory (doesFileExist)+import qualified Data.Text as T+import qualified Data.Text.IO as T++-- | Get filename of ignore/boring file for a VCS+getVCSFile :: VCS -> Path Rel File+getVCSFile vcs =+    case vcs of+      VCSDarcs -> Darcs.file+      VCSGit -> Git.file+      VCSMercurial -> Hg.file++-- | Search for the ignore/boring files of different VCSes starting a directory+findIgnoreFiles :: [VCS] -> Path Abs Dir -> IO [IgnoreFile]+findIgnoreFiles vcsList rootPath =+    catMaybes <$> mapM seekVcs vcsList+    where+      seekVcs vcs =+          seek vcs rootPath (getVCSFile vcs)+      seek vcs dir file =+          do let full = dir </> file+                 fp = toFilePath full+             isThere <- doesFileExist fp+             if isThere+             then return $ Just (IgnoreFile vcs (Left full))+             else let nextDir = parent dir+                  in if nextDir == dir+                     then return Nothing+                     else seek vcs nextDir file++-- | Build function that checks if a file should be ignored+buildChecker :: [IgnoreFile] -> IO (Either String FileIgnoredChecker)+buildChecker =+    runCheckerBuilder . mapM_ go+    where+      go file =+          do contents <-+                 case if_data file of+                   Left fp -> liftIO $ T.readFile (toFilePath fp)+                   Right t -> return t+             let lns = T.lines contents+             case if_vcs file of+               VCSDarcs -> Darcs.makeChecker lns+               VCSGit -> Git.makeChecker lns+               VCSMercurial -> Hg.makeChecker lns

@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+module Ignore.Types where++#if MIN_VERSION_base(4,8,0)+#else+import Data.Monoid+#endif+import Path+import qualified Data.Text as T++-- | VCS type+data VCS+   = VCSGit+   | VCSMercurial+   | VCSDarcs+   deriving (Show, Eq)++-- | An ignore file+data IgnoreFile+   = IgnoreFile+   { if_vcs :: VCS+   , if_data :: Either (Path Abs File) T.Text+   -- ^ Either a path to a file or an embedded 'T.Text' containing the ignore files data+   } deriving (Show, Eq)++-- | Abstract checker if a file should be ignored+newtype FileIgnoredChecker+    = FileIgnoredChecker { runFileIgnoredChecker :: FilePath -> Bool }++instance Monoid FileIgnoredChecker where+    mempty = FileIgnoredChecker $ const False+    mappend (FileIgnoredChecker a) (FileIgnoredChecker b) =+        FileIgnoredChecker $ \fp -> a fp || b fp

@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}+module Ignore.VCS.Darcs+    ( makeChecker+    , file+    )+where++import Ignore.Builder++import Path+import qualified Data.Text as T++makeChecker :: Monad m => [T.Text] -> CheckerBuilderT m ()+makeChecker = go++file :: Path Rel File+file = $(mkRelDir "_darcs/prefs") </> $(mkRelFile "boring")++go :: Monad m => [T.Text] -> CheckerBuilderT m ()+go [] = return ()+go (x : xs)+    | T.null ln = go xs+    | T.head ln == '#' = go xs+    | otherwise =+        do registerRegex ln+           go xs+    where+      ln = T.strip x

@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Ignore.VCS.Git+    ( makeChecker+    , file+    )+where++import Ignore.Builder++import Path+import qualified Data.Text as T++makeChecker :: Monad m => [T.Text] -> CheckerBuilderT m ()+makeChecker = mapM_ handleLine++file :: Path Rel File+file = $(mkRelFile ".gitignore")++handleLine :: Monad m => T.Text -> CheckerBuilderT m ()+handleLine origLn+    | T.null ln = return ()+    | T.head ln == '#' = return ()+    | otherwise = registerGlobGit ln+    where+      ln = T.strip origLn -- TODO: quoted trailing whitespace

@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Ignore.VCS.Mercurial+    ( makeChecker+    , file+    )+where++import Ignore.Builder++import Path+import qualified Data.Text as T++makeChecker :: Monad m => [T.Text] -> CheckerBuilderT m ()+makeChecker = go registerRegex++file :: Path Rel File+file = $(mkRelFile ".hgignore")++go :: Monad m => (T.Text -> CheckerBuilderT m ()) -> [T.Text] -> CheckerBuilderT m ()+go _ [] = return ()+go register (x : xs)+    | T.null ln = go register xs+    | T.head ln == '#' = go register xs+    | T.toLower ln == "syntax: glob" = go registerGlobGit xs+    | T.toLower ln == "syntax: regexp" = go registerRegex xs+    | otherwise =+        do register ln+           go register xs+    where+      ln = T.strip x

@@ -0,0 +1,55 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+module Ignore.VCS.GitSpec (htf_thisModulesTests) where++import Ignore++import Test.Framework+import qualified Data.Text as T++ignoreFile :: IgnoreFile+ignoreFile =+    IgnoreFile+    { if_vcs = VCSGit+    , if_data =+        Right $+        T.unlines+        [ "# comment"+        , "dist"+        , "cabal-dev"+        , "*.o"+        , "*.hi"+        , "*.chi"+        , "*.chs.h"+        , ".virthualenv"+        , ".DS_Store"+        , ".cabal-sandbox"+        , "cabal.sandbox.config"+        , "*~"+        , ".stack-work"+        ]+    }++getFileIgnoredChecker :: IO (FilePath -> Bool)+getFileIgnoredChecker =+    do ch <- buildChecker [ignoreFile]+       (FileIgnoredChecker f) <- assertRight ch+       return f++test_parserWorks :: IO ()+test_parserWorks =+    do _ <- subAssert getFileIgnoredChecker+       return ()++test_correctNoSlash :: IO ()+test_correctNoSlash =+    do matcher <- subAssert getFileIgnoredChecker+       assertBool (matcher "foo~")+       assertBool (matcher "dist/foo")+       assertBool (matcher "foo/bar~")+       assertBool (matcher "dist")+       assertBool (not $ matcher "distinct")+       assertBool (not $ matcher "src/foo.hs")+       assertBool (matcher "src/foo.hi")+       assertBool (matcher "cabal.sandbox.config")+       assertBool (not $ matcher "Spock.cabal")

@@ -0,0 +1,61 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+module Ignore.VCS.MercurialSpec (htf_thisModulesTests) where++import Ignore++import Test.Framework+import qualified Data.Text as T++ignoreFile :: IgnoreFile+ignoreFile =+    IgnoreFile+    { if_vcs = VCSMercurial+    , if_data =+        Right $+        T.unlines+        [ "# comment"+        , "syntax: glob"+        , "dist"+        , "cabal-dev"+        , "*.o"+        , "*.hi"+        , "*.chi"+        , "*.chs.h"+        , ".virthualenv"+        , ".DS_Store"+        , ".cabal-sandbox"+        , "cabal.sandbox.config"+        , "*~"+        , ".stack-work"+        , "syntax: regexp"+        , ".*\\.aux"+        ]+    }++getFileIgnoredChecker :: IO (FilePath -> Bool)+getFileIgnoredChecker =+    do ch <- buildChecker [ignoreFile]+       (FileIgnoredChecker f) <- assertRight ch+       return f++test_parserWorks :: IO ()+test_parserWorks =+    do _ <- subAssert getFileIgnoredChecker+       return ()++test_correctNoSlash :: IO ()+test_correctNoSlash =+    do matcher <- subAssert getFileIgnoredChecker+       assertBool (matcher "foo~")+       assertBool (matcher "dist/foo")+       assertBool (matcher "foo/bar~")+       assertBool (matcher "dist")+       assertBool (not $ matcher "distinct")+       assertBool (not $ matcher "src/foo.hs")+       assertBool (matcher "src/foo.hi")+       assertBool (matcher "cabal.sandbox.config")+       assertBool (not $ matcher "Spock.cabal")+       assertBool (matcher "test.aux")+       assertBool (matcher "foooa/test.aux")+       assertBool (not $ matcher "auxauxaux")

@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import Test.Framework+import {-@ HTF_TESTS @-} Ignore.VCS.GitSpec+import {-@ HTF_TESTS @-} Ignore.VCS.MercurialSpec++main :: IO ()+main = htfMain htf_importedTests