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)
configFileName :: String
configFileName :: String
configFileName = String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
Package.name
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]
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
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 :: 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
Config -> IO Config
writeConfig (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ [Template] -> Config
Config []
errorNoTemplatesAvailable :: IO ()
errorNoTemplatesAvailable :: IO ()
errorNoTemplatesAvailable = do
String -> IO ()
err String
noTemplatesAvailable
String -> IO ()
warning String
tryAddingATemplate
IO ()
forall a. IO a
exitFailure
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]
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