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

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

module PFile.Profile.Internal.Switch
  ( switch
  , unlink
  , validateLinkedEntry
  , link
  , unpack
  , validateUnlinkedEntry
  , purge
  , showSwitchError
  , SwitchError (..)
  , showUnlinkError
  , UnlinkError (..)
  , showLinkedEntryValidateError
  , LinkedEntryValidateError (..)
  , showLinkError
  , LinkError (..)
  , showUnpackError
  , UnpackError (..)
  , showUnlinkedEntryValidateError
  , UnlinkedEntryValidateError (..)
  , showPurgeError
  , PurgeError (..)
  , SwitchOptions (..)
  ) where

import           Control.Monad.Writer            (execWriterT)
import           PFile.Error
  ( fallback
  , liftIOWithError
  , modifyError
  , tellError
  )
import qualified PFile.Mount                     as Mount
import           PFile.Path
  ( canonicalizePath
  , doesPathExist
  )
import qualified PFile.Path                      as Path
import           PFile.Profile.Internal.Profile
  ( Entry (..)
  , Name (..)
  , Profile (..)
  )
import           PFile.Profile.Internal.Registry (linkAll, unpackAll)
import qualified PFile.Profile.Internal.Registry as Registry
import           PFile.TrashCan                  (TrashCan (..))
import qualified PFile.TrashCan                  as TrashCan
import           Protolude                       hiding (link)

-- | Switch from the current profile to the next profile. 'switch' 'unlink's
-- the current profile and then 'link's the next profile.
--
-- @since 0.1.0.0
switch ::
     (MonadError SwitchError m, MonadIO m)
  => SwitchOptions
  -- ^ Options that control 'switch' behaviour (currently only
  -- 'forceRemoveOccupied').
  -> Profile
  -- ^ Current profile.
  -> Profile
  -- ^ Next profile.
  -> m ()
switch :: forall (m :: * -> *).
(MonadError SwitchError m, MonadIO m) =>
SwitchOptions -> Profile -> Profile -> m ()
switch SwitchOptions
options Profile
current Profile
next = do
  SwitchOptions -> Profile -> ExceptT UnlinkError m ()
