{-# LANGUAGE DataKinds #-}
{-# 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 System.XDG.Env
import System.XDG.Error
import System.XDG.FileSystem
import Prelude hiding (readFile, writeFile)

getDataHome :: XDGEnv (Path Abs Dir)
getDataHome :: XDGEnv (Path Abs Dir)
getDataHome = String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome String
"XDG_DATA_HOME" $(mkRelDir ".local/share")

getConfigHome :: XDGEnv (Path Abs Dir)
getConfigHome :: XDGEnv (Path Abs Dir)
getConfigHome = String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome String
"XDG_CONFIG_HOME" $(mkRelDir ".config")

getStateHome :: XDGEnv (Path Abs Dir)
getStateHome :: XDGEnv (Path Abs Dir)
getStateHome = String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome String
"XDG_STATE_HOME" $(mkRelDir ".local/state")

getCacheHome :: XDGEnv (Path Abs Dir)
getCacheHome :: XDGEnv (Path Abs Dir)
getCacheHome = String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome String
"XDG_CACHE_HOME" $(mkRelDir ".local/cache")

getRuntimeDir :: XDGEnv (Path Abs Dir)
getRuntimeDir :: XDGEnv (Path Abs Dir)
getRuntimeDir = do
  String
dir <- String -> XDGEnv String
requireEnv String
"XDG_RUNTIME_DIR"
  String -> Error XDGError -@> Path Abs Dir
requireAbsDir String
dir

getDataDirs :: XDGEnv [Path Abs Dir]
getDataDirs :: XDGEnv [Path Abs Dir]
getDataDirs =
  XDGEnv (Path Abs Dir)
-> String -> [String] -> XDGEnv [Path Abs Dir]
getEnvDirs XDGEnv (Path Abs Dir)
getDataHome String
"XDG_DATA_DIRS" [String
"/usr/local/share/", String
"/usr/share/"]

readDataFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readDataFile :: forall a. String -> '[Env, Error XDGError, ReadFile a] >@> a
readDataFile = forall a. XDGEnv [Path Abs Dir] -> String -> XDGReader a a
readFileFromDirs XDGEnv [Path Abs Dir]
getDataDirs

readData :: Monoid b => (a -> b) -> FilePath -> XDGReader a b
readData :: forall b a. Monoid b => (a -> b) -> String -> XDGReader a b
readData = forall b a.
Monoid b =>
XDGEnv [Path Abs Dir] -> (a -> b) -> String -> XDGReader a b
appendEnvFiles XDGEnv [Path Abs Dir]
getDataDirs

getConfigDirs :: XDGEnv [Path Abs Dir]
getConfigDirs :: XDGEnv [Path Abs Dir]
getConfigDirs = XDGEnv (Path Abs Dir)
-> String -> [String] -> XDGEnv [Path Abs Dir]
getEnvDirs XDGEnv (Path Abs Dir)
getConfigHome String
"XDG_CONFIG_DIRS" [String
"/etc/xdg"]

readConfigFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readConfigFile :: forall a. String -> '[Env, Error XDGError, ReadFile a] >@> a
readConfigFile = forall a. XDGEnv [Path Abs Dir] -> String -> XDGReader a a
readFileFromDirs XDGEnv [Path Abs Dir]
getConfigDirs

readConfig :: Monoid b => (a -> b) -> FilePath -> XDGReader a b
readConfig :: forall b a. Monoid b => (a -> b) -> String -> XDGReader a b
readConfig = forall b a.
Monoid b =>
XDGEnv [Path Abs Dir] -> (a -> b) -> String -> XDGReader a b
appendEnvFiles XDGEnv [Path Abs Dir]
getConfigDirs

readStateFile :: FilePath -> XDGReader a a
readStateFile :: forall a. String -> '[Env, Error XDGError, ReadFile a] >@> a
readStateFile = forall a. XDGEnv (Path Abs Dir) -> String -> XDGReader a a
readFileFromDir XDGEnv (Path Abs Dir)
getStateHome

readCacheFile :: FilePath -> XDGReader a a
readCacheFile :: forall a. String -> '[Env, Error XDGError, ReadFile a] >@> a
readCacheFile = forall a. XDGEnv (Path Abs Dir) -> String -> XDGReader a a
readFileFromDir XDGEnv (Path Abs Dir)
getCacheHome

readRuntimeFile :: FilePath -> XDGReader a a
readRuntimeFile :: forall a. String -> '[Env, Error XDGError, ReadFile a] >@> a
readRuntimeFile = forall a. XDGEnv (Path Abs Dir) -> String -> XDGReader a a
readFileFromDir XDGEnv (Path Abs Dir)
getRuntimeDir

type XDGEnv a = '[Env, Error XDGError] >@> a

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 :: String -> XDGEnv String
requireEnv String
env = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ String -> XDGError
MissingEnv String
env) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (r :: EffectRow).
Member Env r =>
String -> Sem r (Maybe String)
getEnv String
env

requireAbsDir :: FilePath -> (Error XDGError) -@> Path Abs Dir
requireAbsDir :: String -> Error XDGError -@> Path Abs Dir
requireAbsDir String
path = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ String -> XDGError
InvalidPath String
path) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir String
path

