{- |
Module:      PFile.Profile.Internal.Current
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Types and functions for managing current profile.
-}

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module PFile.Profile.Internal.Current
  ( loadCurrent
  , showLoadCurrentError
  , LoadCurrentError (..)
  , setCurrent
  , unsetCurrent
  , showSetCurrentError
  , SetCurrentError (..)
  , showUnsetCurrentError
  , UnsetCurrentError (..)
  ) where

import           PFile.Env                            (Env (..))
import           PFile.Error
  ( liftIOWithError
  , modifyError
  )
import qualified PFile.Log                            as Log
import           PFile.Path
  ( canonicalizePath
  , createDirectoryLink
  , takeBaseName
  )
import qualified PFile.Path                           as Path
import           PFile.Profile.Internal.Profile
  ( Name (..)
  , Profile (..)
  , profileRoot
  )
import           PFile.Profile.Internal.Serialization
  ( LoadError
  , load
  , showLoadError
  )
import           Protolude

-- | 'PFile.Profile.Internal.Serialization.load' current 'Profile'. Current
-- 'Profile' is resolved via 'PFile.Env.currentLinkPath'.
--
-- @since 0.1.0.0
loadCurrent ::
     (MonadReader Env m, MonadError LoadCurrentError m, MonadIO m) => m Profile
loadCurrent :: forall (m :: * -> *).
(MonadReader Env m, MonadError LoadCurrentError m, MonadIO m) =>
m Profile
loadCurrent = do
  Env {Absolute
currentLinkPath :: Env -> Absolute
currentLinkPath :: Absolute
currentLinkPath} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info Text
"Canonicalize link pointing at current profile"
  Absolute
currentPath <- Absolute -> IO Absolute
forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
canonicalizePath Absolute
currentLinkPath
    IO Absolute -> (IOException -> LoadCurrentError) -> m Absolute
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> LoadCurrentError
CanonicalizeCurrentError Absolute
currentLinkPath
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$  Text
"Canonicalized link pointing at current profile: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
currentPath
  Absolute
currentPath
    Absolute -> (Absolute -> Name) -> Name
forall a b. a -> (a -> b) -> b
& Text -> Name
Name (Text -> Name) -> (Absolute -> Text) -> Absolute -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Absolute -> String) -> Absolute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> String
takeBaseName
    Name
-> (Name -> ExceptT LoadError m Profile)
-> ExceptT LoadError m Profile
forall a b. a -> (a -> b) -> b
& Name -> ExceptT LoadError m Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError LoadError m, MonadIO m) =>
Name -> m Profile
load
    ExceptT LoadError m Profile
-> (ExceptT LoadError m Profile -> m Profile) -> m Profile
forall a b. a -> (a -> b) -> b
& (LoadError -> LoadCurrentError)
-> ExceptT LoadError m Profile -> m Profile
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError LoadError -> LoadCurrentError
LoadCurrentError

showLoadCurrentError :: LoadCurrentError -> Text
showLoadCurrentError :: LoadCurrentError -> Text
showLoadCurrentError = \case
  CanonicalizeCurrentError Absolute
path IOException
cause
    -> Text
"Unable to resolve current link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show IOException
cause
  LoadCurrentError LoadError
cause -> LoadError -> Text
showLoadError LoadError
cause

-- | Error thrown by 'loadCurrent'.
--
-- @since 0.1.0.0
data LoadCurrentError
  = CanonicalizeCurrentError !Path.Absolute !IOException
  -- ^ Unable to canonicalize 'PFile.Env.currentLinkPath'.
  | LoadCurrentError !LoadError
  -- ^ Error was encountered during
  -- 'PFile.Profile.Internal.Serialization.load'.

-- | Set current 'Profile'. Previously set 'Profile' is unset via
-- 'unsetCurrent' and then 'PFile.Env.currentLinkPath' is set to point at a new
-- current 'Profile'.
--
-- @since 0.1.0.0
setCurrent ::
     (MonadReader Env m, MonadError SetCurrentError m, MonadIO m)
  => Profile
  -> m ()
setCurrent :: forall (m :: * -> *).
(MonadReader Env m, MonadError SetCurrentError m, MonadIO m) =>
Profile -> m ()
setCurrent Profile {Name
name :: Name
name :: Profile -> Name
name} = do
  Env {Absolute
currentLinkPath :: Env -> Absolute
currentLinkPath :: Absolute
currentLinkPath} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ExceptT UnsetCurrentError m ()
forall (m :: * -> *).
(MonadReader Env m, MonadError UnsetCurrentError m, MonadIO m) =>
m ()
unsetCurrent
    ExceptT UnsetCurrentError m ()
-> (ExceptT UnsetCurrentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (UnsetCurrentError -> SetCurrentError)
-> ExceptT UnsetCurrentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnsetCurrentError -> SetCurrentError
UnsetCurrentError
  Absolute
root <- Name -> m Absolute
forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileRoot Name
name
  Absolute -> Absolute -> ExceptT CreateDirectoryLinkError m ()
forall (m :: * -> *).
(MonadError CreateDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createDirectoryLink Absolute
root Absolute
currentLinkPath
    ExceptT CreateDirectoryLinkError m ()
-> (ExceptT CreateDirectoryLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateDirectoryLinkError -> SetCurrentError)
-> ExceptT CreateDirectoryLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateDirectoryLinkError -> SetCurrentError
CurrentLinkError

-- | Unset current 'Profile'. 'PFile.Env.currentLinkPath' is removed.
--
-- @since 0.1.0.0
unsetCurrent ::
     (MonadReader Env m, MonadError UnsetCurrentError m, MonadIO m) => m ()
unsetCurrent :: forall (m :: * -> *).
(MonadReader Env m, MonadError UnsetCurrentError m, MonadIO m) =>
m ()
unsetCurrent = do
  Env {Absolute
currentLinkPath :: Env -> Absolute
currentLinkPath :: Absolute
currentLinkPath} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Absolute -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
Path.remove Absolute
currentLinkPath
    ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> UnsetCurrentError)
-> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> UnsetCurrentError
CurrentLinkRemoveError

showSetCurrentError :: SetCurrentError -> Text
showSetCurrentError :: SetCurrentError -> Text
showSetCurrentError = \case
  UnsetCurrentError UnsetCurrentError
cause -> UnsetCurrentError -> Text
showUnsetCurrentError UnsetCurrentError
cause
  CurrentLinkError CreateDirectoryLinkError
cause  -> CreateDirectoryLinkError -> Text
Path.showCreateDirectoryLinkError CreateDirectoryLinkError
cause

-- | Error thrown by 'setCurrent'.
--
-- @since 0.1.0.0
data SetCurrentError
  = UnsetCurrentError !UnsetCurrentError
  -- ^ Error was encountered during 'unsetCurrent'.
  | CurrentLinkError !Path.CreateDirectoryLinkError
  -- ^ Unable to create a directory link 'PFile.Env.currentLinkPath' pointing
  -- at a new current 'Profile'.

showUnsetCurrentError :: UnsetCurrentError -> Text
showUnsetCurrentError :: UnsetCurrentError -> Text
showUnsetCurrentError = \case
  CurrentLinkRemoveError RemoveError
cause
    -> Text
"Unable to remove current profile link because of: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoveError -> Text
Path.showRemoveError RemoveError
cause

-- | Error thrown by 'unsetCurrent'.
--
-- @since 0.1.0.0
newtype UnsetCurrentError
  = CurrentLinkRemoveError Path.RemoveError
  -- ^ Unable to remove a directory link 'PFile.Env.currentLinkPath'.