packages feed

path-io 0.3.1 → 1.0.0

raw patch · 5 files changed

+232/−22 lines, 5 filesdep +hspecdep +path-io

Dependencies added: hspec, path-io

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+## Path IO 1.0.0++* Changed signature of `getAppUserDataDir`, so it takes `String` as the+  first argument.++* Removed deprecated `forgivingAbsence'` function.++* Made `findFile` lazier, it stops searching as soon as a file is found.++* Added some tests.+ ## Path IO 0.3.1  * Introduced synonym for `forgivingAbsence'` —
Path/IO.hs view
@@ -66,7 +66,6 @@   , isLocationOccupied   , forgivingAbsence   , ignoringAbsence-  , forgivingAbsence'     -- * Permissions   , D.Permissions   , D.emptyPermissions@@ -96,7 +95,6 @@ import Data.Either (lefts, rights) import Data.Foldable (foldl') import Data.List ((\\))-import Data.Maybe (listToMaybe) import Data.Time (UTCTime) import Path import System.IO (Handle)@@ -318,8 +316,7 @@   => Path b Dir        -- ^ Directory to list   -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files listDirRecur path = do-  bpath <- makeAbsolute path-  items <- listDir bpath+  items <- listDir path   foldl' mappend items `liftM` mapM listDirRecur (fst items)  -- | Copy directory recursively. This is not smart about symbolic links, but@@ -493,9 +490,9 @@ --   found.  getAppUserDataDir :: (MonadIO m, MonadThrow m)-  => Path Rel Dir      -- ^ A relative path that is appended to the path+  => String            -- ^ Name of application (used in path construction)   -> m (Path Abs Dir)-getAppUserDataDir = (>>= parseAbsDir) . liftD D.getAppUserDataDirectory+getAppUserDataDir = (>>= parseAbsDir) . liftIO . D.getAppUserDataDirectory  -- | Returns the current user's document directory. --@@ -543,9 +540,7 @@ -- * 'UnsupportedOperation' -- The operating system has no notion of temporary directory. ----- * 'isDoesNotExistError'--- The temporary directory for the current user does not exist, or--- cannot be found.+-- The function doesn't verify whether the path exists.  getTempDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) getTempDir = liftIO D.getTemporaryDirectory >>= resolveDir'@@ -597,7 +592,11 @@   -- Similar to 'normalise', an empty path is equivalent to the current   -- directory.   ---  -- /Known bug(s)/: on Windows, the function does not resolve symbolic links.+  -- /Known bug(s)/: on Windows, the function does not resolve symbolic+  -- links.+  --+  -- Please note that before version 1.2.3.0 of @directory@ package, this+  -- function had unpredictable behavior on non-existent paths.    canonicalizePath :: (MonadIO m, MonadThrow m)     => path -> m (AbsPath path)@@ -637,9 +636,7 @@   makeRelativeToCurrentDir p = getCurrentDir >>= flip makeRelative p  -- | Append stringly-typed path to an absolute path and then canonicalize--- it. This can throw the same exceptions as 'canonicalizePath'. In--- particular, 'System.IO.Error.doesNotExistErrorType' is thrown if--- resulting file does not exist and thus its path cannot be canonicalized.+-- it.  resolveFile :: (MonadIO m, MonadThrow m)   => Path Abs Dir      -- ^ Base directory@@ -792,7 +789,13 @@   => [Path b Dir]      -- ^ Set of directories to search in   -> Path Rel File     -- ^ Filename of interest   -> m (Maybe (Path Abs File)) -- ^ Absolute path to file (if found)-findFile dirs file = listToMaybe `liftM` findFiles dirs file+findFile [] _ = return Nothing+findFile (d:ds) file = do+  bfile <- (</> file) `liftM` makeAbsolute d+  exist <- doesFileExist bfile+  if exist+    then return (Just bfile)+    else findFile ds file  -- | Search through the given set of directories for the given file and -- return a list of paths where the given file exists.@@ -973,13 +976,6 @@  ignoringAbsence :: (MonadIO m, MonadCatch m) => m a -> m () ignoringAbsence = liftM (const ()) . forgivingAbsence---- | A synonym for 'ignoringAbsence'.--{-# DEPRECATED forgivingAbsence' "Use 'ignoringAbsence' instead." #-}--forgivingAbsence' :: (MonadIO m, MonadCatch m) => m a -> m ()-forgivingAbsence' = ignoringAbsence  ---------------------------------------------------------------------------- -- Permissions
README.md view
@@ -3,7 +3,9 @@ [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Hackage](https://img.shields.io/hackage/v/path-io.svg?style=flat)](https://hackage.haskell.org/package/path-io) [![Stackage Nightly](http://stackage.org/package/path-io/badge/nightly)](http://stackage.org/nightly/package/path-io)+[![Stackage LTS](http://stackage.org/package/path-io/badge/lts)](http://stackage.org/lts/package/path-io) [![Build Status](https://travis-ci.org/mrkkrp/path-io.svg?branch=master)](https://travis-ci.org/mrkkrp/path-io)+[![Coverage Status](https://coveralls.io/repos/mrkkrp/path-io/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/path-io?branch=master)  This package provides interface to [`directory`](https://hackage.haskell.org/package/directory) package for
path-io.cabal view
@@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE.  name:                 path-io-version:              0.3.1+version:              1.0.0 cabal-version:        >= 1.10 license:              BSD3 license-file:         LICENSE.md@@ -65,6 +65,21 @@     ghc-options:      -Wall -Werror   else     ghc-options:      -O2 -Wall+  default-language:   Haskell2010++test-suite tests+  main-is:            Main.hs+  hs-source-dirs:     tests+  type:               exitcode-stdio-1.0+  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+  build-depends:      base         >= 4.7 && < 5+                    , exceptions   >= 0.8+                    , hspec        >= 2.0+                    , path         >= 0.5+                    , path-io      >= 1.0.0   default-language:   Haskell2010  source-repository head
+ tests/Main.hs view
@@ -0,0 +1,186 @@+--+-- Tests for ‘path-io’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- 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 Mark Karpov nor the names of 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 “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 HOLDERS 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.++{-# LANGUAGE CPP             #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad+import Control.Monad.Catch+import Data.List (sort)+import Path+import Path.IO+import Test.Hspec+import System.Environment++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif++main :: IO ()+main = hspec . around withSandbox $ do+  beforeWith populatedDir $ do+    describe "listDir"      listDirSpec+    describe "listDirRecur" listDirRecurSpec+    describe "copyDirRecur" copyDirRecurSpec+    describe "findFile"     findFileSpec+  describe "getCurrentDir"  getCurrentDirSpec+  describe "setCurrentDir"  setCurrentDirSpec+  describe "withCurrentDir" withCurrentDirSpec+  describe "getHomeDir"     getHomeDirSpec+  describe "getTempDir"     getTempDirSpec++listDirSpec :: SpecWith (Path Abs Dir)+listDirSpec = it "lists directory" $ \dir ->+  getDirStructure listDir dir `shouldReturn` populatedDirTop++listDirRecurSpec :: SpecWith (Path Abs Dir)+listDirRecurSpec = it "lists directory recursively" $ \dir ->+  getDirStructure listDirRecur dir `shouldReturn` populatedDirStructure++copyDirRecurSpec :: SpecWith (Path Abs Dir)+copyDirRecurSpec = it "copies directory" $ \src -> do+  let dest = parent src </> $(mkRelDir "copied-dir")+  copyDirRecur src dest+  old <- getDirStructure listDirRecur src+  new <- getDirStructure listDirRecur dest+  old `shouldBe` new++findFileSpec :: SpecWith (Path Abs Dir)+findFileSpec = it "finds a file lazily" $ \dir -> do+  let relFile = head (snd populatedDirTop)+  found <- findFile (dir : undefined) relFile+  found `shouldBe` Just (dir </> relFile)++getCurrentDirSpec :: SpecWith (Path Abs Dir)+getCurrentDirSpec = it "returns current dir" $ \dir ->+  getCurrentDir `shouldNotReturn` dir++setCurrentDirSpec :: SpecWith (Path Abs Dir)+setCurrentDirSpec = it "sets current dir" $ \dir -> do+  wdir <- getCurrentDir+  setCurrentDir dir+  new  <- getCurrentDir+  setCurrentDir wdir+  new `shouldBe` dir++withCurrentDirSpec :: SpecWith (Path Abs Dir)+withCurrentDirSpec = it "temporarily modifies current dir" $ \dir -> do+  withCurrentDir dir $+    getCurrentDir `shouldReturn` dir+  getCurrentDir `shouldNotReturn` dir++getHomeDirSpec :: SpecWith (Path Abs Dir)+getHomeDirSpec =+  it "home dir is influenced by environment variable HOME" $ \dir ->+    bracket (getEnv evar) (setEnv evar) $ \_ -> do+      setEnv evar (toFilePath dir)+      getHomeDir `shouldReturn` dir+  where evar = "HOME"++getTempDirSpec :: SpecWith (Path Abs Dir)+getTempDirSpec =+  it "temp dir is influenced by environment variable TMPDIR" $ \dir ->+    flip finally (unsetEnv evar) $  do+      setEnv evar (toFilePath dir)+      getTempDir `shouldReturn` dir+      unsetEnv evar+  where evar = "TMPDIR"++----------------------------------------------------------------------------+-- Helpers++-- | Create sandbox directory to model some situation in it and run some+-- tests. Note that we're using new unique sandbox directory for each test+-- case to avoid contamination and it's unconditionally deleted after test+-- case finishes.++withSandbox :: ActionWith (Path Abs Dir) -> IO ()+withSandbox = withSystemTempDir "path-io-sandbox"++-- | Create directory and some sub-directories and files in it. Return path+-- to that directory.+--+-- Created objects are described in 'populatedDirStructure'.++populatedDir :: Path Abs Dir -> IO (Path Abs Dir)+populatedDir root = do+  let (dirs, files) = populatedDirStructure+      pdir          = root </> $(mkRelDir "pdir")+      withinSandbox = (pdir </>)+  ensureDir pdir+  forM_ dirs (ensureDir . withinSandbox)+  forM_ files $ (`writeFile` "") . toFilePath . withinSandbox+  return pdir++-- | Get inner structure of a directory. Items are sorted, so it's easier to+-- compare results.++getDirStructure+  :: (Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File]))+     -- ^ Which function to use for scanning+  -> Path Abs Dir+     -- ^ Path to directory to scan+  -> IO ([Path Rel Dir], [Path Rel File])+getDirStructure f path = do+  (dirs, files) <- f path+  rdirs  <- sort <$> mapM (makeRelative path) dirs+  rfiles <- sort <$> mapM (makeRelative path) files+  return (rdirs, rfiles)++-- | Structure of directory created by the 'populatedDir' function. Please+-- keep it sorted.++populatedDirStructure :: ([Path Rel Dir], [Path Rel File])+populatedDirStructure =+  ( [ $(mkRelDir "a")+    , $(mkRelDir "b")+    , $(mkRelDir "b/c")+    ]+  , [ $(mkRelFile "b/c/three.txt")+    , $(mkRelFile "b/two.txt")+    , $(mkRelFile "one.txt")+    ]+  )++-- | Top-level structure of populated directory as it should be scanned by+-- the 'listDir' function.++populatedDirTop :: ([Path Rel Dir], [Path Rel File])+populatedDirTop =+  ( [ $(mkRelDir "a")+    , $(mkRelDir "b")+    ]+  , [ $(mkRelFile "one.txt")+    ]+  )