requireRelFile :: FilePath -> (Error XDGError) -@> Path Rel File
requireRelFile :: String -> Error XDGError -@> Path Rel File
requireRelFile String
path = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ String -> XDGError
InvalidPath String
path) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
path

getEnvHome :: String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome :: String -> Path Rel Dir -> XDGEnv (Path Abs Dir)
getEnvHome String
env Path Rel Dir
defaultDir = do
  Maybe (Path Abs Dir)
dir <- (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member Env r =>
String -> Sem r (Maybe String)
getEnv String
env
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r (Path Abs Dir)
getDefault forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
dir
 where
  getDefault :: Sem r (Path Abs Dir)
getDefault = do
    String
home <- String -> XDGEnv String
requireEnv String
"HOME"
    Path Abs Dir
home' <- String -> Error XDGError -@> Path Abs Dir
requireAbsDir String
home
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
home' forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
defaultDir

getEnvDirs ::
  (XDGEnv (Path Abs Dir)) -> String -> [String] -> XDGEnv [Path Abs Dir]
getEnvDirs :: XDGEnv (Path Abs Dir)
-> String -> [String] -> XDGEnv [Path Abs Dir]
getEnvDirs XDGEnv (Path Abs Dir)
getUserDir String
env [String]
defaultDirs = do
  Maybe (Path Abs Dir)
userDir <- forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XDGEnv (Path Abs Dir)
getUserDir) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
  [String]
dirs <- forall a. a -> Maybe a -> a
fromMaybe [String]
defaultDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe [a] -> Maybe [a]
noEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a] -> [[a]]
endBy String
":") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member Env r =>
String -> Sem r (Maybe String)
getEnv String
env
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ Maybe (Path Abs Dir)
userDir forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir [String]
dirs)
 where
  noEmpty :: Maybe [a] -> Maybe [a]
noEmpty (Just []) = forall a. Maybe a
Nothing
  noEmpty Maybe [a]
x = Maybe [a]
x

readFileFromDir :: XDGEnv (Path Abs Dir) -> FilePath -> XDGReader a a
readFileFromDir :: forall a. XDGEnv (Path Abs Dir) -> String -> XDGReader a a
readFileFromDir XDGEnv (Path Abs Dir)
getDir String
subPath = do
  Path Rel File
subFile <- String -> Error XDGError -@> Path Rel File
requireRelFile String
subPath
  Path Abs Dir
dir <- XDGEnv (Path Abs Dir)
getDir
  forall f (r :: EffectRow).
Member (ReadFile f) r =>
Path Abs File -> Sem r f
readFile forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
subFile

readFileFromDirs :: XDGEnv [Path Abs Dir] -> FilePath -> XDGReader a a
readFileFromDirs :: forall a. XDGEnv [Path Abs Dir] -> String -> XDGReader a a
readFileFromDirs XDGEnv [Path Abs Dir]
getDirs String
subPath = do
  Path Rel File
subFile <- String -> Error XDGError -@> Path Rel File
requireRelFile String
subPath
  let tryOne :: Path Abs Dir -> Sem r a -> Sem r a
