module Core.Toml
    ( Config(..)
    , getUserConfig  -- :: IO Config
    ) where

import Core.Util

import Data.Text.IO qualified as T
import Toml         qualified

import Toml (Codec (Codec, codecRead), TomlCodec, (.=), (<!>))


-- | Hdmenu's config file.
type Config :: Type
data Config = Config
    { Config -> [ByteString]
files    :: [ByteString]
    , Config -> ShowBS
open     :: ShowBS
    , Config -> FilePath
dmenuExe :: FilePath
    , Config -> ShowBS
term     :: ShowBS
    , Config -> [ByteString]
tty      :: [ByteString]
    , Config -> Double
decay    :: Double
    , Config -> FilePath
histPath :: FilePath
      -- ^ Command line option, NOT specifiable in the config file.
    }

-- | Empty config type with all the default values.
defaultCfg :: Config
defaultCfg :: Config
defaultCfg = Config
    { files :: [ByteString]
files    = []
    , dmenuExe :: FilePath
dmenuExe = FilePath
"dmenu"
    , open :: ShowBS
open     = (ByteString
"xdg-open" <>)
    , term :: ShowBS
term     = (ByteString
"xterm"    <>)
    , tty :: [ByteString]
tty      = []
    , decay :: Double
decay    = Double
1
    , histPath :: FilePath
histPath = FilePath
""
    }

-- | Parse the config file.
configCodec :: TomlCodec Config
configCodec :: TomlCodec Config
configCodec = [ByteString]
-> ShowBS
-> FilePath
-> ShowBS
-> [ByteString]
-> Double
-> FilePath
-> Config
Config
    ([ByteString]
 -> ShowBS
 -> FilePath
 -> ShowBS
 -> [ByteString]
 -> Double
 -> FilePath
 -> Config)
-> Codec Config [ByteString]
-> Codec
     Config
     (ShowBS
      -> FilePath
      -> ShowBS
      -> [ByteString]
      -> Double
      -> FilePath
      -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec [ByteString] -> TomlCodec [ByteString]
defFiles (TomlBiMap ByteString AnyValue -> Key -> TomlCodec [ByteString]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap ByteString AnyValue
Toml._ByteString Key
"files")           TomlCodec [ByteString]
-> (Config -> [ByteString]) -> Codec Config [ByteString]
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> [ByteString]
files
    Codec
  Config
  (ShowBS
   -> FilePath
   -> ShowBS
   -> [ByteString]
   -> Double
   -> FilePath
   -> Config)
-> Codec Config ShowBS
-> Codec
     Config
     (FilePath
      -> ShowBS -> [ByteString] -> Double -> FilePath -> Config)
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec ByteString -> TomlCodec ShowBS
toDL (TomlCodec ByteString -> TomlCodec ByteString
defOpen (Key -> TomlCodec ByteString
Toml.byteString Key
"open"))                    TomlCodec ShowBS -> (Config -> ShowBS) -> Codec Config ShowBS
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> ShowBS
open
    Codec
  Config
  (FilePath
   -> ShowBS -> [ByteString] -> Double -> FilePath -> Config)
-> Codec Config FilePath
-> Codec
     Config (ShowBS -> [ByteString] -> Double -> FilePath -> Config)
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec FilePath -> TomlCodec FilePath
defDmenu (Key -> TomlCodec FilePath
Toml.string Key
"executable")                        TomlCodec FilePath -> (Config -> FilePath) -> Codec Config FilePath
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> FilePath
dmenuExe
    Codec
  Config (ShowBS -> [ByteString] -> Double -> FilePath -> Config)
-> Codec Config ShowBS
-> Codec Config ([ByteString] -> Double -> FilePath -> Config)
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec ByteString -> TomlCodec ShowBS
toDL (TomlCodec ByteString -> TomlCodec ByteString
defTerm (Key -> TomlCodec ByteString
Toml.byteString Key
"terminal"))                TomlCodec ShowBS -> (Config -> ShowBS) -> Codec Config ShowBS
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> ShowBS
term
    Codec Config ([ByteString] -> Double -> FilePath -> Config)
-> Codec Config [ByteString]
-> Codec Config (Double -> FilePath -> Config)
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec [ByteString] -> TomlCodec [ByteString]
defTtyProgs (TomlBiMap ByteString AnyValue -> Key -> TomlCodec [ByteString]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap ByteString AnyValue
Toml._ByteString Key
"tty-programs") TomlCodec [ByteString]
-> (Config -> [ByteString]) -> Codec Config [ByteString]
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> [ByteString]
tty
    Codec Config (Double -> FilePath -> Config)
-> Codec Config Double -> Codec Config (FilePath -> Config)
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec Double -> TomlCodec Double
defDecay (Key -> TomlCodec Double
Toml.double Key
"decay")                             TomlCodec Double -> (Config -> Double) -> Codec Config Double
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Config -> Double
decay
    Codec Config (FilePath -> Config)
-> Codec Config FilePath -> TomlCodec Config
forall a b.
Codec Config (a -> b) -> Codec Config a -> Codec Config b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Codec Config FilePath
forall a. a -> Codec Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
""
  where
    -- Parse an option or—in case it's missing—return a default value.
    tomlWithDefault :: a -> TomlCodec a -> TomlCodec a
    tomlWithDefault :: forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault a
def codec :: TomlCodec a
codec@Codec{ TomlEnv a
codecRead :: forall i o. Codec i o -> TomlEnv o
codecRead :: TomlEnv a
codecRead } =
        TomlCodec a
codec { codecRead = codecRead <!> const (pure def) }

    TomlCodec ByteString -> TomlCodec ShowBS
toDL :: TomlCodec ByteString -> TomlCodec ShowBS
        = (ShowBS -> ByteString)
-> (ByteString -> ShowBS)
-> TomlCodec ByteString
-> TomlCodec ShowBS
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (ShowBS -> ShowBS
forall a b. (a -> b) -> a -> b
$ ByteString
"") ByteString -> ShowBS
forall a. Semigroup a => a -> a -> a
(<>)

    defFiles :: TomlCodec [ByteString] -> TomlCodec [ByteString]
defFiles    = [ByteString] -> TomlCodec [ByteString] -> TomlCodec [ByteString]
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> [ByteString]
files    Config
defaultCfg)
    defOpen :: TomlCodec ByteString -> TomlCodec ByteString
