xdg-basedir-compliant (empty) → 1.0.2

raw patch · 9 files changed

+597/−0 lines, 9 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, bytestring, filepath, hspec, polysemy, polysemy-plugin, polysemy-zoo, split, xdg-basedir-compliant

Files

LICENSE +30/−0
README.md +46/−0
src/System/XDG.hs +119/−0
src/System/XDG/Env.hs +23/−0
src/System/XDG/Error.hs +16/−0
src/System/XDG/FileSystem.hs +39/−0
src/System/XDG/Internal.hs +124/−0
test/Spec.hs +113/−0
xdg-basedir-compliant.cabal +87/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Pierre Thierry (c) 2017++All rights reserved.++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 of Pierre Thierry nor the names of other+      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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.

+ README.md view

@@ -0,0 +1,46 @@+# XDG Basedir implementation++This is a compliant implementation of the [XDG Base Directory Specification](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html).++## Compliance++- [ ] `$XDG_DATA_HOME`+  - [X] get path+  - [X] read file+  - [ ] write file+- [ ] `$XDG_CONFIG_HOME`+  - [X] get path+  - [X] read file+  - [ ] write file+- [ ] `$XDG_STATE_HOME`+  - [X] get path+  - [X] read file+  - [ ] write file+- [X] `$XDG_DATA_DIRS`+  - [X] get path list+  - [X] read best file+  - [X] merge files+- [X] `$XDG_CONFIG_DIRS`+  - [X] get path list+  - [X] read best file+  - [X] merge files+- [ ] `$XDG_CACHE_HOME`+  - [X] get path+  - [X] read file+  - [ ] write file+- [ ] `$XDG_RUNTIME_DIR`+  - [X] get path+  - [X] read file+  - [ ] write file+- [ ] treat relative paths as invalid++# Build++You can build the project with:++```+hpack+cabal build+```++If you have Nix installed, `shell.nix` provides an environment with all the needed dependencies. It is suitable for `nix-direnv`.

+ src/System/XDG.hs view

