packages feed

glob-posix (empty) → 0.1.0.0

raw patch · 9 files changed

+613/−0 lines, 9 filesdep +Globdep +MissingHdep +basesetup-changed

Dependencies added: Glob, MissingH, base, criterion, directory, filepath, glob-posix, tasty, tasty-expected-failure, tasty-hunit, unix

Files

+ LICENSE view
@@ -0,0 +1,202 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright 2016 Reuben D'Netto++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,18 @@+import Criterion.Main+import qualified System.Directory.Glob as GP      -- glob-posix+import qualified System.FilePath.Glob as G        -- Glob+import qualified System.Path.Glob as MH           -- MissingH++main :: IO ()+main = defaultMain [+        bgroup "glob-posix" $ cases (GP.glob GP.globDefaults),+        bgroup "MissingH" $ cases MH.glob,+        bgroup "Glob" $ cases G.glob+    ]+  where+      cases glob = [+              bench "Simple path"     . whnfIO $ glob "/usr/bin",+              bench "Python versions" . whnfIO $ glob "/usr/lib/python?.?",+              bench "Python site"     . whnfIO $ glob "/usr/lib/python?.?/site-packages/test"+          ]+
+ glob-posix.cabal view
@@ -0,0 +1,57 @@+name:                glob-posix+version:             0.1.0.0+synopsis:            Haskell bindings for POSIX glob library.+description:         Wrapper for the glob(3) function. The key functions are glob and globMany.+                     GNU extensions are supported but contained in a different module to encourage portability.+homepage:            https://github.com/rdnetto/glob-posix#readme+license:             Apache+license-file:        LICENSE+author:              Reuben D'Netto+maintainer:          rdnetto@gmail.com+copyright:           2016 Reuben D'Netto+category:            System+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     System.Directory.Glob,+                       System.Directory.Glob.GNU,+                       System.Directory.Glob.GNU.Compat+  other-modules:       System.Directory.Glob.Internal+  build-depends:       base >= 4.7 && < 5+  default-language:    Haskell2010+  ghc-options:         -O2 -Wall++test-suite glob-posix-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base,+                       directory,+                       filepath,+                       glob-posix,+                       tasty,+                       tasty-expected-failure,+                       tasty-hunit,+                       unix+  default-language:    Haskell2010+  ghc-options:         -O2 -Wall++benchmark glob-posix-bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      bench+  main-is:             Bench.hs+  build-depends:       base,+                       criterion,+                       MissingH,+                       Glob,+                       glob-posix+  default-language:    Haskell2010+  ghc-options:         -O2 -Wall+++source-repository head+  type:     git+  location: https://github.com/rdnetto/glob-posix+
+ src/System/Directory/Glob.hsc view
@@ -0,0 +1,113 @@+{-# LANGUAGE ForeignFunctionInterface #-}++{-|+Module      : System.Directory.Glob+Copyright   : (c) Reuben D'Netto 2016+License     : Apache 2.0+Maintainer  : rdnetto@gmail.com+Portability : POSIX++This module provides a wrapper around the <https://linux.die.net/man/3/glob glob(3)> C function, which finds file paths matching a given pattern.+All of the standard flags are supported, though GNU extensions are contained in the "System.Directory.Glob.GNU" module to encourage portability.+-}+module System.Directory.Glob (+    (<>),+    glob,+    globDefaults,+    globMany,+    GlobFlag,+    -- Only export standard flags by default+    globMark,+    globNoCheck,+    globNoEscape,+    globNoSort+    ) where++import Control.Monad (unless, forM_)+import Data.Monoid ((<>))+import Foreign (alloca, peekArray)+import Foreign.C.String (CString, peekCString, withCString)+import Foreign.C.Types (CInt(..))+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable (Storable(..))++import System.Directory.Glob.Internal+#include <glob.h>+++-- Each call to glob() involves String marshalling and return code checking+c_glob' :: Ptr CGlob -> GlobFlag -> String -> IO ()+c_glob' globPtr (GlobFlag f) p = withCString p $ \p' -> do+    errCode <- c_glob p' f nullPtr globPtr++    unless (errCode == 0 || errCode == (#const GLOB_NOMATCH))+        (error $ "glob failed with exit code: " ++ show errCode)++-- | Finds pathnames matching a pattern. e.g @foo*@, @prog_v?@, @ba[zr]@, etc.+glob :: GlobFlag        -- ^ The control flags to apply.+     -> String          -- ^ The pattern.+     -> IO [FilePath]   -- ^ The paths matching the pattern.+glob flags pat = alloca $ \globPtr -> do+    -- Call glob+    c_glob' globPtr flags pat++    -- Unpack results+    CGlob strs <- peek globPtr+    res <- mapM peekCString strs++    -- Cleanup+    c_globfree globPtr+    return res++-- | Like glob, but matches against multiple patterns.+--   This function only allocates and marshals data once, making it more efficient than multiple glob calls.+globMany :: GlobFlag        -- ^ The control flags to apply.+         -> [String]        -- ^ A list of patterns to apply.+         -> IO [FilePath]   -- ^ The paths matching the patterns.+globMany _ [] = return []       -- Need to handle this explicitly, or we'll free an uninitiallized glob_t.+globMany flags (p0:ps) = alloca $ \globPtr -> do+    -- First call to glob must be *without* GLOB_APPEND+    c_glob' globPtr flags p0++    -- Call glob for the remaining patterns with GLOB_APPEND+    forM_ ps . c_glob' globPtr $ flags <> globAppend++    -- Unpack paths+    CGlob strs <- peek globPtr+    res <- mapM peekCString strs++    -- Cleanup+    c_globfree globPtr+    return res++{-+    typedef struct {+        size_t   gl_pathc;    /* Count of paths matched so far  */+        char   **gl_pathv;    /* List of matched pathnames.     */+        size_t   gl_offs;     /* Slots to reserve in gl_pathv.  */+    } glob_t;+-}+newtype CGlob = CGlob [CString]++instance Storable CGlob where+    sizeOf _    = #size glob_t+    alignment _ = #alignment glob_t+    peek ptr = do+        pathC <- (#peek glob_t, gl_pathc) ptr+        pathV <- peekArray pathC  =<< (#peek glob_t, gl_pathv) ptr+        return $ CGlob pathV++    poke _ _ = error "Poke unsupported for CGlob"++-- We don't use this, so its type doesn't matter+type C_ErrorFunc = Ptr ()+++-- int glob(const char *pattern, int flags, int (*errfunc) (const char *epath, int eerrno), glob_t *pglob);+foreign import ccall "glob.h glob"+     c_glob :: CString -> CInt -> C_ErrorFunc -> Ptr CGlob -> IO CInt++-- void globfree(glob_t *pglob);+foreign import ccall "glob.h globfree"+     c_globfree :: Ptr CGlob -> IO ()+
+ src/System/Directory/Glob/GNU.hsc view
@@ -0,0 +1,28 @@+{-|+Module      : System.Directory.Glob.GNU+Copyright   : (c) Reuben D'Netto 2016+License     : Apache 2.0+Maintainer  : rdnetto@gmail.com+Portability : GNU++This module exports 'GlobFlag' values which are only supported on platforms using the GNU implementation of glob.+Using them on non-GNU platforms will result in a compile-time failure.+If you wish to defer the failure to run-time, you should also import "System.Directory.Glob.GNU.Compat".+-}+module System.Directory.Glob.GNU+#ifdef linux_HOST_OS+    (+        globBrace,+        globNoMagic,+        globOnlyDir,+        globPeriod,+        globTilde,+        globTildeCheck+    ) where++import System.Directory.Glob.Internal++#else+    () where++#endif
+ src/System/Directory/Glob/GNU/Compat.hsc view
@@ -0,0 +1,23 @@+{-|+Module      : System.Directory.Glob.GNU.Compat+Copyright   : (c) Reuben D'Netto 2016+License     : Apache 2.0+Maintainer  : rdnetto@gmail.com++On non-GNU platforms, this module exports values for 'GlobFlag' which will throw an exception on use.+They can be used to defer the failure to runtime, when you wish to avoid adding @#ifdef@ checks to your code.+-}+module System.Directory.Glob.GNU.Compat where++#ifndef linux_HOST_OS+import System.Directory.Glob.Internal (GlobFlag)++globBrace, globNoMagic, globOnlyDir, globPeriod, globTilde, globTildeCheck :: GlobFlag+globBrace      = error "Unsupported: GLOB_BRACE is a GNU extension"+globNoMagic    = error "Unsupported: GLOB_NOMAGIC is a GNU extension"+globOnlyDir    = error "Unsupported: GLOB_ONLYDIR is a GNU extension"+globPeriod     = error "Unsupported: GLOB_PERIOD is a GNU extension"+globTilde      = error "Unsupported: GLOB_TILDE is a GNU extension"+globTildeCheck = error "Unsupported: GLOB_TILDE_CHECK is a GNU extension"+#endif+
+ src/System/Directory/Glob/Internal.hsc view
@@ -0,0 +1,56 @@+{-|+Module      : System.Directory.Glob.Internal+Copyright   : (c) Reuben D'Netto 2016+License     : Apache 2.0+Maintainer  : rdnetto@gmail.com+Portability : POSIX+-}+module System.Directory.Glob.Internal where++import Data.Bits ((.|.))+import Data.Monoid ((<>))+import Foreign.C.Types (CInt(..))++#include <glob.h>+++-- | Control flags for glob. Use 'globDefaults' if you have no special requirements.+--   To combine multiple flags, use the '<>' operator (re-exported here for convenience).+--   See <https://linux.die.net/man/3/glob man glob(3)> for more information.+data GlobFlag = GlobFlag !CInt++-- | Default value - equivalent to 0 for the C function.+globDefaults = GlobFlag 0++instance Monoid GlobFlag where+    mempty = globDefaults+    mappend (GlobFlag a) (GlobFlag b) = GlobFlag (a .|. b)+++-- | Used for mutation of an existing structure - for internal use only.+#enum GlobFlag, GlobFlag, GLOB_APPEND+-- | Append a @/@ to each entry that is the path of a directory.+#enum GlobFlag, GlobFlag, GLOB_MARK+-- | If there are no matches, return the original pattern.+#enum GlobFlag, GlobFlag, globNoCheck  = GLOB_NOCHECK+-- | Disable the use of @\@ for escaping metacharacters.+#enum GlobFlag, GlobFlag, globNoEscape = GLOB_NOESCAPE+-- | Do not sort the entries before returning them.+#enum GlobFlag, GlobFlag, globNoSort   = GLOB_NOSORT++-- GNU extensions+#ifdef linux_HOST_OS+-- | Enable CSH-style brace expansion. e.g. foo.{txt,md}. Supports nested braces. (GNU extension)+#enum GlobFlag, GlobFlag, GLOB_BRACE+-- | Enables globNoCheck if the pattern contains no metacharacters. (GNU extension)+#enum GlobFlag, GlobFlag, globNoMagic  = GLOB_NOMAGIC+-- | Only return directories, if it is cheap to do so. (GNU extension)+#enum GlobFlag, GlobFlag, globOnlyDir  = GLOB_ONLYDIR+-- | Allow leading '.' to be matched by metacharacters.+#enum GlobFlag, GlobFlag, GLOB_PERIOD+-- | Substitute home directory for '~' or '~user' prefixes.+#enum GlobFlag, GlobFlag, GLOB_TILDE+-- | Like globTilde, but return no matches if there is no such user.+#enum GlobFlag, GlobFlag, GLOB_TILDE_CHECK+#endif+
+ test/Spec.hs view
@@ -0,0 +1,114 @@+import Control.Exception (bracket_)+import System.Directory+import System.FilePath ((</>))+import System.Info (os)+import System.IO (IOMode(..), withFile)+import System.Posix.User+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit++import System.Directory.Glob+import System.Directory.Glob.GNU+import System.Directory.Glob.GNU.Compat+++main :: IO ()+main = do+    putStrLn $ "\nRunning on " ++ os+    tmp <- getTemporaryDirectory++    -- We only expect Linux to have GNU extensions+    let gnuHandling = if os == "linux"+                         then id+                         else ignoreTest++    defaultMain $ testGroup "Tests" [+        testGroup "POSIX Functionality" (posixTests tmp),+        gnuHandling $ testGroup "GNU Extensions" (gnuTests tmp)+        ]++posixTests :: FilePath -> [TestTree]+posixTests tmp = [+    testCase "Basic case" $+        glob globDefaults "/usr/bin" !@?= ["/usr/bin"],++    testCase "Non-existant path" $+        glob globDefaults "/foo" !@?= [],++    testCase "globMany" . withTempFile "foo" $ \f1 ->+        withTempFile "bar" $ \f2 ->+            globMany globDefaults [tmp </> "foo", tmp </> "bar"] !@?= [f1, f2],++    testCase "GLOB_MARK" $+        glob globMark "/usr/bin" !@?= ["/usr/bin/"],++    testCase "GLOB_NOCHECK" $+        glob globNoCheck "/foo" !@?= ["/foo"],++    testCase "GLOB_ESCAPE" . withTempFile "a?b" $ \f ->+        glob globDefaults (tmp </> "a\\?b") !@?= [f],++    testCase "GLOB_NOESCAPE" . withTempFile "a\\?b" $ \f ->+        glob globNoEscape (tmp </> "a\\?b") !@?= [f]++    ]++gnuTests :: FilePath -> [TestTree]+gnuTests tmp = [+    testCase "GLOB_NOMAGIC" $+        glob globNoMagic "/foo" !@?= ["/foo"],+++    testCase "GLOB_PERIOD" . withTempFile ".ab" $ \f -> do+        glob globDefaults           (tmp </> "?ab") !@?= []+        glob globPeriod (tmp </> "?ab") !@?= [f],++    testCase "GLOB_BRACE" . withTempFile "foo" $ \f1 ->+        withTempFile "far" $ \f2 -> do+            glob globDefaults          (tmp </> "f{oo,ar}") !@?= []+            glob globBrace (tmp </> "f{oo,ar}") !@?= [f1, f2],++    testCase "GLOB_TILDE" $ do+        h <- getHomeDirectory+        user <- getUserName+        glob globDefaults          ('~':user) !@?= []+        glob globTilde ('~':user) !@?= [h]++    ]+++-- Convenience operator that eliminates the need to bind the actual result before asserting it is equal to the expected result+(!@?=) :: (Eq a, Show a) => IO a -> a -> Assertion+(!@?=) x y = do+    x' <- x+    x' @?= y++-- Deterministic temp file creation & deletion+withTempFile :: FilePath -> (FilePath -> IO a) -> IO a+withTempFile f cb = do+    d <- getTemporaryDirectory+    let f' = d </> f+    let createFile fp = withFile fp WriteMode (\_ -> return ())++    bracket_+        (createFile f')+        (removeFile f')+        (cb f')++-- Creates a temporary directory that we can't read from.+-- Used for testing error handling.+withUnreadableDir :: (FilePath -> IO a) -> IO a+withUnreadableDir cb = do+    fp <- (</> "foo") <$> getTemporaryDirectory++    bracket_+        (createDirectory fp >> setPermissions fp emptyPermissions)+        (setPermissions fp emptyPermissions {writable = True} >> removeDirectory fp)+        (cb fp)++-- Gets the username of the current user+-- We can't use getLoginName here because it requires a controlling tty+getUserName :: IO String+getUserName = userName <$> (getUserEntryForID =<< getEffectiveUserID)+