xdg-basedir-compliant 1.1.0 → 1.2.0

raw patch · 9 files changed

+286/−159 lines, 9 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README.md +12/−10
• src/System/XDG.hs +74/−5
• src/System/XDG/Env.hs +5/−8
• src/System/XDG/Error.hs +7/−6
• src/System/XDG/FileSystem.hs +53/−28
• src/System/XDG/Internal.hs +70/−48
• test/Spec.hs +60/−51
• xdg-basedir-compliant.cabal +4/−2

@@ -1,4 +1,4 @@-Copyright Pierre Thierry (c) 2017+Copyright Pierre Thierry (c) 2022–2023  All rights reserved. 

@@ -4,18 +4,18 @@  ## Compliance -- [ ] `$XDG_DATA_HOME`+- [X] `$XDG_DATA_HOME`   - [X] get path   - [X] read file-  - [ ] write file-- [ ] `$XDG_CONFIG_HOME`+  - [X] write file+- [X] `$XDG_CONFIG_HOME`   - [X] get path   - [X] read file-  - [ ] write file-- [ ] `$XDG_STATE_HOME`+  - [X] write file+- [X] `$XDG_STATE_HOME`   - [X] get path   - [X] read file-  - [ ] write file+  - [X] write file - [X] `$XDG_DATA_DIRS`   - [X] get path list   - [X] read best file@@ -24,15 +24,17 @@   - [X] get path list   - [X] read best file   - [X] merge files-- [ ] `$XDG_CACHE_HOME`+- [X] `$XDG_CACHE_HOME`   - [X] get path   - [X] read file-  - [ ] write file-- [ ] `$XDG_RUNTIME_DIR`+  - [X] write file+- [X] `$XDG_RUNTIME_DIR`   - [X] get path   - [X] read file-  - [ ] write file+  - [X] write file - [X] treat relative paths as invalid++As this library deals purely with accessing files, I eventually chose not to implement the notion of warning the user when `$XDG_RUNTIME_DIR` isn't set and of providing a replacement directory. Any application where that behaviour would be relevant can use the exception raised by `getRuntimeDir` to detect this problem, should deal with warning the user in its own context, and can set `$XDG_RUNTIME_DIR` with a path that makes sense for that application.  # Build 

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- {-| Module      : System.XDG Description : XDG Basedir functions@@ -8,13 +6,40 @@   When an environment variable is missing that must be defined, they will-raise a `MissingEnv` exception. This applies to @$HOME@ and @$XDG_RUNTIME_DIR@.+raise a `System.XDG.Error.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.+paths. Functions that return a single path will raise an `System.XDG.Error.InvalidPath` exception. -}-module System.XDG where+module System.XDG+  (+  -- * Data+    getDataHome+  , getDataDirs+  , readDataFile+  , readData+  , writeDataFile+  -- * Config+  , getConfigHome+  , getConfigDirs+  , readConfigFile+  , readConfig+  , writeConfigFile+  -- * Cache+  , getCacheHome+  , readCacheFile+  , writeCacheFile+  -- * State+  , getStateHome+  , readStateFile+  , writeStateFile+  -- * Runtime+  -- | The specification says that when @$XDG_RUNTIME_DIR@ isn't set, an application should fall back to a replacement directory and warn users. To that end, `getRuntimeDir` will raise a `System.XDG.Error.MissingEnv` exception when @$XDG_RUNTIME_DIR@ isn't set. The application can then set it to useful value and then use `readRuntimeFile` and `writeRuntimeFile`.+  , getRuntimeDir+  , readRuntimeFile+  , writeRuntimeFile+  ) where  import           Data.ByteString.Lazy           ( ByteString ) import           Path                           ( fromAbsDir )@@ -115,3 +140,47 @@ readRuntimeFile file = In.runXDGIO $ In.maybeRead $ In.readStateFile file  +{-| Writes a config file in the config home if it is writable.++@+> writeConfigFile "subdir/filename" $ BS.pack [1, 2, 3]+@+-}+writeConfigFile :: FilePath -> ByteString -> IO ()+writeConfigFile file content = In.runXDGIO $ In.writeConfigFile file content++{-| Writes a data file in the data home if it is writable.++@+> writeDataFile "subdir/filename" $ BS.pack [1, 2, 3]+@+-}+writeDataFile :: FilePath -> ByteString -> IO ()+writeDataFile file content = In.runXDGIO $ In.writeDataFile file content++{-| Writes a cache file in the cache home if it is writable.++@+> writeCacheFile "subdir/filename" $ BS.pack [1, 2, 3]+@+-}+writeCacheFile :: FilePath -> ByteString -> IO ()+writeCacheFile file content = In.runXDGIO $ In.writeCacheFile file content++{-| Writes a state file in the state home if it is writable.++@+> writeStateFile "subdir/filename" $ BS.pack [1, 2, 3]+@+-}+writeStateFile :: FilePath -> ByteString -> IO ()+writeStateFile file content = In.runXDGIO $ In.writeStateFile file content++{-| Writes a runtime file in the runtime dir if it is writable.++@+> writeRuntimeFile "subdir/filename" $ BS.pack [1, 2, 3]+@+-}+writeRuntimeFile :: FilePath -> ByteString -> IO ()+writeRuntimeFile file content = In.runXDGIO $ In.writeRuntimeFile file content

@@ -1,23 +1,20 @@-{-# LANGUAGE TemplateHaskell, DataKinds #-}-{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TemplateHaskell #-}  module System.XDG.Env where -import           Polysemy-import           System.Environment             ( lookupEnv )-+import Polysemy+import System.Environment (lookupEnv)  data Env m a where-  GetEnv ::String -> Env m (Maybe String)+  GetEnv :: String -> Env m (Maybe String)  makeSem ''Env - type EnvList = [(String, String)]  runEnvList :: EnvList -> InterpreterFor Env r runEnvList envs = interpret (\(GetEnv name) -> pure $ lookup name envs)-  runEnvIO :: Member (Embed IO) r => InterpreterFor Env r runEnvIO = interpret (\(GetEnv name) -> embed $ lookupEnv name)

@@ -1,18 +1,19 @@ module System.XDG.Error where -import           Control.Exception-import           Path-+import Control.Exception+import Path +-- | The type of exceptions raised by this library. data XDGError   = FileNotFound (Path Abs File)   | NoReadableFile-  | MissingEnv String-  | InvalidPath FilePath+  | -- | This exception is raised when an environment variable that should be defined is not. It is not raised when an optional environment variable is not defined.+    MissingEnv String+  | -- | This exception is raised when an invalid file path or a relative path is found instead of a valid absolute path.+    InvalidPath FilePath   deriving (Eq, Show)  instance Exception XDGError-  throwIOLeft :: Exception e => Either e a -> IO a throwIOLeft = either throwIO pure

@@ -1,40 +1,65 @@-{-# LANGUAGE TemplateHaskell, DataKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TemplateHaskell #-}  module System.XDG.FileSystem where -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-import           System.XDG.Error-+import qualified Control.Exception as IO+import qualified Data.ByteString.Lazy as BS+import qualified Data.Map as M+import Path+import Polysemy+import Polysemy.Error+import Polysemy.State (+  State,+  evalState,+  get,+  modify,+ )+import qualified System.IO.Error as IO+import System.XDG.Error  data ReadFile f m a where-  ReadFile ::Path Abs File -> ReadFile f m f+  ReadFile :: Path Abs File -> ReadFile f m f -makeSem ''ReadFile+data WriteFile f m a where+  WriteFile :: Path Abs File -> f -> WriteFile f m () +makeSem ''ReadFile+makeSem ''WriteFile  type FileList a = [(Path Abs File, a)] +type FileMap a = M.Map (Path Abs File) a -runReadFileList-  :: Member (Error XDGError) r => FileList a -> InterpreterFor (ReadFile a) r-runReadFileList files = interpret-  (\(ReadFile path) ->-    maybe (throw $ FileNotFound path) pure $ lookup path files-  )+runReadWriteFileList ::+  Member (Error XDGError) r =>+  FileList a ->+  Sem (ReadFile a ': WriteFile a ': State (FileMap a) ': r) b ->+  Sem r b+runReadWriteFileList files =+  evalState (M.fromList files)+    . interpret (\(WriteFile path content) -> modify (M.insert path content))+    . interpret+      ( \(ReadFile path) -> do+          fileMap <- get+          maybe (throw $ FileNotFound path) pure $ M.lookup path fileMap+      ) -runReadFileIO-  :: Members '[Embed IO , Error XDGError] r-  => InterpreterFor (ReadFile BS.ByteString) r-runReadFileIO = interpret-  (\(ReadFile path) -> do-    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 $ toFilePath path-    either throw pure result-  )+runReadWriteFileIO ::+  Members '[Embed IO, Error XDGError] r =>+  Sem (ReadFile BS.ByteString ': WriteFile BS.ByteString ': r) a ->+  Sem r a+runReadWriteFileIO =+  interpret+    ( \(WriteFile path content) -> do+        result <- embed $ IO.tryJust (notFound path) $ BS.writeFile (toFilePath path) content+        either throw pure result+    )+    . interpret+      ( \(ReadFile path) -> do+          result <- embed $ IO.tryJust (notFound path) $ BS.readFile $ toFilePath path+          either throw pure result+      )+ where+  notFound :: Path Abs File -> IO.IOException -> Maybe XDGError+  notFound path e = if IO.isDoesNotExistError e then Just $ FileNotFound path else Nothing

@@ -1,34 +1,34 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}  module System.XDG.Internal where -import qualified Control.Exception             as IO-import           Data.ByteString.Lazy           ( ByteString )-import           Data.Foldable                  ( fold )-import           Data.List.Split                ( endBy )-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.XDG.Env-import           System.XDG.Error-import           System.XDG.FileSystem-+import qualified Control.Exception as IO+import Data.ByteString.Lazy (ByteString)+import Data.Foldable (fold)+import Data.List.Split (endBy)+import Data.Maybe (+  catMaybes,+  fromMaybe,+ )+import Path (+  Abs,+  Dir,+  File,+  Path,+  Rel,+  mkRelDir,+  parseAbsDir,+  parseRelFile,+  (</>),+ )+import Polysemy+import Polysemy.Error+import Polysemy.Operators+import System.XDG.Env+import System.XDG.Error+import System.XDG.FileSystem+import Prelude hiding (readFile, writeFile)  getDataHome :: XDGEnv (Path Abs Dir) getDataHome = getEnvHome "XDG_DATA_HOME" $(mkRelDir ".local/share")@@ -51,7 +51,7 @@ getDataDirs =   getEnvDirs getDataHome "XDG_DATA_DIRS" ["/usr/local/share/", "/usr/share/"] -readDataFile :: FilePath -> '[Env , Error XDGError , ReadFile a] >@> a+readDataFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a readDataFile = readFileFromDirs getDataDirs  readData :: Monoid b => (a -> b) -> FilePath -> XDGReader a b@@ -75,10 +75,11 @@ readRuntimeFile :: FilePath -> XDGReader a a readRuntimeFile = readFileFromDir getRuntimeDir +type XDGEnv a = '[Env, Error XDGError] >@> a -type XDGEnv a = '[Env , Error XDGError] >@> a+type XDGReader a b = '[Env, Error XDGError, ReadFile a] >@> b -type XDGReader a b = '[Env , Error XDGError , ReadFile a] >@> b+type XDGWriter a b = '[Env, Error XDGError, ReadFile a, WriteFile a] >@> b  requireEnv :: String -> XDGEnv String requireEnv env = maybe (throw $ MissingEnv env) pure =<< getEnv env@@ -86,7 +87,7 @@ requireAbsDir :: FilePath -> (Error XDGError) -@> Path Abs Dir requireAbsDir path = maybe (throw $ InvalidPath path) pure $ parseAbsDir path -requireRelFile :: FilePath -> (Error XDGError) -@> Path  Rel File+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)@@ -95,24 +96,24 @@   maybe getDefault pure dir  where   getDefault = do-    home  <- requireEnv "HOME"+    home <- requireEnv "HOME"     home' <- requireAbsDir home     pure $ home' </> defaultDir -getEnvDirs-  :: (XDGEnv (Path Abs Dir)) -> String -> [String] -> XDGEnv [Path Abs Dir]+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+  dirs <- fromMaybe defaultDirs . noEmpty . fmap (endBy ":") <$> getEnv env   pure $ catMaybes $ userDir : (map parseAbsDir dirs)  where   noEmpty (Just []) = Nothing-  noEmpty x         = x+  noEmpty x = x  readFileFromDir :: XDGEnv (Path Abs Dir) -> FilePath -> XDGReader a a readFileFromDir getDir subPath = do   subFile <- requireRelFile subPath-  dir     <- getDir+  dir <- getDir   readFile $ dir </> subFile  readFileFromDirs :: XDGEnv [Path Abs Dir] -> FilePath -> XDGReader a a@@ -122,24 +123,45 @@   dirs <- getDirs   foldr tryOne (throw NoReadableFile) dirs -appendEnvFiles-  :: Monoid b => XDGEnv [Path Abs Dir] -> (a -> b) -> FilePath -> XDGReader a b+appendEnvFiles ::+  Monoid b => XDGEnv [Path Abs Dir] -> (a -> b) -> FilePath -> XDGReader a b appendEnvFiles getDirs parse subPath = do   subFile <- requireRelFile subPath-  files   <- map (</> subFile) <$> getDirs+  files <- map (</> subFile) <$> getDirs   fold     <$> 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-    err            -> throw err-  )+maybeRead action =+  catch+    (Just <$> action)+    ( \case+        NoReadableFile -> pure Nothing+        err -> throw err+    ) +writeConfigFile :: FilePath -> a -> XDGWriter a ()+writeConfigFile = writeFileToDir getConfigHome -runXDGIO :: XDGReader ByteString a -> IO a+writeDataFile :: FilePath -> a -> XDGWriter a ()+writeDataFile = writeFileToDir getDataHome++writeCacheFile :: FilePath -> a -> XDGWriter a ()+writeCacheFile = writeFileToDir getCacheHome++writeStateFile :: FilePath -> a -> XDGWriter a ()+writeStateFile = writeFileToDir getStateHome++writeRuntimeFile :: FilePath -> a -> XDGWriter a ()+writeRuntimeFile = writeFileToDir getRuntimeDir++writeFileToDir :: XDGEnv (Path Abs Dir) -> FilePath -> a -> XDGWriter a ()+writeFileToDir getDir subPath value = do+  subFile <- requireRelFile subPath+  dir <- getDir+  writeFile (dir </> subFile) value++runXDGIO :: XDGWriter ByteString a -> IO a runXDGIO action = do-  result <- runM $ runError $ runReadFileIO $ runEnvIO action+  result <- runM $ runError $ runReadWriteFileIO $ runEnvIO action   either IO.throwIO pure result

@@ -1,32 +1,31 @@ {-# 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-import           System.XDG.FileSystem-import           System.XDG.Internal-import           Test.Hspec-+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 Polysemy.State+import System.Directory (getCurrentDirectory, removeFile)+import System.Environment (setEnv)+import System.FilePath ((</>))+import qualified System.XDG as XDGIO+import System.XDG.Env+import System.XDG.Error+import System.XDG.FileSystem+import System.XDG.Internal+import Test.Hspec  instance IsString (Path Abs Dir) where   fromString = fromMaybe undefined . parseAbsDir@@ -34,59 +33,55 @@ instance IsString (Path Abs File) where   fromString = fromMaybe undefined . parseAbsFile -- bareEnv :: EnvList bareEnv = [("HOME", "/alice")]  fullEnv :: EnvList fullEnv =-  [ ("HOME"           , "/alice")+  [ ("HOME", "/alice")   , ("XDG_CONFIG_HOME", "/config")-  , ("XDG_DATA_HOME"  , "/data")-  , ("XDG_STATE_HOME" , "/state")-  , ("XDG_CACHE_HOME" , "/cache")+  , ("XDG_DATA_HOME", "/data")+  , ("XDG_STATE_HOME", "/state")+  , ("XDG_CACHE_HOME", "/cache")   , ("XDG_RUNTIME_DIR", "/runtime")   ]  badEnv :: EnvList badEnv =-  [ ("HOME"         , "/alice")+  [ ("HOME", "/alice")   , ("XDG_DATA_HOME", "data/")   , ("XDG_DATA_DIRS", "/foo:./bar:/baz:foo/../bar")   ] - userFiles :: FileList Integer userFiles =-  [ ("/data/foo/bar"   , 1)-  , ("/config/foo/bar" , 10)-  , ("/state/foo/bar"  , 100)-  , ("/cache/foo/bar"  , 200)+  [ ("/data/foo/bar", 1)+  , ("/config/foo/bar", 10)+  , ("/state/foo/bar", 100)+  , ("/cache/foo/bar", 200)   , ("/runtime/foo/bar", 300)   ]  sysFiles :: FileList Integer sysFiles =   [ ("/usr/local/share/foo/bar", 2)-  , ("/usr/share/foo/bar"      , 3)-  , ("/etc/xdg/foo/bar"        , 20)+  , ("/usr/share/foo/bar", 3)+  , ("/etc/xdg/foo/bar", 20)   ]  allFiles :: FileList Integer allFiles = userFiles ++ sysFiles -testXDG-  :: EnvList-  -> FileList Integer-  -> '[Env , ReadFile Integer , Error XDGError] @> a-  -> Either XDGError a-testXDG env files = run . runError . runReadFileList files . runEnvList env+testXDG ::+  EnvList ->+  FileList Integer ->+  '[Env, ReadFile Integer, WriteFile Integer, State (FileMap Integer), Error XDGError] @> a ->+  Either XDGError a+testXDG env files = run . runError . runReadWriteFileList files . runEnvList env  decodeInteger :: ByteString -> Sum Integer decodeInteger = Sum . fromMaybe 0 . decode - main :: IO () main = hspec $ do   describe "XDG" $ do@@ -129,18 +124,32 @@       it "opens a runtime file" $ do         testXDG fullEnv userFiles (readRuntimeFile "foo/bar")           `shouldBe` Right 300+      it "writes a config file" $ do+        testXDG fullEnv userFiles (writeConfigFile "foo/bar" 1000 >> readConfigFile "foo/bar") `shouldBe` Right 1000+      it "writes a data file" $ do+        testXDG fullEnv userFiles (writeDataFile "foo/bar" 2000 >> readDataFile "foo/bar") `shouldBe` Right 2000+      it "writes a cache file" $ do+        testXDG fullEnv userFiles (writeCacheFile "foo/bar" 3000 >> readCacheFile "foo/bar") `shouldBe` Right 3000+      it "writes a state file" $ do+        testXDG fullEnv userFiles (writeStateFile "foo/bar" 4000 >> readStateFile "foo/bar") `shouldBe` Right 4000+      it "writes a runtime file" $ do+        testXDG fullEnv userFiles (writeRuntimeFile "foo/bar" 5000 >> readRuntimeFile "foo/bar") `shouldBe` Right 5000     describe "IO interpreter" $ do       it "opens a data file" $ do         cwd <- getCurrentDirectory         setEnv "XDG_DATA_HOME" $ cwd </> "test/dir1"-        setEnv "XDG_DATA_DIRS" $ intercalate ":" $ map-          (cwd </>)-          ["test/dir2", "test/dir3"]+        setEnv "XDG_DATA_DIRS" $+          intercalate ":" $+            map+              (cwd </>)+              ["test/dir2", "test/dir3"]         (decodeInteger . fromJust)-          <$>            XDGIO.readDataFile "foo/bar.json"+          <$> 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--+      it "writes a data file" $ do+        XDGIO.writeDataFile "foo/quux.json" "4"+        (decodeInteger . fromJust) <$> XDGIO.readDataFile "foo/quux.json" `shouldReturn` 4+        (</> "test/dir1/foo/quux.json") <$> getCurrentDirectory >>= removeFile

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           xdg-basedir-compliant-version:        1.1.0+version:        1.2.0 synopsis:       XDG Basedir description:    See README.md category:       System@@ -13,7 +13,7 @@ bug-reports:    https://github.com/kephas/xdg-basedir-compliant/issues author:         Pierre Thierry maintainer:     pierre@nothos.net-copyright:      2022 Pierre Thierry+copyright:      2022–2023 Pierre Thierry license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -49,6 +49,7 @@   build-depends:       base >=4.7 && <5     , bytestring+    , containers     , directory     , filepath     , path@@ -80,6 +81,7 @@     , aeson     , base >=4.7 && <5     , bytestring+    , containers     , directory     , filepath     , hspec