{-# LANGUAGE Rank2Types #-}

{- |
Copyright:  (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Functions to remove from your @life@ repository.
-}

module Life.Main.Remove
    ( lifeRemove
    ) where

import Colourista (warningMessage)
import Path (Abs, Path, Rel)
import Path.IO (getHomeDir, makeRelative, removeDirRecur, removeFile, resolveDir, resolveFile)
import Relude.Extra.Lens (Lens', (%~))

import Life.Configuration (LifeConfiguration, directoriesL, filesL, parseHomeLife, writeGlobalLife)
import Life.Core (LifePath (..), master)
import Life.Github (removeFromRepo, withSynced)
import Life.Message (abortCmd)
import Life.Path (LifeExistence (..), whatIsLife)

import qualified Data.Set as Set


-- | Remove path from existing life-configuration file.
lifeRemove :: LifePath -> IO ()
lifeRemove :: LifePath -> IO ()
lifeRemove lPath :: LifePath
lPath = IO LifeExistence
whatIsLife IO LifeExistence -> (LifeExistence -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- if one of them is missing -- abort
    NoLife -> Text -> Text -> IO ()
abortCmd "remove" ".life and docfiles/ do not exist"
    OnlyLife _ -> Text -> Text -> IO ()
abortCmd "remove" "dotfiles/ directory doesn't exist"
    OnlyRepo _ -> Text -> Text -> IO ()
abortCmd "remove" ".life file doesn't exist"
    -- actual life remove process
    Both _ _ -> Branch -> IO () -> IO ()
forall a. Branch -> IO a -> IO a
withSynced Branch
master (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Path Abs Dir
homeDirPath  <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
        case LifePath
lPath of
            (File path :: FilePath
path) -> do
                Path Rel File
filePath <- Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
homeDirPath FilePath
path IO (Path Abs File)
-> (Path Abs File -> IO (Path Rel File)) -> IO (Path Rel File)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs Dir -> Path Abs File -> IO (RelPath (Path Abs File))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
homeDirPath
                Lens' LifeConfiguration (Set (Path Rel File))
-> (Path Abs File -> IO ()) -> Path Rel File -> IO ()
forall t.
Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Abs t -> IO ()) -> Path Rel t -> IO ()
resolveConfiguration Lens' LifeConfiguration (Set (Path Rel File))
filesL Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile Path Rel File
filePath
            (Dir path :: FilePath
path)  -> do
                Path Rel Dir
dirPath <- Path Abs Dir -> FilePath -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
resolveDir Path Abs Dir
homeDirPath FilePath
path IO (Path Abs Dir)
-> (Path Abs Dir -> IO (Path Rel Dir)) -> IO (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs Dir -> Path Abs Dir -> IO (RelPath (Path Abs Dir))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
homeDirPath
                Lens' LifeConfiguration (Set (Path Rel Dir))
-> (Path Abs Dir -> IO ()) -> Path Rel Dir -> IO ()
forall t.
Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Abs t -> IO ()) -> Path Rel t -> IO ()
resolveConfiguration Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path Rel Dir
dirPath

resolveConfiguration
    :: Lens' LifeConfiguration (Set (Path Rel t))
    -> (Path Abs t -> IO ()) -- ^ function to remove object
    -> Path Rel t
    -> IO ()
resolveConfiguration :: Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Abs t -> IO ()) -> Path Rel t -> IO ()
resolveConfiguration confLens :: Lens' LifeConfiguration (Set (Path Rel t))
confLens removeFun :: Path Abs t -> IO ()
removeFun path :: Path Rel t
path = do
    LifeConfiguration
configuration <- IO LifeConfiguration
parseHomeLife

    let newConfiguration :: LifeConfiguration
newConfiguration = LifeConfiguration
configuration LifeConfiguration
-> (LifeConfiguration -> LifeConfiguration) -> LifeConfiguration
forall a b. a -> (a -> b) -> b
& Lens' LifeConfiguration (Set (Path Rel t))
confLens Lens' LifeConfiguration (Set (Path Rel t))
-> (Set (Path Rel t) -> Set (Path Rel t))
-> LifeConfiguration
-> LifeConfiguration
forall s a. Lens' s a -> (a -> a) -> s -> s
%~ Path Rel t -> Set (Path Rel t) -> Set (Path Rel t)
forall a. Ord a => a -> Set a -> Set a
Set.delete Path Rel t
path
    if LifeConfiguration
configuration LifeConfiguration -> LifeConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== LifeConfiguration
newConfiguration
    then Text -> IO ()
warningMessage "File or directory is not tracked" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
    else do
        LifeConfiguration -> IO ()
writeGlobalLife LifeConfiguration
newConfiguration
        (Path Abs t -> IO ()) -> Path Rel t -> IO ()
forall t. (Path Abs t -> IO ()) -> Path Rel t -> IO ()
removeFromRepo Path Abs t -> IO ()
removeFun Path Rel t
path