{- |
Module:      PFile.Profile.Internal.Registry
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 profiles entries.
-}

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

module PFile.Profile.Internal.Registry
  ( pushAll
  , push
  , showPushError
  , PushError (..)
  , pop
  , showPopError
  , PopError (..)
  , linkAll
  , link
  , showLinkError
  , LinkError (..)
  , unpackAll
  , unpack
  , showUnpackError
  , UnpackError (..)
  ) where

import           Control.Monad.Writer           (MonadWriter (..))
import           PFile.Env                      (Env)
import           PFile.Error                    (modifyError)
import qualified PFile.Log                      as Log
import qualified PFile.Mount                    as Mount
import           PFile.Path
  ( CopyError
  , copy
  , createLink
  , showCopyError
  )
import qualified PFile.Path                     as Path
import           PFile.Profile.Internal.Profile (Entry, Name (..), absoluteRoot)
import qualified PFile.Profile.Internal.Profile as Entry (Entry (..))
import qualified PFile.Profile.LinkHandling     as LinkHandling
import           Protolude                      hiding (link)

-- | 'push' a list of 'PFile.Path.Absolute' inside of
-- a 'PFile.Profile.Internal.Profile.Profile' named 'Name' with a chosen
-- 'PFile.Profile.LinkHandling.Strategy' for links. When an error is
-- encountered during 'push', 'pushAll' terminates and provides successfully
-- 'push'ed entries via a 'MonadWriter'.
--
-- @since 0.1.0.0
pushAll ::
     ( MonadReader Env m
     , MonadError PushError m
     , MonadWriter [Entry] m
     , MonadIO m
     )
  => LinkHandling.Strategy
  -> Name
  -> [Path.Absolute]
  -> m ()
pushAll :: forall (m :: * -> *).
(MonadReader Env m, MonadError PushError m, MonadWriter [Entry] m,
 MonadIO m) =>
Strategy -> Name -> [Absolute] -> m ()
pushAll Strategy
linkHandlingStrategy Name
name = (Absolute -> m ()) -> [Absolute] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \Absolute
originPath ->
  Strategy -> Name -> Absolute -> m Mount
forall (m :: * -> *).
(MonadReader Env m, MonadError PushError m, MonadIO m) =>
Strategy -> Name -> Absolute -> m Mount
push Strategy
linkHandlingStrategy Name
name Absolute
originPath
    m Mount -> (Mount -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Mount
mountPath -> [Entry] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Entry.Entry {Mount
mountPath :: Mount
mountPath :: Mount
Entry.mountPath, Absolute
originPath :: Absolute
originPath :: Absolute
Entry.originPath}]

-- | 'PFile.Mount.mount' a 'PFile.Path.Absolute' inside of
-- a 'PFile.Profile.Internal.Profile.Profile' named 'Name' with a chosen
-- 'PFile.Profile.LinkHandling.Strategy' for links.
--
-- @since 0.1.0.0
push ::
     (MonadReader Env m, MonadError PushError m, MonadIO m)
  => LinkHandling.Strategy
  -> Name
  -> Path.Absolute
  -> m Mount.Mount
push :: forall (m :: * -> *).
(MonadReader Env m, MonadError PushError m, MonadIO m) =>
Strategy -> Name -> Absolute -> m Mount
push Strategy
linkHandlingStrategy Name
name Absolute
originPath = do
  Maybe Type
type_ <- Absolute -> m (Maybe Type)
forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
Path.typeOf Absolute
originPath
  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
"Push "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
originPath
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Type -> Text) -> Maybe Type -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unknown" Type -> Text
Path.showType Maybe Type
type_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with link handling strategy "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Strategy -> Text
LinkHandling.showStrategy Strategy
linkHandlingStrategy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  Root
root <- Name -> m Root
forall (m :: * -> *). MonadReader Env m => Name -> m Root
absoluteRoot Name
name
  Mount
mountPath <- Strategy -> Root -> Absolute -> ExceptT MountError m Mount
forall (m :: * -> *).
(MonadError MountError m, MonadIO m) =>
Strategy -> Root -> Absolute -> m Mount
Mount.mount Strategy
linkHandlingStrategy Root
root Absolute
originPath
    ExceptT MountError m Mount
