xdg-basedir-compliant 1.0.2 → 1.1.0

raw patch · 8 files changed

+132/−70 lines, 8 filesdep +directorydep +pathPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, path

API changes (from Hackage documentation)

Files

• CHANGELOG +2/−0
• README.md +1/−1
• src/System/XDG.hs +12/−14
• src/System/XDG/Error.hs +3/−1
• src/System/XDG/FileSystem.hs +4/−3
• src/System/XDG/Internal.hs +68/−47
• test/Spec.hs +35/−2
• xdg-basedir-compliant.cabal +7/−2

@@ -0,0 +1,2 @@+1.1.0+  * BREAKING CHANGE: now relative paths are treated as invalid

@@ -32,7 +32,7 @@   - [X] get path   - [X] read file   - [ ] write file-- [ ] treat relative paths as invalid+- [X] treat relative paths as invalid  # Build 

@@ -9,44 +9,42 @@  When an environment variable is missing that must be defined, they will raise a `MissingEnv` exception. This applies to @$HOME@ and @$XDG_RUNTIME_DIR@.++As per the specification, these functions will treat any relative path in the+environment variables as invalid. They will be skipped when operating on a list of+paths. Functions that return a single path will raise an `InvalidPath` exception. -} module System.XDG where  import           Data.ByteString.Lazy           ( ByteString )-import           Data.Either                    ( fromRight )-import           Polysemy-import           Polysemy.Error                 ( runError )-import           Polysemy.Operators-import           System.XDG.Env-import           System.XDG.Error-import           System.XDG.FileSystem+import           Path                           ( fromAbsDir ) import qualified System.XDG.Internal           as In   {-| Returns the content of @$XDG_DATA_HOME@ or its default value. -} getDataHome :: IO FilePath-getDataHome = In.runXDGIO In.getDataHome+getDataHome = fromAbsDir <$> In.runXDGIO In.getDataHome  {-| Returns the content of @$XDG_CONFIG_HOME@ or its default value. -} getConfigHome :: IO FilePath-getConfigHome = In.runXDGIO In.getConfigHome+getConfigHome = fromAbsDir <$> In.runXDGIO In.getConfigHome  {-| Returns the content of @$XDG_STATE_HOME@ or its default value. -} getStateHome :: IO FilePath-getStateHome = In.runXDGIO In.getStateHome+getStateHome = fromAbsDir <$> In.runXDGIO In.getStateHome  {-| Returns the content of @$XDG_CACHE_HOME@ or its default value. -} getCacheHome :: IO FilePath-getCacheHome = In.runXDGIO In.getCacheHome+getCacheHome = fromAbsDir <$> In.runXDGIO In.getCacheHome  {-| Returns the content of @$XDG_RUNTIME_DIR@. -} getRuntimeDir :: IO FilePath-getRuntimeDir = In.runXDGIO In.getRuntimeDir+getRuntimeDir = fromAbsDir <$> In.runXDGIO In.getRuntimeDir  {-| Returns the list of data dirs taken from @$XDG_DATA_HOME@ and @$XDG_DATA_DIRS@ or their default values. -} getDataDirs :: IO [FilePath]-getDataDirs = In.runXDGIO In.getDataDirs+getDataDirs = map fromAbsDir <$> In.runXDGIO In.getDataDirs  {-| Returns the content of the first readable file in the data dirs if there is one. It will try the files in order of decreasing imporance.@@ -69,7 +67,7 @@ {-| Returns the list of config dirs taken from @$XDG_CONFIG_HOME@ and @$XDG_CONFIG_DIRS@ or their default values. -} getConfigDirs :: IO [FilePath]-getConfigDirs = In.runXDGIO In.getConfigDirs+getConfigDirs = map fromAbsDir <$> In.runXDGIO In.getConfigDirs  {-| Returns the content of the first readable file in the config dirs if there is one. It will try the files in order of decreasing imporance.

@@ -1,12 +1,14 @@ module System.XDG.Error where  import           Control.Exception+import           Path   data XDGError-  = FileNotFound FilePath+  = FileNotFound (Path Abs File)   | NoReadableFile   | MissingEnv String+  | InvalidPath FilePath   deriving (Eq, Show)  instance Exception XDGError

@@ -4,6 +4,7 @@  import qualified Control.Exception             as IO import qualified Data.ByteString.Lazy          as BS+import           Path import           Polysemy import           Polysemy.Error import qualified System.IO.Error               as IO@@ -11,12 +12,12 @@   data ReadFile f m a where-  ReadFile ::FilePath -> ReadFile f m f+  ReadFile ::Path Abs File -> ReadFile f m f  makeSem ''ReadFile  -type FileList a = [(FilePath, a)]+type FileList a = [(Path Abs File, a)]   runReadFileList@@ -34,6 +35,6 @@     let notFound :: IO.IOException -> Maybe XDGError         notFound e =           if IO.isDoesNotExistError e then Just $ FileNotFound path else Nothing-    result <- embed $ IO.tryJust notFound $ BS.readFile path+    result <- embed $ IO.tryJust notFound $ BS.readFile $ toFilePath path     either throw pure result   )

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} @@ -7,35 +8,46 @@ import           Data.ByteString.Lazy           ( ByteString ) import           Data.Foldable                  ( fold ) import           Data.List.Split                ( endBy )-import           Data.Maybe                     ( fromMaybe )+import           Data.Maybe                     ( catMaybes+                                                , fromMaybe+                                                )+import           Path                           ( (</>)+                                                , Abs+                                                , Dir+                                                , File+                                                , Path+                                                , Rel+                                                , mkRelDir+                                                , parseAbsDir+                                                , parseRelFile+                                                ) import           Polysemy import           Polysemy.Error import           Polysemy.Operators import           Prelude                 hiding ( readFile )-import           System.FilePath                ( (</>) )-import qualified System.IO.Error               as IO import           System.XDG.Env import           System.XDG.Error import           System.XDG.FileSystem  -getDataHome :: Env -@> FilePath-getDataHome = getEnvHome "XDG_DATA_HOME" ".local/share"+getDataHome :: XDGEnv (Path Abs Dir)+getDataHome = getEnvHome "XDG_DATA_HOME" $(mkRelDir ".local/share") -getConfigHome :: Env -@> FilePath-getConfigHome = getEnvHome "XDG_CONFIG_HOME" ".config"+getConfigHome :: XDGEnv (Path Abs Dir)+getConfigHome = getEnvHome "XDG_CONFIG_HOME" $(mkRelDir ".config") -getStateHome :: Env -@> FilePath-getStateHome = getEnvHome "XDG_STATE_HOME" ".local/state"+getStateHome :: XDGEnv (Path Abs Dir)+getStateHome = getEnvHome "XDG_STATE_HOME" $(mkRelDir ".local/state") -getCacheHome :: Env -@> FilePath-getCacheHome = getEnvHome "XDG_CACHE_HOME" ".local/cache"+getCacheHome :: XDGEnv (Path Abs Dir)+getCacheHome = getEnvHome "XDG_CACHE_HOME" $(mkRelDir ".local/cache") -getRuntimeDir :: '[Env, Error XDGError] >@> FilePath-getRuntimeDir = maybe (throw $ MissingEnv env) pure =<< getEnv env-  where env = "XDG_RUNTIME_DIR"+getRuntimeDir :: XDGEnv (Path Abs Dir)+getRuntimeDir = do+  dir <- requireEnv "XDG_RUNTIME_DIR"+  requireAbsDir dir -getDataDirs :: Env -@> [FilePath]+getDataDirs :: XDGEnv [Path Abs Dir] getDataDirs =   getEnvDirs getDataHome "XDG_DATA_DIRS" ["/usr/local/share/", "/usr/share/"] @@ -45,7 +57,7 @@ readData :: Monoid b => (a -> b) -> FilePath -> XDGReader a b readData = appendEnvFiles getDataDirs -getConfigDirs :: Env -@> [FilePath]+getConfigDirs :: XDGEnv [Path Abs Dir] getConfigDirs = getEnvDirs getConfigHome "XDG_CONFIG_DIRS" ["/etc/xdg"]  readConfigFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a@@ -64,57 +76,66 @@ readRuntimeFile = readFileFromDir getRuntimeDir  +type XDGEnv a = '[Env , Error XDGError] >@> a+ type XDGReader a b = '[Env , Error XDGError , ReadFile a] >@> b -getUserHome :: Env -@> FilePath-getUserHome = fromMaybe "" <$> getEnv "HOME" --TODO: throw error if no $HOME+requireEnv :: String -> XDGEnv String+requireEnv env = maybe (throw $ MissingEnv env) pure =<< getEnv env -getEnvHome :: String -> FilePath -> Env -@> FilePath-getEnvHome env defaultHome = do-  home <- getUserHome-  fromMaybe (home </> defaultHome) <$> getEnv env+requireAbsDir :: FilePath -> (Error XDGError) -@> Path Abs Dir+requireAbsDir path = maybe (throw $ InvalidPath path) pure $ parseAbsDir path -getEnvDirs :: (Env -@> FilePath) -> String -> [String] -> Env -@> [FilePath]-getEnvDirs getHome env defaultDirs = do-  dirsHome <- getHome-  dirs     <- fromMaybe defaultDirs . noEmpty . fmap (endBy ":") <$> getEnv env-  pure $ dirsHome : dirs+requireRelFile :: FilePath -> (Error XDGError) -@> Path  Rel File+requireRelFile path = maybe (throw $ InvalidPath path) pure $ parseRelFile path++getEnvHome :: String -> Path Rel Dir -> XDGEnv (Path Abs Dir)+getEnvHome env defaultDir = do+  dir <- (>>= parseAbsDir) <$> getEnv env+  maybe getDefault pure dir  where+  getDefault = do+    home  <- requireEnv "HOME"+    home' <- requireAbsDir home+    pure $ home' </> defaultDir++getEnvDirs+  :: (XDGEnv (Path Abs Dir)) -> String -> [String] -> XDGEnv [Path Abs Dir]+getEnvDirs getUserDir env defaultDirs = do+  userDir <- catch (Just <$> getUserDir) (const $ pure Nothing)+  dirs    <- fromMaybe defaultDirs . noEmpty . fmap (endBy ":") <$> getEnv env+  pure $ catMaybes $ userDir : (map parseAbsDir dirs)+ where   noEmpty (Just []) = Nothing   noEmpty x         = x -readFileFromDir-  :: '[Env, Error XDGError] >@> FilePath -> FilePath -> XDGReader a a-readFileFromDir getDir file = do-  dir <- getDir-  readFile $ dir </> file+readFileFromDir :: XDGEnv (Path Abs Dir) -> FilePath -> XDGReader a a+readFileFromDir getDir subPath = do+  subFile <- requireRelFile subPath+  dir     <- getDir+  readFile $ dir </> subFile -readFileFromDirs-  :: Env -@> [FilePath]-  -> FilePath-  -> '[Env , Error XDGError , ReadFile a] >@> a-readFileFromDirs getDirs file = do+readFileFromDirs :: XDGEnv [Path Abs Dir] -> FilePath -> XDGReader a a+readFileFromDirs getDirs subPath = do+  subFile <- requireRelFile subPath+  let tryOne dir next = catch (readFile $ dir </> subFile) (const next)   dirs <- getDirs   foldr tryOne (throw NoReadableFile) dirs-  where tryOne dir next = catch (readFile $ dir </> file) (const next)  appendEnvFiles-  :: Monoid b-  => Env -@> [FilePath]-  -> (a -> b)-  -> FilePath-  -> '[Env , Error XDGError , ReadFile a] >@> b-appendEnvFiles getDirs parse file = do-  files <- map (</> file) <$> getDirs+  :: Monoid b => XDGEnv [Path Abs Dir] -> (a -> b) -> FilePath -> XDGReader a b+appendEnvFiles getDirs parse subPath = do+  subFile <- requireRelFile subPath+  files   <- map (</> subFile) <$> getDirs   fold-    <$> traverse (\file -> catch (parse <$> readFile file) (pure mempty)) files+    <$> traverse (\path -> catch (parse <$> readFile path) (pure mempty)) files  maybeRead :: XDGReader a a -> XDGReader a (Maybe a) maybeRead action = catch   (Just <$> action)   (\case     NoReadableFile -> pure Nothing-    error          -> throw error+    err            -> throw err   )  

