{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedLists #-}
module Taskell.IO.Config where
import ClassyPrelude
import qualified Data.Text.IO as T (readFile)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist,
getHomeDirectory)
import System.Environment (lookupEnv)
import Brick (AttrMap)
import Brick.Themes (loadCustomizations, themeToAttrMap)
import Data.FileEmbed (embedFile)
import Data.Ini.Config
import Taskell.IO.Keyboard (addMissing, badMapping, defaultBindings)
import Taskell.IO.Keyboard.Parser (bindings)
import Taskell.IO.Keyboard.Types (Bindings)
import Taskell.UI.Theme (defaultTheme)
import qualified Taskell.IO.Config.General as General
import qualified Taskell.IO.Config.GitHub as GitHub
import qualified Taskell.IO.Config.Layout as Layout
import qualified Taskell.IO.Config.Markdown as Markdown
import qualified Taskell.IO.Config.Trello as Trello
data Config = Config
{ Config -> Config
general :: General.Config
, Config -> Config
layout :: Layout.Config
, Config -> Config
markdown :: Markdown.Config
, Config -> Config
trello :: Trello.Config
, Config -> Config
github :: GitHub.Config
}
debugging :: Config -> Bool
debugging :: Config -> Bool
debugging Config
config = Config -> Bool
General.debug (Config -> Config
general Config
config)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
Config -> Config -> Config -> Config -> Config -> Config
Config
Config
General.defaultConfig
Config
Layout.defaultConfig
Config
Markdown.defaultConfig
Config
Trello.defaultConfig
Config
GitHub.defaultConfig
directoryName :: FilePath
directoryName :: FilePath
directoryName = FilePath
"taskell"
legacyConfigPath :: IO FilePath
legacyConfigPath :: IO FilePath
legacyConfigPath = (FilePath -> FilePath -> FilePath
</> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
directoryName) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
xdgDefaultConfig :: IO FilePath
xdgDefaultConfig :: IO FilePath
xdgDefaultConfig = (FilePath -> FilePath -> FilePath
</> FilePath
".config") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
xdgConfigPath :: IO FilePath
xdgConfigPath :: IO FilePath
xdgConfigPath =
(FilePath -> FilePath -> FilePath
</> FilePath
directoryName) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Maybe FilePath -> FilePath)
-> IO FilePath -> IO (Maybe FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
xdgDefaultConfig IO (Maybe FilePath -> FilePath)
-> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XDG_CONFIG_HOME")
getDir :: IO FilePath
getDir :: IO FilePath
getDir = IO FilePath
legacyConfigPath IO FilePath -> (FilePath -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO Bool
doesDirectoryExist IO Bool -> (Bool -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath -> IO FilePath -> Bool -> IO FilePath
forall a. a -> a -> Bool -> a
bool IO FilePath
xdgConfigPath IO FilePath
legacyConfigPath
themePath :: FilePath -> FilePath
themePath :: FilePath -> FilePath
themePath = (FilePath -> FilePath -> FilePath
</> FilePath
"theme.ini")
configPath :: FilePath -> FilePath
configPath :: FilePath -> FilePath
configPath = (FilePath -> FilePath -> FilePath
</> FilePath
"config.ini")
templatePath :: FilePath -> FilePath
templatePath :: FilePath -> FilePath
templatePath = (FilePath -> FilePath -> FilePath
</> FilePath
"template.md")
bindingsPath :: FilePath -> FilePath
bindingsPath :: FilePath -> FilePath
bindingsPath = (FilePath -> FilePath -> FilePath
</> FilePath
"bindings.ini")
setup :: IO Config
setup :: IO Config
setup
= do
FilePath
dir <- IO FilePath
getDir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
FilePath -> ByteString -> IO ()
create (FilePath -> FilePath
configPath FilePath
dir) $(embedFile "templates/config.ini")
FilePath -> ByteString -> IO ()
create (FilePath -> FilePath
themePath FilePath
dir) $(embedFile "templates/theme.ini")
FilePath -> ByteString -> IO ()
create (FilePath -> FilePath
templatePath FilePath
dir) $(embedFile "templates/template.md")
FilePath -> ByteString -> IO ()
create (FilePath -> FilePath
bindingsPath FilePath
dir) $(embedFile "templates/bindings.ini")
IO Config
getConfig
create :: FilePath -> ByteString -> IO ()
create :: FilePath -> ByteString -> IO ()
create FilePath
path ByteString
contents = FilePath -> IO Bool
doesFileExist FilePath
path IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFile FilePath
path ByteString
contents)
configParser :: IniParser Config
configParser :: IniParser Config
configParser =
Config -> Config -> Config -> Config -> Config -> Config
Config (Config -> Config -> Config -> Config -> Config -> Config)
-> IniParser Config
-> IniParser (Config -> Config -> Config -> Config -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IniParser Config
General.parser IniParser (Config -> Config -> Config -> Config -> Config)
-> IniParser Config
-> IniParser (Config -> Config -> Config -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IniParser Config
Layout.parser IniParser (Config -> Config -> Config -> Config)
-> IniParser Config -> IniParser (Config -> Config -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IniParser Config
Markdown.parser IniParser (Config -> Config -> Config)
-> IniParser Config -> IniParser (Config -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IniParser Config
Trello.parser IniParser (Config -> Config)
-> IniParser Config -> IniParser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
IniParser Config
GitHub.parser
getConfig :: IO Config
getConfig :: IO Config
getConfig = do
Text
content <- FilePath -> IO Text
T.readFile (FilePath -> IO Text) -> IO FilePath -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> FilePath
configPath (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getDir)
case Text -> IniParser Config -> Either FilePath Config
forall a. Text -> IniParser a -> Either FilePath a
parseIniFile Text
content IniParser Config
configParser of
Right Config
config -> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config
Left FilePath
s -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn ([Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack ([Element Text] -> Text) -> [Element Text] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"config.ini: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s) IO () -> Config -> IO Config
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Config
defaultConfig
getBindings :: IO Bindings
getBindings :: IO Bindings
getBindings = do
Either Text Bindings
bnds <- Text -> Either Text Bindings
bindings (Text -> Either Text Bindings)
-> IO Text -> IO (Either Text Bindings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Text
T.readFile (FilePath -> IO Text) -> IO FilePath -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> FilePath
bindingsPath (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getDir))
case Bindings -> Bindings
addMissing (Bindings -> Bindings)
-> Either Text Bindings -> Either Text Bindings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bindings -> Either Text Bindings
badMapping (Bindings -> Either Text Bindings)
-> Either Text Bindings -> Either Text Bindings
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either Text Bindings
bnds) of
Right Bindings
b -> Bindings -> IO Bindings
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bindings
b
Left Text
err ->
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text
"bindings.ini: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - using default bindings") IO () -> Bindings -> IO Bindings
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bindings
defaultBindings
generateAttrMap :: IO AttrMap
generateAttrMap :: IO AttrMap
generateAttrMap = do
FilePath
dir <- IO FilePath
getDir
Either FilePath Theme
customizedTheme <- FilePath -> Theme -> IO (Either FilePath Theme)
loadCustomizations (FilePath -> FilePath
themePath FilePath
dir) Theme
defaultTheme
case Either FilePath Theme
customizedTheme of
Right Theme
theme -> AttrMap -> IO AttrMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttrMap -> IO AttrMap) -> AttrMap -> IO AttrMap
forall a b. (a -> b) -> a -> b
$ Theme -> AttrMap
themeToAttrMap Theme
theme
Left FilePath
s -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn ([Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack ([Element Text] -> Text) -> [Element Text] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"theme.ini: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s) IO () -> AttrMap -> IO AttrMap
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Theme -> AttrMap
themeToAttrMap Theme
defaultTheme