forall (m :: * -> *).
(MonadError UnlinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
unlink SwitchOptions
options Profile
current
    ExceptT UnlinkError m ()
-> (ExceptT UnlinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (UnlinkError -> SwitchError) -> ExceptT UnlinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnlinkError -> SwitchError
UnlinkCurrentError
  SwitchOptions -> Profile -> ExceptT LinkError m ()
forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
link SwitchOptions
options Profile
next
    ExceptT LinkError m () -> (ExceptT LinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (LinkError -> SwitchError) -> ExceptT LinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError LinkError -> SwitchError
LinkNextError

-- | Remove links pointing at entries inside of the 'Profile'. 'unlink' only
-- remove links that are know to PFile.
--
-- @since 0.1.0.0
unlink ::
     (MonadError UnlinkError m, MonadIO m)
  => SwitchOptions
  -> Profile
  -> m ()
unlink :: forall (m :: * -> *).
(MonadError UnlinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
unlink SwitchOptions {Bool
forceRemoveOccupied :: SwitchOptions -> Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied} profile :: Profile
profile@Profile {[Entry]
entries :: [Entry]
entries :: Profile -> [Entry]
entries} = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceRemoveOccupied
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Entry] -> (Entry -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Entry]
entries
      ((LinkedEntryValidateError -> UnlinkError)
-> ExceptT LinkedEntryValidateError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError LinkedEntryValidateError -> UnlinkError
ValidateUnlinkError (ExceptT LinkedEntryValidateError m () -> m ())
-> (Entry -> ExceptT LinkedEntryValidateError m ())
-> Entry
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ExceptT LinkedEntryValidateError m ()
forall (m :: * -> *).
(MonadError LinkedEntryValidateError m, MonadIO m) =>
Entry -> m ()
validateLinkedEntry)
  Profile -> ExceptT PurgeError m ()
forall (m :: * -> *).
(MonadError PurgeError m, MonadIO m) =>
Profile -> m ()
purge Profile
profile
    ExceptT PurgeError m ()
-> (ExceptT PurgeError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (PurgeError -> UnlinkError) -> ExceptT PurgeError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError PurgeError -> UnlinkError
PurgeUnlinkError

-- | Validate that 'Entry's 'originPath' is a link pointing at 'mountPath'.
--
-- @since 0.1.0.0
validateLinkedEntry ::
     (MonadError LinkedEntryValidateError m, MonadIO m) => Entry -> m ()
validateLinkedEntry :: forall (m :: * -> *).
(MonadError LinkedEntryValidateError m, MonadIO m) =>
Entry -> m ()
validateLinkedEntry entry :: Entry
entry@Entry {mountPath :: Entry -> Mount
mountPath = Mount.Mount Absolute
mountPath, Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
originPath} = do
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesPathExist Absolute
originPath) (m () -> m ())
-> (LinkedEntryValidateError -> m ())
-> LinkedEntryValidateError
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkedEntryValidateError -> m ()
forall a. LinkedEntryValidateError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (LinkedEntryValidateError -> m ())
-> LinkedEntryValidateError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> LinkedEntryValidateError
OriginDoesNotExistError Absolute
originPath
  Absolute
canonicalizedPath <- Absolute -> IO Absolute
forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
canonicalizePath Absolute
originPath
    IO Absolute
-> (IOException -> LinkedEntryValidateError) -> m Absolute
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> LinkedEntryValidateError
OriginCanonicalizeError Absolute
originPath
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Absolute
canonicalizedPath Absolute -> Absolute -> Bool
forall a. Eq a => a -> a -> Bool
== Absolute
mountPath) (m () -> m ())
-> (LinkedEntryValidateError -> m ())
-> LinkedEntryValidateError
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkedEntryValidateError -> m ()
forall a. LinkedEntryValidateError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (LinkedEntryValidateError -> m ())
-> LinkedEntryValidateError -> m ()
forall a b. (a -> b) -> a -> b
$ Entry -> Absolute -> LinkedEntryValidateError
OriginChangedError Entry
entry Absolute
canonicalizedPath

-- | Create links pointing at 'Entry'ies inside of the 'Profile' with
-- 'PFile.Profile.Internal.Registry.linkAll'.
--
-- @since 0.1.0.0
link ::
     forall m. (MonadError LinkError m, MonadIO m)
  => SwitchOptions
  -> Profile
  -> m ()
link :: forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
link SwitchOptions {Bool
forceRemoveOccupied :: SwitchOptions -> Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied} profile :: Profile
profile@Profile {[Entry]
entries :: Profile -> [Entry]
entries :: [Entry]
entries} = do
  if Bool
forceRemoveOccupied
    then
      Profile -> ExceptT PurgeError m ()
forall (m :: * -> *).
(MonadError PurgeError m, MonadIO m) =>
Profile -> m ()
purge Profile
profile
        ExceptT PurgeError m ()
-> (ExceptT PurgeError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (PurgeError -> LinkError) -> ExceptT PurgeError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError PurgeError -> LinkError
PurgeLinkError
    else
      [Entry] -> (Entry -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Entry]
entries
        ((UnlinkedEntryValidateError -> LinkError)
-> ExceptT UnlinkedEntryValidateError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnlinkedEntryValidateError -> LinkError
ValidateLinkError (ExceptT UnlinkedEntryValidateError m () -> m ())
-> (Entry -> ExceptT UnlinkedEntryValidateError m ())
-> Entry
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ExceptT UnlinkedEntryValidateError m ()
forall (m :: * -> *).
(MonadError UnlinkedEntryValidateError m, MonadIO m) =>
Entry -> m ()
validateUnlinkedEntry)
  [Entry] -> ExceptT LinkError (WriterT [Absolute] m) ()
forall (m :: * -> *).
(MonadError LinkError m, MonadWriter [Absolute] m, MonadIO m) =>
[Entry] -> m ()
linkAll [Entry]
entries
    ExceptT LinkError (WriterT [Absolute] m) ()
-> (ExceptT LinkError (WriterT [Absolute] m) () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& m [Absolute] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Absolute] -> m ())
-> (ExceptT LinkError (WriterT [Absolute] m) () -> m [Absolute])
-> ExceptT LinkError (WriterT [Absolute] m) ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LinkError -> [Absolute] -> m ())
-> ExceptT LinkError (WriterT [Absolute] m) () -> m [Absolute]
forall (m :: * -> *) e w b a.
Monad m =>
(e -> w -> m b) -> ExceptT e (WriterT w m) a -> m w
fallback LinkError -> [Absolute] -> m ()
rollbackLinks
  where
    rollbackLinks :: Registry.LinkError -> [Path.Absolute] -> m ()
    rollbackLinks :: LinkError -> [Absolute] -> m ()
rollbackLinks LinkError
cause [Absolute]
originPaths = [Absolute]
originPaths
      [Absolute]
-> ([Absolute] -> WriterT [(Absolute, RemoveError)] m ())
-> WriterT [(Absolute, RemoveError)] m ()
forall a b. a -> (a -> b) -> b
& (Absolute -> WriterT [(Absolute, RemoveError)] m ())
-> [Absolute] -> WriterT [(Absolute, RemoveError)] m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\Absolute
p -> Absolute
-> ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
Path.remove Absolute
p ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
-> (ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
    -> WriterT [(Absolute, RemoveError)] m ())
-> WriterT [(Absolute, RemoveError)] m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> (Absolute, RemoveError))
-> ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
-> WriterT [(Absolute, RemoveError)] m ()
forall e2 (m :: * -> *) e1 a.
MonadWriter [e2] m =>
(e1 -> e2) -> ExceptT e1 m a -> m ()
tellError (Absolute
p, ))
      WriterT [(Absolute, RemoveError)] m ()