defOpen     = ByteString -> TomlCodec ByteString -> TomlCodec ByteString
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> ShowBS
open     Config
defaultCfg ByteString
"")
    defDmenu :: TomlCodec FilePath -> TomlCodec FilePath
defDmenu    = FilePath -> TomlCodec FilePath -> TomlCodec FilePath
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> FilePath
dmenuExe Config
defaultCfg)
    defTerm :: TomlCodec ByteString -> TomlCodec ByteString
defTerm     = ByteString -> TomlCodec ByteString -> TomlCodec ByteString
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> ShowBS
term     Config
defaultCfg ByteString
"")
    defTtyProgs :: TomlCodec [ByteString] -> TomlCodec [ByteString]
defTtyProgs = [ByteString] -> TomlCodec [ByteString] -> TomlCodec [ByteString]
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> [ByteString]
tty      Config
defaultCfg)
    defDecay :: TomlCodec Double -> TomlCodec Double
defDecay    = Double -> TomlCodec Double -> TomlCodec Double
forall a. a -> TomlCodec a -> TomlCodec a
tomlWithDefault (Config -> Double
decay    Config
defaultCfg)

-- | Try to find a user config and, if it exists, parse it.
getUserConfig :: IO Config
getUserConfig :: IO Config
getUserConfig = do
    -- Default path where to look for the config file:
    --          ~/.config/hdmenu/hdmenu.toml
    FilePath
cfgFile <- IO FilePath
hdmenuPath IO FilePath -> FilePath -> IO FilePath
forall (f :: * -> *).
Functor f =>
f FilePath -> FilePath -> f FilePath
<</>> FilePath
"hdmenu.toml"
    IO Bool -> IO Config -> IO Config -> IO Config
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
cfgFile)
        (Config -> Either [TomlDecodeError] Config -> Config
forall b a. b -> Either a b -> b
fromRight Config
defaultCfg (Either [TomlDecodeError] Config -> Config)
-> (Text -> Either [TomlDecodeError] Config) -> Text -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TomlCodec Config -> Text -> Either [TomlDecodeError] Config
forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
Toml.decode TomlCodec Config
configCodec (Text -> Config) -> IO Text -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
cfgFile)
        (Config -> IO Config
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
defaultCfg)