-- |Interpreters for 'PersistPath'
module Ribosome.Interpreter.PersistPath where

import Path (Abs, Dir, Path, Rel, parseRelDir, (</>))
import Path.IO (XdgDirectory (XdgCache), createDirIfMissing, getXdgDir)

import Ribosome.Data.PersistPathError (PersistPathError (Permissions, Undefined))
import Ribosome.Data.PluginName (PluginName (unPluginName))
import Ribosome.Data.SettingError (SettingError)
import qualified Ribosome.Effect.PersistPath as PersistPath
import Ribosome.Effect.PersistPath (PersistPath (PersistPath))
import qualified Ribosome.Effect.Settings as Settings
import Ribosome.Effect.Settings (Settings)
import Ribosome.Host.Data.BootError (BootError)
import Ribosome.PluginName (pluginName)

-- |Append an optional subdir to a dir.
maybeSubdir :: Path b Dir -> Maybe (Path Rel Dir) -> Path b Dir
maybeSubdir :: forall b. Path b Dir -> Maybe (Path Rel Dir) -> Path b Dir
maybeSubdir Path b Dir
root = \case
  Just Path Rel Dir
sub ->
    Path b Dir
root Path b Dir -> Path Rel Dir -> Path b Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
sub
  Maybe (Path Rel Dir)
Nothing ->
    Path b Dir
root

-- |Append an optional subdir to a dir and ensure existence of the resulting directory if 'True' is given.
persistPath ::
  Members [Stop PersistPathError, Embed IO] r =>
  Bool ->
  Path Abs Dir ->
  Maybe (Path Rel Dir) ->
  Sem r (Path Abs Dir)
persistPath :: forall (r :: EffectRow).
Members '[Stop PersistPathError, Embed IO] r =>
Bool
-> Path Abs Dir -> Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
persistPath Bool
create Path Abs Dir
base Maybe (Path Rel Dir)
sub = do
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
create ((Text -> PersistPathError) -> IO () -> Sem r ()
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryAny (PersistPathError -> Text -> PersistPathError
forall a b. a -> b -> a
const (Path Abs Dir -> PersistPathError
Permissions Path Abs Dir
path)) (Bool -> Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True Path Abs Dir
path))
  pure Path Abs Dir
path
  where
    path :: Path Abs Dir
path =
      Path Abs Dir -> Maybe (Path Rel Dir) -> Path Abs Dir
forall b. Path b Dir -> Maybe (Path Rel Dir) -> Path b Dir
maybeSubdir Path Abs Dir
base Maybe (Path Rel Dir)
sub

-- |Interpret 'PersistPath' by using the specified root directory.
interpretPersistPathAt ::
  Member (Embed IO) r =>
  Bool ->
  Path Abs Dir ->
  InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPathAt :: forall (r :: EffectRow).
Member (Embed IO) r =>
Bool
-> Path Abs Dir
-> InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPathAt Bool
create Path Abs Dir
base =
  (forall x (r0 :: EffectRow).
 PersistPath (Sem r0) x -> Sem (Stop PersistPathError : r) x)
-> InterpreterFor (PersistPath !! PersistPathError) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    PersistPath Maybe (Path Rel Dir)
sub ->
      Bool
-> Path Abs Dir
-> Maybe (Path Rel Dir)
-> Sem (Stop PersistPathError : r) (Path Abs Dir)
forall (r :: EffectRow).
Members '[Stop PersistPathError, Embed IO] r =>
Bool
-> Path Abs Dir -> Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
persistPath Bool
create Path Abs Dir
base Maybe (Path Rel Dir)
sub

-- |Look up the XDG cache directory, returning 'Nothing' if it is unavailable.
xdgCache ::
  Member (Embed IO) r =>
  Sem r (Maybe (Path Abs Dir))
xdgCache :: forall (r :: EffectRow).
Member (Embed IO) r =>
Sem r (Maybe (Path Abs Dir))
xdgCache =
  Either Text (Path Abs Dir) -> Maybe (Path Abs Dir)