-> (WriterT [(Absolute, RemoveError)] m ()
    -> m [(Absolute, RemoveError)])
-> m [(Absolute, RemoveError)]
forall a b. a -> (a -> b) -> b
& WriterT [(Absolute, RemoveError)] m ()
-> m [(Absolute, RemoveError)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT m [(Absolute, RemoveError)]
-> ([(Absolute, RemoveError)] -> 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
>>= \case
        errors :: [(Absolute, RemoveError)]
errors@((Absolute, RemoveError)
_:[(Absolute, RemoveError)]
_) -> LinkError -> m ()
forall a. LinkError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LinkError -> m ()) -> LinkError -> m ()
forall a b. (a -> b) -> a -> b
$ LinkError -> [(Absolute, RemoveError)] -> Profile -> LinkError
LinkRollbackError LinkError
cause [(Absolute, RemoveError)]
errors Profile
profile
        []           -> LinkError -> m ()
forall a. LinkError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LinkError -> m ()) -> LinkError -> m ()
forall a b. (a -> b) -> a -> b
$ LinkError -> LinkError
LinkError LinkError
cause

-- | Unpack 'Profile's entries back to their original locations with
-- 'PFile.Profile.Internal.Registry.unpackAll'.
--
-- @since 0.1.0.0
unpack ::
     forall m. (MonadError UnpackError m, MonadIO m)
  => SwitchOptions
  -> Profile
  -> m ()
unpack :: forall (m :: * -> *).
(MonadError UnpackError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
unpack options :: SwitchOptions
options@SwitchOptions {Bool
forceRemoveOccupied :: SwitchOptions -> Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied} profile :: Profile
profile@Profile {[Entry]
entries :: Profile -> [Entry]
entries :: [Entry]
entries} = do
  if Bool
forceRemoveOccupied
    then
      Profile -> ExceptT PurgeError m ()
forall (m :: * -> *).
(MonadError PurgeError m, MonadIO m) =>
Profile -> m ()
purge Profile
profile
        ExceptT PurgeError m ()
-> (ExceptT PurgeError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (PurgeError -> UnpackError) -> ExceptT PurgeError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError PurgeError -> UnpackError
PurgeUnpackError
    else
      SwitchOptions -> Profile -> ExceptT UnlinkError m ()
forall (m :: * -> *).
(MonadError UnlinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
unlink SwitchOptions
options Profile
profile
        ExceptT UnlinkError m ()
-> (ExceptT UnlinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (UnlinkError -> UnpackError) -> ExceptT UnlinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnlinkError -> UnpackError
UnlinkUnpackError
  [Entry] -> ExceptT UnpackError (WriterT [Absolute] m) ()
forall (m :: * -> *).
(MonadError UnpackError m, MonadWriter [Absolute] m, MonadIO m) =>
[Entry] -> m ()
unpackAll [Entry]
entries
    ExceptT UnpackError (WriterT [Absolute] m) ()
-> (ExceptT UnpackError (WriterT [Absolute] m) () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& m [Absolute] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Absolute] -> m ())
-> (ExceptT UnpackError (WriterT [Absolute] m) () -> m [Absolute])
-> ExceptT UnpackError (WriterT [Absolute] m) ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnpackError -> [Absolute] -> m ())
-> ExceptT UnpackError (WriterT [Absolute] m) () -> m [Absolute]
forall (m :: * -> *) e w b a.
Monad m =>
(e -> w -> m b) -> ExceptT e (WriterT w m) a -> m w
fallback UnpackError -> [Absolute] -> m ()
rollbackUnpacked
  where
    rollbackUnpacked :: Registry.UnpackError -> [Path.Absolute] -> m ()
    rollbackUnpacked :: UnpackError -> [Absolute] -> m ()
rollbackUnpacked UnpackError
cause [Absolute]
originPaths = [Absolute]
originPaths
      [Absolute]
-> ([Absolute] -> WriterT [(Absolute, RemoveError)] m ())
-> WriterT [(Absolute, RemoveError)] m ()
forall a b. a -> (a -> b) -> b
& (Absolute -> WriterT [(Absolute, RemoveError)] m ())
-> [Absolute] -> WriterT [(Absolute, RemoveError)] m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\Absolute
p -> Absolute
-> ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
Path.remove Absolute
p ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
-> (ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
    -> WriterT [(Absolute, RemoveError)] m ())
-> WriterT [(Absolute, RemoveError)] m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> (Absolute, RemoveError))
-> ExceptT RemoveError (WriterT [(Absolute, RemoveError)] m) ()
-> WriterT [(Absolute, RemoveError)] m ()
forall e2 (m :: * -> *) e1 a.
MonadWriter [e2] m =>
(e1 -> e2) -> ExceptT e1 m a -> m ()
tellError (Absolute
p, ))
      WriterT [(Absolute, RemoveError)] m ()
