diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Path IO 1.2.1 + +* Allowed `directory-1.3.0.0`. + +* Added `getXdgDir`. Only available of `directory-1.2.3.0` or later is used. + +* Various cosmetic improvements. + ## Path IO 1.2.0 * Added `walkDir` function to traverse a directory tree with a handler. diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016 Mark Karpov +Copyright © 2016–2017 Mark Karpov All rights reserved. diff --git a/Path/IO.hs b/Path/IO.hs --- a/Path/IO.hs +++ b/Path/IO.hs @@ -1,6 +1,6 @@ -- | -- Module : Path.IO --- Copyright : © 2016 Mark Karpov +-- Copyright : © 2016–2017 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -29,7 +29,7 @@ , copyDirRecur , copyDirRecur' -- ** Walking directory trees - , WalkAction(..) + , WalkAction (..) , walkDir , walkDirAccum -- ** Current working directory @@ -41,6 +41,10 @@ , getAppUserDataDir , getUserDocsDir , getTempDir +#if MIN_VERSION_directory(1,2,3) + , XdgDirectory (..) + , getXdgDir +#endif -- * Path transformation , AbsPath , RelPath @@ -99,7 +103,7 @@ import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) -import Control.Monad.Trans.Writer.Lazy (runWriterT, tell) +import Control.Monad.Trans.Writer.Lazy (execWriterT, tell) import Data.Either (lefts, rights) import Data.List ((\\)) import Data.Time (UTCTime) @@ -107,6 +111,9 @@ import System.IO (Handle) import System.IO.Error (isDoesNotExistError) import System.PosixCompat.Files (deviceID, fileID, getFileStatus) +#if MIN_VERSION_directory(1,2,3) +import System.Directory (XdgDirectory) +#endif import qualified Data.Set as S import qualified System.Directory as D import qualified System.FilePath as F @@ -430,9 +437,10 @@ | WalkExclude [Path Abs Dir] -- ^ List of sub-directories to exclude from -- descending --- | Traverse a directory tree, calling a handler function at each directory --- node traversed. The absolute paths of the parent directory, sub-directories --- and the files in the directory are provided as arguments to the handler. +-- | Traverse a directory tree using depth first pre-order traversal, calling a +-- handler function at each directory node traversed. The absolute paths of the +-- parent directory, sub-directories and the files in the directory are +-- provided as arguments to the handler. -- -- Detects and silently avoids any traversal loops in the directory tree. -- @@ -496,8 +504,7 @@ -- ^ Directory where traversal begins -> m o -- ^ Accumulation of outputs generated by the output writer invocations -walkDirAccum dHandler writer topdir = - liftM snd . runWriterT $ walkDir handler topdir +walkDirAccum dHandler writer topdir = execWriterT $ walkDir handler topdir where handler dir subdirs files = do res <- lift $ writer dir subdirs files @@ -699,6 +706,34 @@ getTempDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) getTempDir = liftIO D.getTemporaryDirectory >>= resolveDir' {-# INLINE getTempDir #-} + +#if MIN_VERSION_directory(1,2,3) +-- | Obtain the paths to special directories for storing user-specific +-- application data, configuration, and cache files, conforming to the +-- . +-- Compared with 'getAppUserDataDir', this function provides a more +-- fine-grained hierarchy as well as greater flexibility for the user. +-- +-- It also works on Windows, although in that case 'XdgData' and 'XdgConfig' +-- will map to the same directory. +-- +-- Note: The directory may not actually exist, in which case you would need +-- to create it with file mode @700@ (i.e. only accessible by the owner). +-- +-- Note also: this is a piece of conditional API, only available if +-- @directory-1.2.3.0@ or later is used. +-- +-- @since 1.2.1 + +getXdgDir :: (MonadIO m, MonadThrow m) + => XdgDirectory -- ^ Which special directory + -> Maybe (Path Rel Dir) + -- ^ A relative path that is appended to the path; if 'Nothing', the + -- base path is returned + -> m (Path Abs Dir) +getXdgDir xdgDir suffix = liftIO (D.getXdgDirectory xdgDir $ maybe "" toFilePath suffix) >>= parseAbsDir +{-# INLINE getXdgDir #-} +#endif ---------------------------------------------------------------------------- -- Path transformation diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,6 +17,6 @@ ## License -Copyright © 2016 Mark Karpov +Copyright © 2016–2017 Mark Karpov Distributed under BSD 3 clause license. diff --git a/path-io.cabal b/path-io.cabal --- a/path-io.cabal +++ b/path-io.cabal @@ -1,7 +1,7 @@ -- -- Cabal configuration for ‘path-io’. -- --- Copyright © 2016 Mark Karpov +-- Copyright © 2016–2017 Mark Karpov -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE. name: path-io -version: 1.2.0 +version: 1.2.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE.md @@ -43,7 +43,7 @@ synopsis: Interface to ‘directory’ package for users of ‘path’ build-type: Simple description: Interface to ‘directory’ package for users of ‘path’. -extra-source-files: CHANGELOG.md +extra-doc-files: CHANGELOG.md , README.md flag dev @@ -54,7 +54,7 @@ library build-depends: base >= 4.7 && < 5.0 , containers - , directory >= 1.2.2.0 && < 1.3 + , directory >= 1.2.2 && < 1.4 , exceptions >= 0.8 && < 0.9 , filepath >= 1.2 && < 1.5 , path >= 0.5 && < 0.6 @@ -81,7 +81,7 @@ , exceptions >= 0.8 && < 0.9 , hspec >= 2.0 && < 3.0 , path >= 0.5 && < 0.6 - , path-io >= 1.2.0 + , path-io >= 1.2.1 , unix-compat default-language: Haskell2010 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,7 +1,7 @@ -- -- Tests for ‘path-io’ package. -- --- Copyright © 2016 Mark Karpov +-- Copyright © 2016–2017 Mark Karpov -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -64,11 +64,16 @@ beforeWith populatedCyclicDir $ describe "listDirRecur Cyclic" listDirRecurCyclicSpec #endif - describe "getCurrentDir" getCurrentDirSpec - describe "setCurrentDir" setCurrentDirSpec - describe "withCurrentDir" withCurrentDirSpec - describe "getHomeDir" getHomeDirSpec - describe "getTempDir" getTempDirSpec + describe "getCurrentDir" getCurrentDirSpec + describe "setCurrentDir" setCurrentDirSpec + describe "withCurrentDir" withCurrentDirSpec + describe "getHomeDir" getHomeDirSpec + describe "getTempDir" getTempDirSpec +#if MIN_VERSION_directory(1,2,3) + describe "getXdgDir Data" getXdgDataDirSpec + describe "getXdgDir Config" getXdgConfigDirSpec + describe "getXdgDir Cache" getXdgCacheDirSpec +#endif listDirSpec :: SpecWith (Path Abs Dir) listDirSpec = it "lists directory" $ \dir -> @@ -191,6 +196,41 @@ getTempDir `shouldReturn` dir unsetEnv evar where evar = "TMPDIR" + +#if MIN_VERSION_directory(1,2,3) +getXdgDataDirSpec :: SpecWith (Path Abs Dir) +getXdgDataDirSpec = + it "XDG data dir is influenced by environment variable XDG_DATA_HOME" $ \dir -> + flip finally (unsetEnv evar) $ do + setEnv evar (toFilePath dir) + getXdgDir XdgData (Just name) `shouldReturn` (dir name) + getXdgDir XdgData Nothing `shouldReturn` dir + unsetEnv evar + where evar = "XDG_DATA_HOME" + name = $(mkRelDir "test") + +getXdgConfigDirSpec :: SpecWith (Path Abs Dir) +getXdgConfigDirSpec = + it "XDG config dir is influenced by environment variable XDG_CONFIG_HOME" $ \dir -> + flip finally (unsetEnv evar) $ do + setEnv evar (toFilePath dir) + getXdgDir XdgConfig (Just name) `shouldReturn` (dir name) + getXdgDir XdgConfig Nothing `shouldReturn` dir + unsetEnv evar + where evar = "XDG_CONFIG_HOME" + name = $(mkRelDir "test") + +getXdgCacheDirSpec :: SpecWith (Path Abs Dir) +getXdgCacheDirSpec = + it "XDG cache dir is influenced by environment variable XDG_CACHE_HOME" $ \dir -> + flip finally (unsetEnv evar) $ do + setEnv evar (toFilePath dir) + getXdgDir XdgCache (Just name) `shouldReturn` (dir name) + getXdgDir XdgCache Nothing `shouldReturn` dir + unsetEnv evar + where evar = "XDG_CACHE_HOME" + name = $(mkRelDir "test") +#endif ---------------------------------------------------------------------------- -- Helpers