@@ -0,0 +1,119 @@+{-# LANGUAGE DataKinds #-}++{-|+Module      : System.XDG+Description : XDG Basedir functions++These functions implement the [XDG Base Directory Specification](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html).+++When an environment variable is missing that must be defined, they will+raise a `MissingEnv` exception. This applies to @$HOME@ and @$XDG_RUNTIME_DIR@.+-}+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 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++{-| Returns the content of @$XDG_CONFIG_HOME@ or its default value. -}+getConfigHome :: IO FilePath+getConfigHome = In.runXDGIO In.getConfigHome++{-| Returns the content of @$XDG_STATE_HOME@ or its default value. -}+getStateHome :: IO FilePath+getStateHome = In.runXDGIO In.getStateHome++{-| Returns the content of @$XDG_CACHE_HOME@ or its default value. -}+getCacheHome :: IO FilePath+getCacheHome = In.runXDGIO In.getCacheHome++{-| Returns the content of @$XDG_RUNTIME_DIR@. -}+getRuntimeDir :: IO FilePath+getRuntimeDir = 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++{-| 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.+++To read @$XDG_DATA_DIRS\/subdir\/filename@:++@+> readDataFile "subdir/filename"+@+-}+readDataFile :: FilePath -> IO (Maybe ByteString)+readDataFile file = In.runXDGIO $ In.maybeRead $ In.readDataFile file++{-| Parse all readable data files into a monoid and append them.+The append operation will operate left to right in the order of decreasing importance. -}+readData :: Monoid b => (ByteString -> b) -> FilePath -> IO b+readData parse file = In.runXDGIO $ In.readData parse file++{-| 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++{-| 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.+++To read @$XDG_CONFIG_DIRS\/subdir\/filename@:++@+> readConfigFile "subdir/filename"+@+-}+readConfigFile :: FilePath -> IO (Maybe ByteString)+readConfigFile file = In.runXDGIO $ In.maybeRead $ In.readConfigFile file++{-| Parse all readable config files into a monoid and append them.+The append operation will operate left to right in the order of decreasing importance. -}+readConfig :: Monoid b => (ByteString -> b) -> FilePath -> IO b+readConfig parse file = In.runXDGIO $ In.readConfig parse file++{-| Returns the content of the cache file if it exists.++@+> readCacheFile "subdir/filename"+@+-}+readCacheFile :: FilePath -> IO (Maybe ByteString)+readCacheFile file = In.runXDGIO $ In.maybeRead $ In.readCacheFile file++{-| Returns the content of the state file if it exists.++@+> readStateFile "subdir/filename"+@+-}+readStateFile :: FilePath -> IO (Maybe ByteString)+readStateFile file = In.runXDGIO $ In.maybeRead $ In.readStateFile file++{-| Returns the content of the runtime file if it exists.++@+> readRuntimeFile "subdir/filename"+@+-}+readRuntimeFile :: FilePath -> IO (Maybe ByteString)+readRuntimeFile file = In.runXDGIO $ In.maybeRead $ In.readStateFile file++

+ src/System/XDG/Env.hs view

@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell, DataKinds #-}+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}++module System.XDG.Env where++import           Polysemy+import           System.Environment             ( lookupEnv )+++data Env m a where+  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)

+ src/System/XDG/Error.hs view

@@ -0,0 +1,16 @@+module System.XDG.Error where++import           Control.Exception+++data XDGError+  = FileNotFound FilePath+  | NoReadableFile+  | MissingEnv String+  deriving (Eq, Show)++instance Exception XDGError+++throwIOLeft :: Exception e => Either e a -> IO a+throwIOLeft = either throwIO pure

+ src/System/XDG/FileSystem.hs view

@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell, DataKinds #-}++module System.XDG.FileSystem where++import qualified Control.Exception             as IO+import qualified Data.ByteString.Lazy          as BS+import           Polysemy+import           Polysemy.Error+import qualified System.IO.Error               as IO+import           System.XDG.Error+++data ReadFile f m a where+  ReadFile ::FilePath -> ReadFile f m f++makeSem ''ReadFile+++type FileList a = [(FilePath, 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+  )++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 path+    either throw pure result+  )

+ src/System/XDG/Internal.hs view

@@ -0,0 +1,124 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}++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                     ( fromMaybe )+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"++getConfigHome :: Env -@> FilePath+getConfigHome = getEnvHome "XDG_CONFIG_HOME" ".config"++getStateHome :: Env -@> FilePath+getStateHome = getEnvHome "XDG_STATE_HOME" ".local/state"++getCacheHome :: Env -@> FilePath+getCacheHome = getEnvHome "XDG_CACHE_HOME" ".local/cache"++getRuntimeDir :: '[Env, Error XDGError] >@> FilePath+getRuntimeDir = maybe (throw $ MissingEnv env) pure =<< getEnv env+  where env = "XDG_RUNTIME_DIR"++getDataDirs :: Env -@> [FilePath]+getDataDirs =+  getEnvDirs getDataHome "XDG_DATA_DIRS" ["/usr/local/share/", "/usr/share/"]++readDataFile :: FilePath -> '[Env , Error XDGError , ReadFile a] >@> a+readDataFile = readFileFromDirs getDataDirs++readData :: Monoid b => (a -> b) -> FilePath -> XDGReader a b+readData = appendEnvFiles getDataDirs++getConfigDirs :: Env -@> [FilePath]+getConfigDirs = getEnvDirs getConfigHome "XDG_CONFIG_DIRS" ["/etc/xdg"]++readConfigFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a+readConfigFile = readFileFromDirs getConfigDirs++readConfig :: Monoid b => (a -> b) -> FilePath -> XDGReader a b+readConfig = appendEnvFiles getConfigDirs++readStateFile :: FilePath -> XDGReader a a+readStateFile = readFileFromDir getStateHome++readCacheFile :: FilePath -> XDGReader a a+readCacheFile = readFileFromDir getCacheHome++readRuntimeFile :: FilePath -> XDGReader a a+readRuntimeFile = readFileFromDir getRuntimeDir+++type XDGReader a b = '[Env , Error XDGError , ReadFile a] >@> b++getUserHome :: Env -@> FilePath+getUserHome = fromMaybe "" <$> getEnv "HOME" --TODO: throw error if no $HOME++getEnvHome :: String -> FilePath -> Env -@> FilePath+getEnvHome env defaultHome = do+  home <- getUserHome+  fromMaybe (home </> defaultHome) <$> getEnv env++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+ 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++readFileFromDirs+  :: Env -@> [FilePath]+  -> FilePath+  -> '[Env , Error XDGError , ReadFile a] >@> a+readFileFromDirs getDirs file = do+  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+  fold+    <$> traverse (\file -> catch (parse <$> readFile file) (pure mempty)) files++maybeRead :: XDGReader a a -> XDGReader a (Maybe a)+maybeRead action = catch+  (Just <$> action)+  (\case+    NoReadableFile -> pure Nothing+    error          -> throw error+  )+++runXDGIO :: XDGReader ByteString a -> IO a+runXDGIO action = do+  result <- runM $ runError $ runReadFileIO $ runEnvIO action+  either IO.throwIO pure result

+ test/Spec.hs view