-> (ExceptT MountError m Mount -> m Mount) -> m Mount
forall a b. a -> (a -> b) -> b
& (MountError -> PushError) -> ExceptT MountError m Mount -> m Mount
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError MountError -> PushError
PushError
  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
"Pushed "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
originPath
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  Mount -> m Mount
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mount
mountPath

showPushError :: PushError -> Text
showPushError :: PushError -> Text
showPushError = \case
  PushError MountError
cause -> MountError -> Text
Mount.showMountError MountError
cause

-- | Error thrown by 'push'.
--
-- @since 0.1.0.0
newtype PushError
  = PushError Mount.MountError
  -- ^ Error was encountered during 'PFile.Mount.mount'.

-- | 'PFile.Mount.unmount' a 'PFile.Mount.Mount' from
-- a 'PFile.Profile.Internal.Profile.Profile' named 'Name' back to its original
-- location at 'PFile.Path.Absolute'.
--
-- @since 0.1.0.0
pop ::
     (MonadReader Env m, MonadError PopError m, MonadIO m)
  => Name
  -> Mount.Mount
  -> m Path.Absolute
pop :: forall (m :: * -> *).
(MonadReader Env m, MonadError PopError m, MonadIO m) =>
Name -> Mount -> m Absolute
pop Name
name Mount
mountPath = do
  Maybe Type