@@ -1,15 +1,25 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-} + import           Data.Aeson                     ( decode ) import           Data.ByteString.Lazy           ( ByteString )+import           Data.List                      ( intercalate ) import           Data.Maybe                     ( fromJust                                                 , fromMaybe                                                 ) import           Data.Monoid                    ( Sum(..) )+import           Data.String                    ( IsString(..) )+import           Path                    hiding ( (</>) ) import           Polysemy import           Polysemy.Error import           Polysemy.Operators+import           System.Directory               ( getCurrentDirectory ) import           System.Environment             ( setEnv )+import           System.FilePath                ( (</>) ) import qualified System.XDG                    as XDGIO import           System.XDG.Env import           System.XDG.Error@@ -18,6 +28,14 @@ import           Test.Hspec  +instance IsString (Path Abs Dir) where+  fromString = fromMaybe undefined . parseAbsDir++instance IsString (Path Abs File) where+  fromString = fromMaybe undefined . parseAbsFile+++ bareEnv :: EnvList bareEnv = [("HOME", "/alice")] @@ -31,6 +49,14 @@   , ("XDG_RUNTIME_DIR", "/runtime")   ] +badEnv :: EnvList+badEnv =+  [ ("HOME"         , "/alice")+  , ("XDG_DATA_HOME", "data/")+  , ("XDG_DATA_DIRS", "/foo:./bar:/baz:foo/../bar")+  ]++ userFiles :: FileList Integer userFiles =   [ ("/data/foo/bar"   , 1)@@ -68,6 +94,8 @@       it "finds the data home" $ do         testXDG bareEnv [] getDataHome `shouldBe` Right "/alice/.local/share"         testXDG fullEnv [] getDataHome `shouldBe` Right "/data"+        testXDG badEnv [] getDataDirs+          `shouldBe` Right ["/alice/.local/share", "/foo", "/baz"]       it "finds the config home" $ do         testXDG bareEnv [] getConfigHome `shouldBe` Right "/alice/.config"         testXDG fullEnv [] getConfigHome `shouldBe` Right "/config"@@ -103,11 +131,16 @@           `shouldBe` Right 300     describe "IO interpreter" $ do       it "opens a data file" $ do-        setEnv "XDG_DATA_HOME" "./test/dir1"-        setEnv "XDG_DATA_DIRS" "./test/dir2:./test/dir3"+        cwd <- getCurrentDirectory+        setEnv "XDG_DATA_HOME" $ cwd </> "test/dir1"+        setEnv "XDG_DATA_DIRS" $ intercalate ":" $ map+          (cwd </>)+          ["test/dir2", "test/dir3"]         (decodeInteger . fromJust)           <$>            XDGIO.readDataFile "foo/bar.json"           `shouldReturn` 1       it "merges data files" $ do         XDGIO.readData decodeInteger "foo/bar.json" `shouldReturn` 3         XDGIO.readData decodeInteger "foo/baz.json" `shouldReturn` 30++

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           xdg-basedir-compliant-version:        1.0.2+version:        1.1.0 synopsis:       XDG Basedir description:    See README.md category:       System@@ -19,6 +19,7 @@ build-type:     Simple extra-source-files:     README.md+    CHANGELOG  source-repository head   type: git@@ -44,11 +45,13 @@       RankNTypes       ScopedTypeVariables       TypeOperators-  ghc-options: -fplugin=Polysemy.Plugin+  ghc-options: -Wall -fplugin=Polysemy.Plugin   build-depends:       base >=4.7 && <5     , bytestring+    , directory     , filepath+    , path     , polysemy     , polysemy-plugin     , polysemy-zoo@@ -77,8 +80,10 @@     , aeson     , base >=4.7 && <5     , bytestring+    , directory     , filepath     , hspec+    , path     , polysemy     , polysemy-plugin     , polysemy-zoo