tryOne Path Abs Dir
dir Sem r a
next = forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch (forall f (r :: EffectRow).
Member (ReadFile f) r =>
Path Abs File -> Sem r f
readFile forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
subFile) (forall a b. a -> b -> a
const Sem r a
next)
  [Path Abs Dir]
dirs <- XDGEnv [Path Abs Dir]
getDirs
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Path Abs Dir -> Sem r a -> Sem r a
tryOne (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw XDGError
NoReadableFile) [Path Abs Dir]
dirs

appendEnvFiles ::
  Monoid b => XDGEnv [Path Abs Dir] -> (a -> b) -> FilePath -> XDGReader a b
appendEnvFiles :: forall b a.
Monoid b =>
XDGEnv [Path Abs Dir] -> (a -> b) -> String -> XDGReader a b
appendEnvFiles XDGEnv [Path Abs Dir]
getDirs a -> b
parse String
subPath = do
  Path Rel File
subFile <- String -> Error XDGError -@> Path Rel File
requireRelFile String
subPath
  [Path Abs File]
files <- forall a b. (a -> b) -> [a] -> [b]
map (forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
subFile) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XDGEnv [Path Abs Dir]
getDirs
  forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Path Abs File
path -> forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch (a -> b
parse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall f (r :: EffectRow).
Member (ReadFile f) r =>
Path Abs File -> Sem r f
readFile Path Abs File
path) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)) [Path Abs File]
files

maybeRead :: XDGReader a a -> XDGReader a (Maybe a)
maybeRead :: forall a. XDGReader a a -> XDGReader a (Maybe a)
maybeRead XDGReader a a
action =
  forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch
    (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XDGReader a a
action)
    ( \case
        XDGError
NoReadableFile -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        XDGError
err -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw XDGError
err
    )

writeConfigFile :: FilePath -> a -> XDGWriter a ()
writeConfigFile :: forall a. String -> a -> XDGWriter a ()
writeConfigFile = forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getConfigHome

writeDataFile :: FilePath -> a -> XDGWriter a ()
writeDataFile :: forall a. String -> a -> XDGWriter a ()
writeDataFile = forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getDataHome

writeCacheFile :: FilePath -> a -> XDGWriter a ()
writeCacheFile :: forall a. String -> a -> XDGWriter a ()
writeCacheFile = forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getCacheHome

writeStateFile :: FilePath -> a -> XDGWriter a ()
writeStateFile :: forall a. String -> a -> XDGWriter a ()
writeStateFile = forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getStateHome

writeRuntimeFile :: FilePath -> a -> XDGWriter a ()
writeRuntimeFile :: forall a. String -> a -> XDGWriter a ()
writeRuntimeFile = forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getRuntimeDir

writeFileToDir :: XDGEnv (Path Abs Dir) -> FilePath -> a -> XDGWriter a ()
writeFileToDir :: forall a. XDGEnv (Path Abs Dir) -> String -> a -> XDGWriter a ()
writeFileToDir XDGEnv (Path Abs Dir)
getDir String
subPath a
value = do
  Path Rel File
subFile <- String -> Error XDGError -@> Path Rel File
requireRelFile String
subPath
  Path Abs Dir
dir <- XDGEnv (Path Abs Dir)
getDir
  forall f (r :: EffectRow).
Member (WriteFile f) r =>
Path Abs File -> f -> Sem r ()
writeFile (Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
subFile) a
value

runXDGIO :: XDGWriter ByteString a -> IO a
runXDGIO :: forall a. XDGWriter ByteString a -> IO a
runXDGIO XDGWriter ByteString a
action = do
  Either XDGError a
result <- forall (m :: * -> *) a. Monad m => Sem '[Embed m] a -> m a
runM forall a b. (a -> b) -> a -> b
$ forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a.
Members '[Embed IO, Error XDGError] r =>
Sem (ReadFile ByteString : WriteFile ByteString : r) a -> Sem r a
runReadWriteFileIO forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor Env r
runEnvIO XDGWriter ByteString a
action
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
IO.throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure Either XDGError a
result