type_ <- Absolute -> m (Maybe Type)
forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
Path.typeOf (Absolute -> m (Maybe Type))
-> (Mount -> Absolute) -> Mount -> m (Maybe Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mount -> Absolute
Mount.absolute (Mount -> m (Maybe Type)) -> Mount -> m (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Mount
mountPath
  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
"Pop "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute (Mount -> Absolute
Mount.absolute Mount
mountPath)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Type -> Text) -> Maybe Type -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unknown" Type -> Text
Path.showType Maybe Type
type_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  Root
root <- Name -> m Root
forall (m :: * -> *). MonadReader Env m => Name -> m Root
absoluteRoot Name
name
  Absolute
originPath <- Root -> Mount -> ExceptT UnmountError m Absolute
forall (m :: * -> *).
(MonadError UnmountError m, MonadIO m) =>
Root -> Mount -> m Absolute
Mount.unmount Root
root Mount
mountPath
    ExceptT UnmountError m Absolute
-> (ExceptT UnmountError m Absolute -> m Absolute) -> m Absolute
forall a b. a -> (a -> b) -> b
& (UnmountError -> PopError)
-> ExceptT UnmountError m Absolute -> m Absolute
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnmountError -> PopError
PopError
  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
"Popped "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute (Mount -> Absolute
Mount.absolute Mount
mountPath)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  Absolute -> m Absolute
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Absolute
originPath

showPopError :: PopError -> Text
showPopError :: PopError -> Text
showPopError = \case
  PopError UnmountError
cause -> UnmountError -> Text
Mount.showUnmountError UnmountError
cause

-- | Error thrown by 'pop'.
--
-- @since 0.1.0.0
newtype PopError
  = PopError Mount.UnmountError
  -- ^ Error was encountered during 'PFile.Mount.unmount'.

-- | 'link' a list of 'Entry'ies. For each 'Entry' a link at
-- 'PFile.Profile.Internal.Profile.originPath' will be created pointing at
-- 'PFile.Profile.Internal.Profile.mountPath'. When an error is encountered
-- during 'link', 'linkAll' terminates and provides successfully 'link'ed
-- entries via a 'MonadWriter'.
--
-- @since 0.1.0.0
linkAll ::
     (MonadError LinkError m, MonadWriter [Path.Absolute] m, MonadIO m)
  => [Entry]
  -> m ()
linkAll :: forall (m :: * -> *).
(MonadError LinkError m, MonadWriter [Absolute] m, MonadIO m) =>
[Entry] -> m ()
linkAll = (Entry -> m ()) -> [Entry] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \Entry.Entry {Mount
mountPath :: Entry -> Mount
mountPath :: Mount
Entry.mountPath, Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
Entry.originPath} ->
  [Absolute
originPath] [Absolute] -> m () -> m [Absolute]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mount -> Absolute -> m ()
forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
Mount -> Absolute -> m ()
link Mount
mountPath Absolute
originPath m [Absolute] -> ([Absolute] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Absolute] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

-- | Create a link at 'PFile.Path.Absolute' pointing at 'PFile.Mount.Mount'.
--
-- @since 0.1.0.0
link ::
     (MonadError LinkError m, MonadIO m)
  => Mount.Mount
  -> Path.Absolute
  -> m ()
link :: forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
Mount -> Absolute -> m ()
link Mount
mountPath Absolute
originPath =
  Absolute -> Absolute -> ExceptT CreateLinkError m ()
forall (m :: * -> *).
(MonadError CreateLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createLink (Mount -> Absolute
Mount.absolute Mount
mountPath) Absolute
originPath
    ExceptT CreateLinkError m ()
-> (ExceptT CreateLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateLinkError -> LinkError)
-> ExceptT CreateLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateLinkError -> LinkError
LinkError

showLinkError :: LinkError -> Text
showLinkError :: LinkError -> Text
showLinkError = \case
  LinkError CreateLinkError
cause -> CreateLinkError -> Text
Path.showCreateLinkError CreateLinkError
cause

-- | Error thrown by 'link'.
--
-- @since 0.1.0.0
newtype LinkError
  = LinkError Path.CreateLinkError
  -- ^ Unable to create a link at 'PFile.Path.Absolute' pointing at
  -- 'PFile.Mount.Mount'.

-- | 'unpack' a list of 'Entry'ies. For each 'Entry'
-- a 'PFile.Profile.Internal.Profile.mountPath' will be copied to
-- 'PFile.Profile.Internal.Profile.originPath'. When an error is encountered
-- during 'unpack', 'unpackAll' terminates and provides successfully 'unpack'ed
-- entries via a 'MonadWriter'.
--
-- @since 0.1.0.0
unpackAll ::
     (MonadError UnpackError m, MonadWriter [Path.Absolute] m, MonadIO m)
  => [Entry]
  -> m ()
unpackAll :: forall (m :: * -> *).
(MonadError UnpackError m, MonadWriter [Absolute] m, MonadIO m) =>
[Entry] -> m ()
unpackAll = (Entry -> m ()) -> [Entry] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \Entry.Entry {Mount
mountPath :: Entry -> Mount
mountPath :: Mount
Entry.mountPath, Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
Entry.originPath} ->
  [Absolute
originPath] [Absolute] -> m () -> m [Absolute]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mount -> Absolute -> m ()
forall (m :: * -> *).
(MonadError UnpackError m, MonadIO m) =>
Mount -> Absolute -> m ()
unpack Mount
mountPath Absolute
originPath m [Absolute] -> ([Absolute] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Absolute] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

-- | Copy filesystem's object at 'PFile.Mount.Mount' to 'PFile.Path.Absolute'.
--
-- @since 0.1.0.0
unpack ::
     (MonadError UnpackError m, MonadIO m)
  => Mount.Mount
  -> Path.Absolute
  -> m ()
unpack :: forall (m :: * -> *).
(MonadError UnpackError m, MonadIO m) =>
Mount -> Absolute -> m ()
unpack Mount
mountPath Absolute
originPath =
  Absolute -> Absolute -> ExceptT CopyError m ()
forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copy (Mount -> Absolute
Mount.absolute Mount
mountPath) Absolute
originPath
    ExceptT CopyError m () -> (ExceptT CopyError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyError -> UnpackError) -> ExceptT CopyError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError (Mount -> Absolute -> CopyError -> UnpackError
UnpackError Mount
mountPath Absolute
originPath)

showUnpackError :: UnpackError -> Text
showUnpackError :: UnpackError -> Text
showUnpackError = \case
  UnpackError (Mount.Mount Absolute
src) Absolute
dest CopyError
cause
    -> Text
"Unable to unpack " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CopyError -> Text
showCopyError CopyError
cause

-- | Error thrown by 'unpack'.
--
-- @since 0.1.0.0
data UnpackError
  = UnpackError !Mount.Mount !Path.Absolute !CopyError
  -- ^ Unable to copy 'PFile.Mount.Mount' to 'PFile.Path.Absolute'.