@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}++import           Data.Aeson                     ( decode )+import           Data.ByteString.Lazy           ( ByteString )+import           Data.Maybe                     ( fromJust+                                                , fromMaybe+                                                )+import           Data.Monoid                    ( Sum(..) )+import           Polysemy+import           Polysemy.Error+import           Polysemy.Operators+import           System.Environment             ( setEnv )+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+++bareEnv :: EnvList+bareEnv = [("HOME", "/alice")]++fullEnv :: EnvList+fullEnv =+  [ ("HOME"           , "/alice")+  , ("XDG_CONFIG_HOME", "/config")+  , ("XDG_DATA_HOME"  , "/data")+  , ("XDG_STATE_HOME" , "/state")+  , ("XDG_CACHE_HOME" , "/cache")+  , ("XDG_RUNTIME_DIR", "/runtime")+  ]++userFiles :: FileList Integer+userFiles =+  [ ("/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)+  ]++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++decodeInteger :: ByteString -> Sum Integer+decodeInteger = Sum . fromMaybe 0 . decode+++main :: IO ()+main = hspec $ do+  describe "XDG" $ do+    describe "pure interpreter" $ do+      it "finds the data home" $ do+        testXDG bareEnv [] getDataHome `shouldBe` Right "/alice/.local/share"+        testXDG fullEnv [] getDataHome `shouldBe` Right "/data"+      it "finds the config home" $ do+        testXDG bareEnv [] getConfigHome `shouldBe` Right "/alice/.config"+        testXDG fullEnv [] getConfigHome `shouldBe` Right "/config"+      it "finds the state home" $ do+        testXDG bareEnv [] getStateHome `shouldBe` Right "/alice/.local/state"+        testXDG fullEnv [] getStateHome `shouldBe` Right "/state"+      it "opens a data file" $ do+        testXDG fullEnv allFiles (readDataFile "foo/bar") `shouldBe` Right 1+        testXDG fullEnv sysFiles (readDataFile "foo/bar") `shouldBe` Right 2+        testXDG fullEnv allFiles (readDataFile "foo/baz")+          `shouldBe` Left NoReadableFile+        testXDG fullEnv [] (maybeRead $ readDataFile "foo/bar")+          `shouldBe` Right Nothing+      it "merges data files" $ do+        testXDG fullEnv allFiles (readData show "foo/bar")+          `shouldBe` Right "123"+        testXDG fullEnv [] (readData show "foo/bar") `shouldBe` Right ""+      it "opens a config file" $ do+        testXDG fullEnv userFiles (readConfigFile "foo/bar") `shouldBe` Right 10+        testXDG fullEnv sysFiles (readConfigFile "foo/bar") `shouldBe` Right 20+        testXDG fullEnv allFiles (readConfigFile "foo/baz")+          `shouldBe` Left NoReadableFile+      it "merges config files" $ do+        testXDG fullEnv allFiles (readConfig show "foo/bar")+          `shouldBe` Right "1020"+        testXDG fullEnv [] (readConfig show "foo/bar") `shouldBe` Right ""+      it "opens a state file" $ do+        testXDG fullEnv userFiles (readStateFile "foo/bar") `shouldBe` Right 100+      it "opens a cache file" $ do+        testXDG fullEnv userFiles (readCacheFile "foo/bar") `shouldBe` Right 200+      it "opens a runtime file" $ do+        testXDG fullEnv userFiles (readRuntimeFile "foo/bar")+          `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"+        (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

+ xdg-basedir-compliant.cabal view

@@ -0,0 +1,87 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.6.+--+-- see: https://github.com/sol/hpack++name:           xdg-basedir-compliant+version:        1.0.2+synopsis:       XDG Basedir+description:    See README.md+category:       System+homepage:       https://github.com/kephas/xdg-basedir-compliant#readme+bug-reports:    https://github.com/kephas/xdg-basedir-compliant/issues+author:         Pierre Thierry+maintainer:     pierre@nothos.net+copyright:      2022 Pierre Thierry+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/kephas/xdg-basedir-compliant++library+  exposed-modules:+      System.XDG+      System.XDG.Env+      System.XDG.Error+      System.XDG.FileSystem+      System.XDG.Internal+  other-modules:+      Paths_xdg_basedir_compliant+  hs-source-dirs:+      src+  default-extensions:+      BlockArguments+      FlexibleContexts+      GADTs+      LambdaCase+      PolyKinds+      RankNTypes+      ScopedTypeVariables+      TypeOperators+  ghc-options: -fplugin=Polysemy.Plugin+  build-depends:+      base >=4.7 && <5+    , bytestring+    , filepath+    , polysemy+    , polysemy-plugin+    , polysemy-zoo+    , split+  default-language: Haskell2010++test-suite xdg-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_xdg_basedir_compliant+  hs-source-dirs:+      test+  default-extensions:+      BlockArguments+      FlexibleContexts+      GADTs+      LambdaCase+      PolyKinds+      RankNTypes+      ScopedTypeVariables+      TypeOperators+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fplugin=Polysemy.Plugin+  build-depends:+      QuickCheck+    , aeson+    , base >=4.7 && <5+    , bytestring+    , filepath+    , hspec+    , polysemy+    , polysemy-plugin+    , polysemy-zoo+    , split+    , xdg-basedir-compliant+  default-language: Haskell2010