{-# 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
    -- create config dir
 = do
    FilePath
dir <- IO FilePath
getDir
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
    -- create config files
    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")
    -- get config
    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

-- generate theme
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