forall l r. Either l r -> Maybe r
rightToMaybe (Either Text (Path Abs Dir) -> Maybe (Path Abs Dir))
-> Sem r (Either Text (Path Abs Dir))
-> Sem r (Maybe (Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Path Abs Dir) -> Sem r (Either Text (Path Abs Dir))
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (XdgDirectory -> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
getXdgDir XdgDirectory
XdgCache Maybe (Path Rel Dir)
forall a. Maybe a
Nothing)

-- |Interpret 'PersistPath' by reading the global setting for the root directory, or using the given directory if the
-- variable is unset.
--
-- The given @name@ is appended to the root, which usually identifies the plugin.
interpretPersistPathSetting ::
  Members [Settings !! SettingError, Embed IO] r =>
  Bool ->
  Maybe (Path Abs Dir) ->
  Path Rel Dir ->
  InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPathSetting :: forall (r :: EffectRow).
Members '[Settings !! SettingError, Embed IO] r =>
Bool
-> Maybe (Path Abs Dir)
-> Path Rel Dir
-> InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPathSetting Bool
create Maybe (Path Abs Dir)
fallback Path Rel Dir
name =
  (forall x (r0 :: EffectRow).
 PersistPath (Sem r0) x -> Sem (Stop PersistPathError : r) x)
-> InterpreterFor (PersistPath !! PersistPathError) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    PersistPath Maybe (Path Rel Dir)
sub -> do
      Path Abs Dir
base <- PersistPathError
-> Maybe (Path Abs Dir)
-> Sem (Stop PersistPathError : r) (Path Abs Dir)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote PersistPathError
Undefined (Maybe (Path Abs Dir)
 -> Sem (Stop PersistPathError : r) (Path Abs Dir))
-> (Maybe (Path Abs Dir) -> Maybe (Path Abs Dir))
-> Maybe (Path Abs Dir)
-> Sem (Stop PersistPathError : r) (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Path Abs Dir)
-> Maybe (Path Abs Dir) -> Maybe (Path Abs Dir)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Path Abs Dir)
fallback) (Maybe (Path Abs Dir)
 -> Sem (Stop PersistPathError : r) (Path Abs Dir))
-> Sem (Stop PersistPathError : r) (Maybe (Path Abs Dir))
-> Sem (Stop PersistPathError : r) (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Setting (Path Abs Dir)
-> Sem (Stop PersistPathError : r) (Maybe (Path Abs Dir))
forall a (r :: EffectRow).
(MsgpackDecode a, Member (Settings !! SettingError) r) =>
Setting a -> Sem r (Maybe a)
Settings.maybe Setting (Path Abs Dir)
PersistPath.setting
      Bool
-> Path Abs Dir
-> Maybe (Path Rel Dir)
-> Sem (Stop PersistPathError : r) (Path Abs Dir)
forall (r :: EffectRow).
Members '[Stop PersistPathError, Embed IO] r =>
Bool
-> Path Abs Dir -> Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
persistPath Bool
create (Path Abs Dir
base Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
name) Maybe (Path Rel Dir)
sub

-- |Interpret 'PersistPath' by reading the global setting for the root directory, or using the XDG cache directory if
-- the variable is unset.
--
-- The plugin name is used as a subdir of the root.
--
-- This uses 'Resumable', see [Errors]("Ribosome#errors").
interpretPersistPath ::
  Members [Settings !! SettingError, Reader PluginName, Error BootError, Embed IO] r =>
  Bool ->
  InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPath :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Reader PluginName, Error BootError,
    Embed IO]
  r =>
Bool -> InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPath Bool
create Sem ((PersistPath !! PersistPathError) : r) a
sem = do
  Maybe (Path Abs Dir)
xdg <- Sem r (Maybe (Path Abs Dir))
forall (r :: EffectRow).
Member (Embed IO) r =>
Sem r (Maybe (Path Abs Dir))
xdgCache
  Path Rel Dir
name <- BootError -> Maybe (Path Rel Dir) -> Sem r (Path Rel Dir)
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note BootError
"plugin name not suitable for file system paths" (Maybe (Path Rel Dir) -> Sem r (Path Rel Dir))
-> (PluginName -> Maybe (Path Rel Dir))
-> PluginName
-> Sem r (Path Rel Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (FilePath -> Maybe (Path Rel Dir))
-> (PluginName -> FilePath) -> PluginName -> Maybe (Path Rel Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath)
-> (PluginName -> Text) -> PluginName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginName -> Text
unPluginName (PluginName -> Sem r (Path Rel Dir))
-> Sem r PluginName -> Sem r (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r PluginName
forall (r :: EffectRow).
Member (Reader PluginName) r =>
Sem r PluginName
pluginName
  Bool
-> Maybe (Path Abs Dir)
-> Path Rel Dir
-> InterpreterFor (PersistPath !! PersistPathError) r
forall (r :: EffectRow).
Members '[Settings !! SettingError, Embed IO] r =>
Bool
-> Maybe (Path Abs Dir)
-> Path Rel Dir
-> InterpreterFor (PersistPath !! PersistPathError) r
interpretPersistPathSetting Bool
create Maybe (Path Abs Dir)
xdg Path Rel Dir
name Sem ((PersistPath !! PersistPathError) : r) a
sem