-> (WriterT [(Absolute, RemoveError)] m ()
    -> m [(Absolute, RemoveError)])
-> m [(Absolute, RemoveError)]
forall a b. a -> (a -> b) -> b
& WriterT [(Absolute, RemoveError)] m ()
-> m [(Absolute, RemoveError)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT m [(Absolute, RemoveError)]
-> ([(Absolute, RemoveError)] -> 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
>>= \case
        errors :: [(Absolute, RemoveError)]
errors@((Absolute, RemoveError)
_:[(Absolute, RemoveError)]
_) -> UnpackError -> m ()
forall a. UnpackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m ()) -> UnpackError -> m ()
forall a b. (a -> b) -> a -> b
$ UnpackError -> [(Absolute, RemoveError)] -> Profile -> UnpackError
UnpackRollbackError UnpackError
cause [(Absolute, RemoveError)]
errors Profile
profile
        []           -> UnpackError -> m ()
forall a. UnpackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m ()) -> UnpackError -> m ()
forall a b. (a -> b) -> a -> b
$ UnpackError -> UnpackError
UnpackError UnpackError
cause

-- | Validate that 'Entry's 'originPath' does not exist.
--
-- @since 0.1.0.0
validateUnlinkedEntry ::
     (MonadError UnlinkedEntryValidateError m, MonadIO m) => Entry -> m ()
validateUnlinkedEntry :: forall (m :: * -> *).
(MonadError UnlinkedEntryValidateError m, MonadIO m) =>
Entry -> m ()
validateUnlinkedEntry entry :: Entry
entry@Entry {Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
originPath} =
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesPathExist Absolute
originPath) (m () -> m ())
-> (UnlinkedEntryValidateError -> m ())
-> UnlinkedEntryValidateError
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnlinkedEntryValidateError -> m ()
forall a. UnlinkedEntryValidateError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (UnlinkedEntryValidateError -> m ())
-> UnlinkedEntryValidateError -> m ()
forall a b. (a -> b) -> a -> b
$ Entry -> UnlinkedEntryValidateError
OriginOccupiedError Entry
entry

-- | Forcibly remove 'originPath's of a 'Profile's 'Entry'ies.
--
-- @since 0.1.0.0
purge ::
     forall m. (MonadError PurgeError m, MonadIO m)
  => Profile
  -> m ()
purge :: forall (m :: * -> *).
(MonadError PurgeError m, MonadIO m) =>
Profile -> m ()
purge profile :: Profile
profile@Profile {[Entry]
entries :: Profile -> [Entry]
entries :: [Entry]
entries} = do
  TrashCan
trashCan <- ExceptT CreateError m TrashCan
forall (m :: * -> *).
(MonadError CreateError m, MonadIO m) =>
m TrashCan
TrashCan.create
    ExceptT CreateError m TrashCan
-> (ExceptT CreateError m TrashCan -> m TrashCan) -> m TrashCan
forall a b. a -> (a -> b) -> b
& (CreateError -> PurgeError)
-> ExceptT CreateError m TrashCan -> m TrashCan
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateError -> PurgeError
TrashCanCreateError
  TrashCan -> [Entry] -> m ()
trashOrigins TrashCan
trashCan [Entry]
entries
    m () -> (PurgeError -> m ()) -> m ()
