{-|
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 `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 `System.XDG.Error.InvalidPath` exception.
-}
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 )
import qualified System.XDG.Internal           as In


{-| Returns the content of @$XDG_DATA_HOME@ or its default value. -}
getDataHome :: IO FilePath
getDataHome :: IO FilePath
getDataHome = Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv (Path Abs Dir)
In.getDataHome

{-| Returns the content of @$XDG_CONFIG_HOME@ or its default value. -}
getConfigHome :: IO FilePath
getConfigHome :: IO FilePath
getConfigHome = Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv (Path Abs Dir)
In.getConfigHome

{-| Returns the content of @$XDG_STATE_HOME@ or its default value. -}
getStateHome :: IO FilePath
getStateHome :: IO FilePath
getStateHome = Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv (Path Abs Dir)
In.getStateHome

{-| Returns the content of @$XDG_CACHE_HOME@ or its default value. -}
getCacheHome :: IO FilePath
getCacheHome :: IO FilePath
getCacheHome = Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv (Path Abs Dir)
In.getCacheHome

{-| Returns the content of @$XDG_RUNTIME_DIR@. -}
getRuntimeDir :: IO FilePath
getRuntimeDir :: IO FilePath
getRuntimeDir = Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv (Path Abs Dir)
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 :: IO [FilePath]
getDataDirs = forall a b. (a -> b) -> [a] -> [b]
map Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv [Path Abs Dir]
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 :: FilePath -> IO (Maybe ByteString)
readDataFile FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. XDGReader a a -> XDGReader a (Maybe a)
In.maybeRead forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
In.readDataFile FilePath
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 :: forall b. Monoid b => (ByteString -> b) -> FilePath -> IO b
readData ByteString -> b
parse FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall b a. Monoid b => (a -> b) -> FilePath -> XDGReader a b
In.readData ByteString -> b
parse FilePath
file

{-| Returns the list of config dirs taken from @$XDG_CONFIG_HOME@ and
@$XDG_CONFIG_DIRS@ or their default values. -}
getConfigDirs :: IO [FilePath]
getConfigDirs :: IO [FilePath]
getConfigDirs = forall a b. (a -> b) -> [a] -> [b]
map Path Abs Dir -> FilePath
fromAbsDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDGWriter ByteString a -> IO a
In.runXDGIO XDGEnv [Path Abs Dir]
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 :: FilePath -> IO (Maybe ByteString)
readConfigFile FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. XDGReader a a -> XDGReader a (Maybe a)
In.maybeRead forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
In.readConfigFile FilePath
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 :: forall b. Monoid b => (ByteString -> b) -> FilePath -> IO b
readConfig ByteString -> b
parse FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall b a. Monoid b => (a -> b) -> FilePath -> XDGReader a b
In.readConfig ByteString -> b
parse FilePath
file

{-| Returns the content of the cache file if it exists.

@
> readCacheFile "subdir/filename"
@
-}
readCacheFile :: FilePath -> IO (Maybe ByteString)
readCacheFile :: FilePath -> IO (Maybe ByteString)
readCacheFile FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. XDGReader a a -> XDGReader a (Maybe a)
In.maybeRead forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
In.readCacheFile FilePath
file

{-| Returns the content of the state file if it exists.

@
> readStateFile "subdir/filename"
@
-}
readStateFile :: FilePath -> IO (Maybe ByteString)
readStateFile :: FilePath -> IO (Maybe ByteString)
readStateFile FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. XDGReader a a -> XDGReader a (Maybe a)
In.maybeRead forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
In.readStateFile FilePath
file

{-| Returns the content of the runtime file if it exists.

@
> readRuntimeFile "subdir/filename"
@
-}
readRuntimeFile :: FilePath -> IO (Maybe ByteString)
readRuntimeFile :: FilePath -> IO (Maybe ByteString)
readRuntimeFile FilePath
file = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. XDGReader a a -> XDGReader a (Maybe a)
In.maybeRead forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
In.readStateFile FilePath
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 :: FilePath -> ByteString -> IO ()
writeConfigFile FilePath
file ByteString
content = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> a -> XDGWriter a ()
In.writeConfigFile FilePath
file ByteString
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 :: FilePath -> ByteString -> IO ()
writeDataFile FilePath
file ByteString
content = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> a -> XDGWriter a ()
In.writeDataFile FilePath
file ByteString
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 :: FilePath -> ByteString -> IO ()
writeCacheFile FilePath
file ByteString
content = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> a -> XDGWriter a ()
In.writeCacheFile FilePath
file ByteString
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 :: FilePath -> ByteString -> IO ()
writeStateFile FilePath
file ByteString
content = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> a -> XDGWriter a ()
In.writeStateFile FilePath
file ByteString
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 :: FilePath -> ByteString -> IO ()
writeRuntimeFile FilePath
file ByteString
content = forall a. XDGWriter ByteString a -> IO a
In.runXDGIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> a -> XDGWriter a ()
In.writeRuntimeFile FilePath
file ByteString
content