{-# 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 :: Env -@> FilePath
getDataHome = FilePath -> FilePath -> Env -@> FilePath
getEnvHome FilePath
"XDG_DATA_HOME" FilePath
".local/share"

getConfigHome :: Env -@> FilePath
getConfigHome :: Env -@> FilePath
getConfigHome = FilePath -> FilePath -> Env -@> FilePath
getEnvHome FilePath
"XDG_CONFIG_HOME" FilePath
".config"

getStateHome :: Env -@> FilePath
getStateHome :: Env -@> FilePath
getStateHome = FilePath -> FilePath -> Env -@> FilePath
getEnvHome FilePath
"XDG_STATE_HOME" FilePath
".local/state"

getCacheHome :: Env -@> FilePath
getCacheHome :: Env -@> FilePath
getCacheHome = FilePath -> FilePath -> Env -@> FilePath
getEnvHome FilePath
"XDG_CACHE_HOME" FilePath
".local/cache"

getRuntimeDir :: '[Env, Error XDGError] >@> FilePath
getRuntimeDir :: '[Env, Error XDGError] >@> FilePath
getRuntimeDir = 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
$ FilePath -> XDGError
MissingEnv FilePath
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 =>
FilePath -> Sem r (Maybe FilePath)
getEnv FilePath
env
  where env :: FilePath
env = FilePath
"XDG_RUNTIME_DIR"

getDataDirs :: Env -@> [FilePath]
getDataDirs :: Env -@> [FilePath]
getDataDirs =
  (Env -@> FilePath) -> FilePath -> [FilePath] -> Env -@> [FilePath]
getEnvDirs Env -@> FilePath
getDataHome FilePath
"XDG_DATA_DIRS" [FilePath
"/usr/local/share/", FilePath
"/usr/share/"]

readDataFile :: FilePath -> '[Env , Error XDGError , ReadFile a] >@> a
readDataFile :: forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readDataFile = forall a.
(Env -@> [FilePath])
-> FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readFileFromDirs Env -@> [FilePath]
getDataDirs

readData :: Monoid b => (a -> b) -> FilePath -> XDGReader a b
readData :: forall b a. Monoid b => (a -> b) -> FilePath -> XDGReader a b
readData = forall b a.
Monoid b =>
(Env -@> [FilePath])
-> (a -> b) -> FilePath -> '[Env, Error XDGError, ReadFile a] >@> b
appendEnvFiles Env -@> [FilePath]
getDataDirs

getConfigDirs :: Env -@> [FilePath]
getConfigDirs :: Env -@> [FilePath]
getConfigDirs = (Env -@> FilePath) -> FilePath -> [FilePath] -> Env -@> [FilePath]
getEnvDirs Env -@> FilePath
getConfigHome FilePath
"XDG_CONFIG_DIRS" [FilePath
"/etc/xdg"]

readConfigFile :: FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readConfigFile :: forall a. FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readConfigFile = forall a.
(Env -@> [FilePath])
-> FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readFileFromDirs Env -@> [FilePath]
getConfigDirs

readConfig :: Monoid b => (a -> b) -> FilePath -> XDGReader a b
readConfig :: forall b a. Monoid b => (a -> b) -> FilePath -> XDGReader a b
readConfig = forall b a.
Monoid b =>
(Env -@> [FilePath])
-> (a -> b) -> FilePath -> '[Env, Error XDGError, ReadFile a] >@> b
appendEnvFiles Env -@> [FilePath]
getConfigDirs

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

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

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


type XDGReader a b = '[Env , Error XDGError , ReadFile a] >@> b

getUserHome :: Env -@> FilePath
getUserHome :: Env -@> FilePath
getUserHome = forall a. a -> Maybe a -> a
fromMaybe FilePath
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member Env r =>
FilePath -> Sem r (Maybe FilePath)
getEnv FilePath
"HOME" --TODO: throw error if no $HOME

getEnvHome :: String -> FilePath -> Env -@> FilePath
getEnvHome :: FilePath -> FilePath -> Env -@> FilePath
getEnvHome FilePath
env FilePath
defaultHome = do
  FilePath
home <- Env -@> FilePath
getUserHome
  forall a. a -> Maybe a -> a
fromMaybe (FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
defaultHome) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member Env r =>
FilePath -> Sem r (Maybe FilePath)
getEnv FilePath
env

getEnvDirs :: (Env -@> FilePath) -> String -> [String] -> Env -@> [FilePath]
getEnvDirs :: (Env -@> FilePath) -> FilePath -> [FilePath] -> Env -@> [FilePath]
getEnvDirs Env -@> FilePath
getHome FilePath
env [FilePath]
defaultDirs = do
  FilePath
dirsHome <- Env -@> FilePath
getHome
  [FilePath]
dirs     <- forall a. a -> Maybe a -> a
fromMaybe [FilePath]
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 FilePath
":") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member Env r =>
FilePath -> Sem r (Maybe FilePath)
getEnv FilePath
env
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath
dirsHome forall a. a -> [a] -> [a]
: [FilePath]
dirs
 where
  noEmpty :: Maybe [a] -> Maybe [a]
noEmpty (Just []) = forall a. Maybe a
Nothing
  noEmpty Maybe [a]
x         = Maybe [a]
x

readFileFromDir
  :: '[Env, Error XDGError] >@> FilePath -> FilePath -> XDGReader a a
readFileFromDir :: forall a.
('[Env, Error XDGError] >@> FilePath) -> FilePath -> XDGReader a a
readFileFromDir '[Env, Error XDGError] >@> FilePath
getDir FilePath
file = do
  FilePath
dir <- '[Env, Error XDGError] >@> FilePath
getDir
  forall f (r :: EffectRow).
Member (ReadFile f) r =>
FilePath -> Sem r f
readFile forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file

readFileFromDirs
  :: Env -@> [FilePath]
  -> FilePath
  -> '[Env , Error XDGError , ReadFile a] >@> a
readFileFromDirs :: forall a.
(Env -@> [FilePath])
-> FilePath -> '[Env, Error XDGError, ReadFile a] >@> a
readFileFromDirs Env -@> [FilePath]
getDirs FilePath
file = do
  [FilePath]
dirs <- Env -@> [FilePath]
getDirs
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> Sem r a -> Sem r a
tryOne (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw XDGError
NoReadableFile) [FilePath]
dirs
  where tryOne :: FilePath -> Sem r a -> Sem r a
tryOne FilePath
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 =>
FilePath -> Sem r f
readFile forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file) (forall a b. a -> b -> a
const Sem r a
next)

appendEnvFiles
  :: Monoid b
  => Env -@> [FilePath]
  -> (a -> b)
  -> FilePath
  -> '[Env , Error XDGError , ReadFile a] >@> b
appendEnvFiles :: forall b a.
Monoid b =>
(Env -@> [FilePath])
-> (a -> b) -> FilePath -> '[Env, Error XDGError, ReadFile a] >@> b
appendEnvFiles Env -@> [FilePath]
getDirs a -> b
parse FilePath
file = do
  [FilePath]
files <- forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
file) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -@> [FilePath]
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 (\FilePath
file -> 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 =>
FilePath -> Sem r f
readFile FilePath
file) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)) [FilePath]
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
error          -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw XDGError
error
  )


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