forall a. m a -> (PurgeError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` TrashCan -> PurgeError -> m ()
rollbackTrashOrigins TrashCan
trashCan
  TrashCan -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
TrashCan -> m ()
TrashCan.remove TrashCan
trashCan
    ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> PurgeError) -> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> PurgeError
TrashCanRemoveError
  where
    trashOrigins :: TrashCan -> [Entry] -> m ()
    trashOrigins :: TrashCan -> [Entry] -> m ()
trashOrigins TrashCan
trashCan = (Entry -> m ()) -> [Entry] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \Entry {Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
originPath} ->
      Absolute -> TrashCan -> ExceptT TrashError m ()
forall (m :: * -> *).
(MonadError TrashError m, MonadIO m) =>
Absolute -> TrashCan -> m ()
TrashCan.trash Absolute
originPath TrashCan
trashCan
        ExceptT TrashError m ()
-> (ExceptT TrashError m () -> ExceptT TrashError m ())
-> ExceptT TrashError m ()
forall a b. a -> (a -> b) -> b
& ExceptT TrashError m () -> ExceptT TrashError m ()
forall (m' :: * -> *). MonadError TrashError m' => m' () -> m' ()
hushMissingError
        ExceptT TrashError m ()
-> (ExceptT TrashError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (TrashError -> PurgeError) -> ExceptT TrashError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError TrashError -> PurgeError
TrashError

    hushMissingError :: MonadError TrashCan.TrashError m' => m' () -> m' ()
    hushMissingError :: forall (m' :: * -> *). MonadError TrashError m' => m' () -> m' ()
hushMissingError = (m' () -> (TrashError -> m' ()) -> m' ())
-> (TrashError -> m' ()) -> m' () -> m' ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip m' () -> (TrashError -> m' ()) -> m' ()
forall a. m' a -> (TrashError -> m' a) -> m' a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError \case
      TrashCan.MountError Mount.OriginMissingError {} -> () -> m' ()
forall a. a -> m' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      TrashError
e                                               -> TrashError -> m' ()
forall a. TrashError -> m' a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TrashError
e

    rollbackTrashOrigins :: TrashCan -> PurgeError -> m ()
    rollbackTrashOrigins :: TrashCan -> PurgeError -> m ()
rollbackTrashOrigins TrashCan
trashCan PurgeError
cause =
      TrashCan -> WriterT [RestoreEntryError] m ()
forall (m :: * -> *).
(MonadWriter [RestoreEntryError] m, MonadIO m) =>
TrashCan -> m ()
TrashCan.restoreAll TrashCan
trashCan WriterT [RestoreEntryError] m ()
-> (WriterT [RestoreEntryError] m () -> m [RestoreEntryError])
-> m [RestoreEntryError]
forall a b. a -> (a -> b) -> b
& WriterT [RestoreEntryError] m () -> m [RestoreEntryError]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT m [RestoreEntryError] -> ([RestoreEntryError] -> 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
>>= \case
        errors :: [RestoreEntryError]
errors@(RestoreEntryError
_:[RestoreEntryError]
_) -> TrashCan -> ExceptT DumpTrashedError m Absolute
forall (m :: * -> *).
(MonadError DumpTrashedError m, MonadIO m) =>
TrashCan -> m Absolute
TrashCan.dumpTrashed TrashCan
trashCan ExceptT DumpTrashedError m Absolute
-> (ExceptT DumpTrashedError m Absolute
    -> m (Either DumpTrashedError Absolute))
-> m (Either DumpTrashedError Absolute)
forall a b. a -> (a -> b) -> b
& ExceptT DumpTrashedError m Absolute
-> m (Either DumpTrashedError Absolute)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
          m (Either DumpTrashedError Absolute)
-> (Either DumpTrashedError Absolute
    -> m (Either [Absolute] Absolute))
-> m (Either [Absolute] Absolute)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DumpTrashedError -> m (Either [Absolute] Absolute))
-> (Absolute -> m (Either [Absolute] Absolute))
-> Either DumpTrashedError Absolute
-> m (Either [Absolute] Absolute)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Either [Absolute] Absolute)
-> DumpTrashedError -> m (Either [Absolute] Absolute)
forall a b. a -> b -> a
const (m (Either [Absolute] Absolute)
 -> DumpTrashedError -> m (Either [Absolute] Absolute))
-> m (Either [Absolute] Absolute)
-> DumpTrashedError
-> m (Either [Absolute] Absolute)
forall a b. (a -> b) -> a -> b
$ TrashCan -> m [Absolute]
forall (m :: * -> *). MonadIO m => TrashCan -> m [Absolute]
TrashCan.trashed TrashCan
trashCan m [Absolute]
-> ([Absolute] -> Either [Absolute] Absolute)
-> m (Either [Absolute] Absolute)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Absolute] -> Either [Absolute] Absolute
forall a b. a -> Either a b
Left) (Either [Absolute] Absolute -> m (Either [Absolute] Absolute)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Absolute] Absolute -> m (Either [Absolute] Absolute))
-> (Absolute -> Either [Absolute] Absolute)
-> Absolute
-> m (Either [Absolute] Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Either [Absolute] Absolute
forall a b. b -> Either a b
Right)
          m (Either [Absolute] Absolute)
-> (Either [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
>>= PurgeError -> m ()
forall a. PurgeError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PurgeError -> m ())
-> (Either [Absolute] Absolute -> PurgeError)
-> Either [Absolute] Absolute
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PurgeError
-> [RestoreEntryError]
-> Profile
-> TrashCan
-> Either [Absolute] Absolute
-> PurgeError
PurgeRollbackError PurgeError
cause [RestoreEntryError]
errors Profile
profile TrashCan
trashCan
        [] -> do
          TrashCan -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
TrashCan -> m ()
TrashCan.remove TrashCan
trashCan
            ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> PurgeError) -> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> PurgeError
TrashCanRemoveError
          PurgeError -> m ()
forall a. PurgeError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PurgeError
cause

showSwitchError :: SwitchError -> Text
showSwitchError :: SwitchError -> Text
showSwitchError = \case
  UnlinkCurrentError UnlinkError
cause -> UnlinkError -> Text
showUnlinkError UnlinkError
cause
  LinkNextError LinkError
cause      -> LinkError -> Text
showLinkError LinkError
cause

-- | Error thrown by 'switch'.
--
-- @since 0.1.0.0
data SwitchError
  = UnlinkCurrentError !UnlinkError
  -- ^ Error was encountered during 'unlink'.
  | LinkNextError !LinkError
  -- ^ Error was encountered during 'link'.

showUnlinkError :: UnlinkError -> Text
showUnlinkError :: UnlinkError -> Text
showUnlinkError = \case
  ValidateUnlinkError LinkedEntryValidateError
cause -> LinkedEntryValidateError -> Text
showLinkedEntryValidateError LinkedEntryValidateError
cause
  PurgeUnlinkError PurgeError
cause    -> PurgeError -> Text
showPurgeError PurgeError
cause

-- | Error thrown by 'unlink'.
--
-- @since 0.1.0.0
data UnlinkError
  = ValidateUnlinkError !LinkedEntryValidateError
  -- ^ Validation error of entries was encountered.
  | PurgeUnlinkError !PurgeError
  -- ^ Error was encountered during 'purge'.

showLinkedEntryValidateError :: LinkedEntryValidateError -> Text
showLinkedEntryValidateError :: LinkedEntryValidateError -> Text
showLinkedEntryValidateError = \case
  OriginDoesNotExistError Absolute
path
    -> Text
"Origin " 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
" does not exist."
  OriginCanonicalizeError Absolute
path IOException
cause
    -> Text
"Unable to resolve path " 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
  OriginChangedError Entry {mountPath :: Entry -> Mount
mountPath = Mount.Mount Absolute
mountPath, Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
originPath} Absolute
actual
    -> Text
"Expected " 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
" to be a link pointing at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
mountPath
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Instead it resolves to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

-- | Error thrown by 'validateLinkedEntry'.
--
-- @since 0.1.0.0
data LinkedEntryValidateError
  = OriginDoesNotExistError !Path.Absolute
  -- ^ 'Entry's 'originPath' does not exist.
  | OriginCanonicalizeError !Path.Absolute !IOException
  -- ^ Unable to canonicalize 'originPath'.
  | OriginChangedError !Entry !Path.Absolute
  -- ^ 'originPath' is not a link pointing at 'mountPath'.

showLinkError :: LinkError -> Text
showLinkError :: LinkError -> Text
showLinkError = \case
  PurgeLinkError PurgeError
cause -> PurgeError -> Text
showPurgeError PurgeError
cause
  ValidateLinkError UnlinkedEntryValidateError
cause -> UnlinkedEntryValidateError -> Text
showUnlinkedEntryValidateError UnlinkedEntryValidateError
cause
  LinkRollbackError LinkError
rollbackCause [(Absolute, RemoveError)]
rollbackErrors Profile {name :: Profile -> Name
name = Name Text
name}
    -> Text
"Linking of the \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" profile has failed"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with the following error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LinkError -> Text
Registry.showLinkError LinkError
rollbackCause
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nAttempt to remove linked paths has failed"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with the following errors:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Absolute, RemoveError)] -> Text
showRollbackErrors [(Absolute, RemoveError)]
rollbackErrors
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Please fix the errors above and then remove the links manually."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n`pfile` is not tracking these links."
  LinkError LinkError
cause -> LinkError -> Text
Registry.showLinkError LinkError
cause
  where
    showRollbackErrors :: [(Path.Absolute, Path.RemoveError)] -> Text
    showRollbackErrors :: [(Absolute, RemoveError)] -> Text
showRollbackErrors = [Text] -> Text
unlines ([Text] -> Text)
-> ([(Absolute, RemoveError)] -> [Text])
-> [(Absolute, RemoveError)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Absolute, RemoveError) -> Text)
-> [(Absolute, RemoveError)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Absolute
originPath, RemoveError
error) ->
      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
<> RemoveError -> Text
Path.showRemoveError RemoveError
error Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Error thrown by 'link'.
--
-- @since 0.1.0.0
data LinkError
  = PurgeLinkError !PurgeError
  -- ^ Error was encountered during 'purge'.
  | ValidateLinkError !UnlinkedEntryValidateError
  -- ^ Validation error of entries was encountered.
  | LinkRollbackError
  -- ^ 'link' attempted to rollback due to 'Registry.LinkError'. The rollback
  -- has failed with a list of 'PFile.Path.RemoveError's. Since the rollback
  -- has failed, the profile passed to 'link' was partially linked - some links
  -- were created and should be removed manually.
    !Registry.LinkError
    -- ^ Cause of rollback.
    ![(Path.Absolute, Path.RemoveError)]
    -- ^ List of errors encountered during rollback.
    !Profile
    -- ^ 'Profile' passed to 'link'.
  | LinkError !Registry.LinkError
  -- ^ 'link' attempted to rollback due to 'Registry.LinkError'. The rollback
  -- has succeeded. The profile passed to 'link' was not linked.

showUnpackError :: UnpackError -> Text
showUnpackError :: UnpackError -> Text
showUnpackError = \case
  PurgeUnpackError PurgeError
cause -> PurgeError -> Text
showPurgeError PurgeError
cause
  UnlinkUnpackError UnlinkError
cause -> UnlinkError -> Text
showUnlinkError UnlinkError
cause
  UnpackRollbackError UnpackError
rollbackCause [(Absolute, RemoveError)]
rollbackErrors Profile {name :: Profile -> Name
name = Name Text
name}
    -> Text
"Unpacking of the \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" profile has failed"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with the following error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UnpackError -> Text
Registry.showUnpackError UnpackError
rollbackCause
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nAttempt to remove unpacked paths has failed"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with the following errors:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Absolute, RemoveError)] -> Text
showRollbackErrors [(Absolute, RemoveError)]
rollbackErrors
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Please fix the errors above and then remove the unpacked paths manually."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n`pfile` is not tracking these unpacked paths."
  UnpackError UnpackError
cause -> UnpackError -> Text
Registry.showUnpackError UnpackError
cause
  where
    showRollbackErrors :: [(Path.Absolute, Path.RemoveError)] -> Text
    showRollbackErrors :: [(Absolute, RemoveError)] -> Text
showRollbackErrors = [Text] -> Text
unlines ([Text] -> Text)
-> ([(Absolute, RemoveError)] -> [Text])
-> [(Absolute, RemoveError)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Absolute, RemoveError) -> Text)
-> [(Absolute, RemoveError)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Absolute
originPath, RemoveError
error) ->
      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
<> RemoveError -> Text
Path.showRemoveError RemoveError
error Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Error thrown by 'unpack'.
--
-- @since 0.1.0.0
data UnpackError
  = PurgeUnpackError !PurgeError
  -- ^ Error was encountered during 'purge'.
  | UnlinkUnpackError !UnlinkError
  -- ^ Error was encountered during 'unlink'.
  | UnpackRollbackError
  -- ^ 'unpack' attempted to rollback due to 'Registry.UnpackError'. The
  -- rollback has failed with a list of 'PFile.Path.RemoveError's. Since the
  -- rollback has failed, the profile passed to 'unpack' was partially unpacked
  -- - some entries were unpacked and should be removed manually.
    !Registry.UnpackError
    -- ^ Cause of rollback.
    ![(Path.Absolute, Path.RemoveError)]
    -- ^ List of errors encountered during rollback.
    !Profile
    -- ^ 'Profile' passed to 'unpack'.
  | UnpackError !Registry.UnpackError

showUnlinkedEntryValidateError :: UnlinkedEntryValidateError -> Text
showUnlinkedEntryValidateError :: UnlinkedEntryValidateError -> Text
showUnlinkedEntryValidateError = \case
  OriginOccupiedError Entry {mountPath :: Entry -> Mount
mountPath = Mount.Mount Absolute
mountPath, Absolute
originPath :: Entry -> Absolute
originPath :: Absolute
originPath}
    -> Text
"Unable to link origin " 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
" to entry " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
mountPath
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because the origin is occupied."

-- | Error thrown by 'validateUnlinkedEntry'.
--
-- @since 0.1.0.0
newtype UnlinkedEntryValidateError
  = OriginOccupiedError Entry
  -- ^ 'Entry's 'originPath' is occupied.

showPurgeError :: PurgeError -> Text
showPurgeError :: PurgeError -> Text
showPurgeError = \case
  TrashCanCreateError CreateError
cause -> CreateError -> Text
TrashCan.showCreateError CreateError
cause
  TrashError TrashError
cause -> TrashError -> Text
TrashCan.showTrashError TrashError
cause
  PurgeRollbackError
      PurgeError
rollbackCause
      [RestoreEntryError]
rollbackErrors
      Profile {name :: Profile -> Name
name = Name Text
name}
      TrashCan {Absolute
root :: Absolute
root :: TrashCan -> Absolute
root}
      Either [Absolute] Absolute
trashed
    -> Text
"Purge of the profile's \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" origins has failed"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with the following error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PurgeError -> Text
showPurgeError PurgeError
rollbackCause
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nTrashed origins restoring has failed with the following errors:\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([RestoreEntryError]
rollbackErrors [RestoreEntryError] -> (RestoreEntryError -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> RestoreEntryError -> Text
TrashCan.showRestoreEntryError [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
unlines)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Trash can with trashed origins could be found here: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
root
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\nA list of trashed origins could be found "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Absolute] -> Text)
-> (Absolute -> Text) -> Either [Absolute] Absolute -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\[Absolute]
paths -> Text
"below:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unlines (Absolute -> Text
Path.showAbsolute (Absolute -> Text) -> [Absolute] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Absolute]
paths))
        (\Absolute
path -> Text
"in the file: " 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
".")
        Either [Absolute] Absolute
trashed
  TrashCanRemoveError RemoveError
cause -> RemoveError -> Text
TrashCan.showRemoveError RemoveError
cause

-- | Error thrown by 'purge'.
--
-- @since 0.1.0.0
data PurgeError
  = TrashCanCreateError !TrashCan.CreateError
  -- ^ Error was encountered during 'TrashCan.create'.
  | TrashError !TrashCan.TrashError
  -- ^ Error was encountered during 'TrashCan.trash'.
  | PurgeRollbackError
  -- ^ 'purge' attempted to rollback due to 'PurgeError'. The rollback has
  -- failed with a list of 'TrashCan.RestoreEntryError's. Since the rollback
  -- has failed, the 'TrashCan.trash'ed entries of the 'Profile' are still kept
  -- inside of the 'TrashCan'.
    !PurgeError
    -- ^ Cause of rollback.
    ![TrashCan.RestoreEntryError]
    -- ^ List of errors encountered during rollback.
    !Profile
    -- ^ 'Profile' passed to 'purge'.
    !TrashCan
    -- ^ 'TrashCan' where 'TrashCan.trash'ed entries of the 'Profile' are kept.
    !(Either [Path.Absolute] Path.Absolute)
    -- ^ 'TrashCan's list of 'TrashCan.trash'ed entries is either dumped to
    -- a file with 'TrashCan.dumpTrashed' or provided as-is due to
    -- 'TrashCan.dumpTrashed' failure.
  | TrashCanRemoveError !TrashCan.RemoveError
  -- ^ Error was encountered during 'TrashCan.remove'.

-- | 'switch' options.
--
-- @since 0.1.0.0
newtype SwitchOptions
  = SwitchOptions
      { SwitchOptions -> Bool
forceRemoveOccupied :: Bool
      -- ^ When 'forceRemoveOccupied' is set, forcibly remove a filesystem's
      -- object where a link pointing at an entry inside of the 'Profile' is
      -- expected.
      }