{-# LANGUAGE TemplateHaskell #-}
{-# 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                     ( 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


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

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
  )


runXDGIO :: XDGReader ByteString a -> IO a
runXDGIO :: forall a. XDGReader ByteString a -> IO a
runXDGIO XDGReader 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).
Members '[Embed IO, Error XDGError] r =>
InterpreterFor (ReadFile ByteString) r
runReadFileIO forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor Env r
runEnvIO XDGReader 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