packages feed

life-sync-1.1.1.0: src/Life/Main/Add.hs

{-# LANGUAGE Rank2Types #-}

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

Functions to add file/directory to your life.
-}

module Life.Main.Add
    ( lifeAdd
    ) where

import Colourista (errorMessage, infoMessage, warningMessage)
import Path (Abs, Dir, File, Path, Rel, parent, toFilePath, (</>))
import Path.IO (copyDirRecur, copyFile, doesDirExist, doesFileExist, ensureDir, getHomeDir,
                makeRelative, resolveDir, resolveFile)
import Relude.Extra.Lens (Lens', (%~))

import Life.Configuration (LifeConfiguration, directoriesL, filesL, parseHomeLife, writeGlobalLife)
import Life.Core (LifePath (..), master)
import Life.Github (addToRepo, withSynced)
import Life.Main.Init (lifeInitQuestion)
import Life.Message (abortCmd)
import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife)

import qualified Data.Set as Set


-- | Add path to existing life-configuration file.
lifeAdd :: LifePath -> IO ()
lifeAdd lPath = whatIsLife >>= \case
    -- actual life add process
    Both _ _ -> withSynced master addingProcess

    -- if one of them is missing -- abort
    OnlyRepo _ -> abortCmd "add" ".life file doesn't exist"
    OnlyLife _ -> abortCmd "add" "dotfiles/ directory doesn't exist"

    -- if both .life and dotfiles doesn't exist go to init process
    NoLife -> lifeInitQuestion "add" addingProcess
  where
    addingProcess :: IO ()
    addingProcess = do
        homeDirPath <- getHomeDir
        case lPath of
            (File path) -> do
                filePath <- resolveFile homeDirPath path
                whenM (doesFileExist filePath) $ do
                    relativeFile <- makeRelative homeDirPath filePath
                    resolveConfiguration filesL checkEqualFiles copyFileWithDir relativeFile

            (Dir path)  -> do
                dirPath <- resolveDir homeDirPath path
                whenM (doesDirExist dirPath) $ do
                    relativeDir <- makeRelative homeDirPath dirPath
                    resolveConfiguration directoriesL checkEqualDirs copyDirRecur relativeDir

            -- We didn't find the file
        errorMessage "The file/directory doesn't exist" >> exitFailure

resolveConfiguration
    :: Lens' LifeConfiguration (Set (Path Rel t))
    -> (Path Rel t -> IO Bool)
    -> (Path Abs t -> Path Abs t -> IO ())
    -> Path Rel t
    -> IO ()
resolveConfiguration confLens checkContent copyFun path = do
    configuration <- parseHomeLife
    let newConfiguration = configuration & confLens %~ Set.insert path

    isSameAsInRepo <- checkContent path
    if isSameAsInRepo
    then do
        let pathText = toText $ toFilePath path
        infoMessage $ "Path " <> pathText <> " is already latest version in repository"
    else do
        writeGlobalLife newConfiguration
        addToRepo copyFun path

    exitSuccess

checkEqualFiles :: Path Rel File -> IO Bool
checkEqualFiles path = do
    homeFilePath <- relativeToHome path
    repoFilePath <- relativeToHome (repoName </> path)

    isRepoFile <- doesFileExist repoFilePath
    if isRepoFile
    then do
        originContent <- readFileLBS $ toFilePath homeFilePath
        repoContent <- readFileLBS $ toFilePath repoFilePath

        pure $ originContent == repoContent
    else pure False

checkEqualDirs :: Path Rel Dir -> IO Bool
checkEqualDirs _ = do
    warningMessage "TODO: check directories to be equal"
    pure False

-- | Just like 'copyFile' but also creates directory for the second file.
copyFileWithDir :: Path Abs File -> Path Abs File -> IO ()
copyFileWithDir from to = ensureDir (parent to) >> copyFile from to