module Rob.Config where

import qualified Rob.Package as Package
import Rob.Logger (err, warning, success, info, flatten)
import Rob.UserMessages (configFileFound, noConfigFileFound, configFileCreated, noTemplatesAvailable, tryAddingATemplate)
import Rob.Types (Config(..), Template(..))

import Data.Maybe
import System.Exit
import System.FilePath (joinPath)
import System.Directory (getHomeDirectory, doesFileExist)
import Data.Yaml (encodeFile, decodeFileEither)

-- | Get the config file name
configFileName :: String
configFileName :: String
configFileName = String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
Package.name

-- | Get the whole path to the config file
configFilePath :: IO FilePath
configFilePath :: IO String
configFilePath = do
  String
home <- IO String
getHomeDirectory
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
home, String
configFileName]

-- | Write the config file and return it
writeConfig :: Config -> IO Config
writeConfig :: Config -> IO Config
writeConfig Config
config = do
  IO String
configFilePath IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
path -> String -> Config -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile String
path Config
config
  Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config

-- | Read the config file and return it
readConfig :: FilePath -> IO Config
readConfig :: String -> IO Config
readConfig String
path = (ParseException -> Config)
-> (Config -> Config) -> Either ParseException Config -> Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Config
forall a. HasCallStack => String -> a
error (String -> Config)
-> (ParseException -> String) -> ParseException -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
forall a. Show a => a -> String
show) Config -> Config
forall a. a -> a
id (Either ParseException Config -> Config)
-> IO (Either ParseException Config) -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either ParseException Config)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
path

-- | Get the current Config file Data
-- | If it doesn't exist it will create a new one
get :: IO Config
get :: IO Config
get = do
  String
path <- IO String
configFilePath
  Bool
hasConfigPath <- String -> IO Bool
doesFileExist String
path
  if Bool
hasConfigPath
    then do
      String -> IO ()
success (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
configFileFound String
path
      String -> IO Config
readConfig String
path
    else do
      String -> IO ()
warning (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
noConfigFileFound String
configFileName
      (String -> IO ()) -> [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m ()
flatten String -> IO ()
info ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String]
configFileCreated String
path
      -- return an empty Config object and write it in the home directory
      Config -> IO Config
writeConfig (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ [Template] -> Config
Config []

-- | Dispatch the no templates available error
errorNoTemplatesAvailable :: IO ()
errorNoTemplatesAvailable :: IO ()
errorNoTemplatesAvailable = do
  String -> IO ()
err String
noTemplatesAvailable
  String -> IO ()
warning String
tryAddingATemplate
  IO ()
forall a. IO a
exitFailure

-- | Add a new template to the config object and write it
addTemplate :: Config -> String -> String -> IO Config
addTemplate :: Config -> String -> String -> IO Config
addTemplate (Config [Template]
templates) String
name String
path = Config -> IO Config
writeConfig (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ [Template] -> Config
Config [Template]
newTemplates
  where
    newTemplate :: Template
newTemplate = String -> String -> Template
Template String
name String
path
    newTemplates :: [Template]
newTemplates = if Template
newTemplate Template -> [Template] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Template]
templates then
        (Template -> Template) -> [Template] -> [Template]
forall a b. (a -> b) -> [a] -> [b]
map (\Template
t -> if Template
t Template -> Template -> Bool
forall a. Eq a => a -> a -> Bool
== Template
newTemplate then Template
newTemplate else Template
t) [Template]
templates
      else
        [Template]
templates [Template] -> [Template] -> [Template]
forall a. [a] -> [a] -> [a]
++ [Template
newTemplate]

-- | Delete a template from the list of templates
deleteTemplate :: Config -> String -> IO Config
deleteTemplate :: Config -> String -> IO Config
deleteTemplate (Config [Template]
templates) String
nameToRemove = Config -> IO Config
writeConfig (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ [Template] -> Config
Config [Template]
newTemplates
  where
    newTemplates :: [Template]
newTemplates = (\(Template String
name String
_) -> String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
nameToRemove) (Template -> Bool) -> [Template] -> [Template]
forall a. (a -> Bool) -> [a] -> [a]
`filter` [Template]
templates