{-# LANGUAGE TemplateHaskell #-}

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

This module contains utility functions to work with shell.
-}

module Life.Path
    ( -- * Constants
      lifePath
    , repoName

      -- * Functions
    , LifeExistence (..)
    , createDirInHome
    , relativeToHome
    , whatIsLife
    ) where

import Path (Abs, Dir, File, Path, Rel, mkRelDir, mkRelFile, (</>))
import Path.IO (createDirIfMissing, doesDirExist, doesFileExist, getHomeDir)


----------------------------------------------------------------------------
-- Global constants
----------------------------------------------------------------------------

-- | Name for life configuration file.
lifePath :: Path Rel File
lifePath :: Path Rel File
lifePath = $(mkRelFile ".life")

-- TODO: consistent naming with @lifePath@ ?
-- | Default repository name for life configuration files.
repoName :: Path Rel Dir
repoName :: Path Rel Dir
repoName = $(mkRelDir "dotfiles/")

----------------------------------------------------------------------------
-- Shell interface
----------------------------------------------------------------------------

-- | Creates directory with name "folder" under "~/folder".
createDirInHome :: Path Rel Dir -> IO (Path Abs Dir)
createDirInHome :: Path Rel Dir -> IO (Path Abs Dir)
createDirInHome dirName :: Path Rel Dir
dirName = do
    Path Abs Dir
newDir <- Path Rel Dir -> IO (Path Abs Dir)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel Dir
dirName
    Path Abs Dir
newDir Path Abs Dir -> IO () -> IO (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
False Path Abs Dir
newDir

-- | Creates path relative to home directory
relativeToHome :: MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome :: Path Rel t -> m (Path Abs t)
relativeToHome path :: Path Rel t
path = do
    Path Abs Dir
homeDir <- m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
    Path Abs t -> m (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs t -> m (Path Abs t)) -> Path Abs t -> m (Path Abs t)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
homeDir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
path

data LifeExistence
    = NoLife
    | OnlyLife (Path Abs File)
    | OnlyRepo (Path Abs Dir)
    | Both (Path Abs File) (Path Abs Dir)

whatIsLife :: IO LifeExistence
whatIsLife :: IO LifeExistence
whatIsLife = do
    Path Abs File
lifeFile <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel File
lifePath
    Path Abs Dir
repoDir  <- Path Rel Dir -> IO (Path Abs Dir)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel Dir
repoName

    Bool
isFile <- Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
lifeFile
    Bool
isDir  <- Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist  Path Abs Dir
repoDir

    LifeExistence -> IO LifeExistence
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LifeExistence -> IO LifeExistence)
-> LifeExistence -> IO LifeExistence
forall a b. (a -> b) -> a -> b
$ case (Bool
isFile, Bool
isDir) of
        (False, False) -> LifeExistence
NoLife
        (True, False)  -> Path Abs File -> LifeExistence
OnlyLife Path Abs File
lifeFile
        (False, True)  -> Path Abs Dir -> LifeExistence
OnlyRepo Path Abs Dir
repoDir
        (True, True)   -> Path Abs File -> Path Abs Dir -> LifeExistence
Both Path Abs File
lifeFile Path Abs Dir
repoDir