Config.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.ZRE.Config where

import System.Environment
import System.Directory
import System.FilePath.Posix
import qualified Data.ByteString.Char8 as B

import Network.ZRE.Types

import Data.Default (def)
import qualified Data.Either
import qualified Data.Foldable

import Options.Applicative
import Network.ZRE.Options

import qualified Data.Text
import qualified Data.Attoparsec.Text

trueStr :: Data.Attoparsec.Text.Parser Bool
trueStr = pure True <$> (
    Data.Foldable.asum
  . map Data.Attoparsec.Text.string $ [ "true", "t", "yes", "y" ]
  )

falseStr :: Data.Attoparsec.Text.Parser Bool
falseStr =  pure False <$> (
    Data.Foldable.asum
  . map Data.Attoparsec.Text.string $ [ "false" , "f" , "no" , "n" ]
  )

iniFileToArgs :: [String] -> String -> [String]
iniFileToArgs sections file =
    concatMap (\(k, v) -> ["--" ++ k] ++ (if v /= "" then [v] else []))
  . map (Data.Text.unpack <$>)
  . map (\(k, v) -> if Data.Either.isRight $ Data.Attoparsec.Text.parseOnly (trueStr) v then (k, "") else (k, v)) -- fix --flag true -> --flag
  . filter (\(_, v) -> case Data.Attoparsec.Text.parseOnly (trueStr <|> falseStr) v of
      Left _e -> True
      Right b -> b)
  . map (Data.Text.pack <$>)
  . map (\x ->
          let t = takeWhile (flip elem $ '-':['a'..'z'])
          in (t x, dropWhile (== ' ') $ drop 1 $ dropWhile (/= '=') x)
        )
  . concatMap (\(_section, fields) -> fields)
  . filter (\(section, _fields) -> section `elem` sections)
  . groupBySections
  . filter (\(x:_xs) -> x /= '#') -- comments
  . filter (/="") -- empty
  $ lines file

-- transform [ "[zre]", "debug = false" "gossip=localhost:31337" "[zrecat]" "bufsize = 300"
-- to
-- [("zre", ["debug=false", "gossip=localhost:31337"]), ("zrecat", ["bufsize=300"])]
groupBySections :: [String] -> [(String, [String])]
groupBySections lines' = go lines'
  where
    go [] = []
    go ((x:xs):ls) | x == '[' = (takeWhile (flip elem $ '-':['a'..'z']) xs, keyVals ls):go ls
    go (_l:ls)     | otherwise = go ls
    keyVals [] = []
    keyVals ls = takeWhile (\(x:_) -> '[' /= x) ls

-- | Override config value from new iff it differs to default value
--
-- This could be done with `gzipWithT` and Generics
overrideNonDefault :: ZRECfg -> ZRECfg -> ZRECfg
overrideNonDefault orig new = ZRECfg {
    zreNamed         = ovr (zreNamed orig)         (zreNamed new)         (zreNamed def)
  , zreQuietPeriod   = ovr (zreQuietPeriod orig)   (zreQuietPeriod new)   (zreQuietPeriod def)
  , zreQuietPingRate = ovr (zreQuietPingRate orig) (zreQuietPingRate new) (zreQuietPingRate def)
  , zreDeadPeriod    = ovr (zreDeadPeriod orig)    (zreDeadPeriod new)    (zreDeadPeriod def)
  , zreBeaconPeriod  = ovr (zreBeaconPeriod orig)  (zreBeaconPeriod new)  (zreBeaconPeriod def)
  , zreInterfaces    = ovr (zreInterfaces orig)    (zreInterfaces new)    (zreInterfaces def)
  , zreMCast         = ovr (zreMCast orig)         (zreMCast new)         (zreMCast def)
  , zreZGossip       = ovr (zreZGossip orig)       (zreZGossip new)       (zreZGossip def)
  , zreDbg           = ovr (zreDbg orig)           (zreDbg new)           (zreDbg def)
  }
  where
    ovr :: (Eq a) => a -> a -> a -> a
    ovr _o n d | n /= d = n
    ovr o _n _d | otherwise = o

parseZRECfg :: String -> FilePath -> IO (Either String ZRECfg)
parseZRECfg exeName fpath = do
  isFile <- doesFileExist fpath
  case isFile of
    False -> pure $ Left "No such file"
    True -> do
      f <- readFile fpath
      let cfg = execParserPure defaultPrefs opts (iniFileToArgs ["zre", exeName] f)
      case cfg of
        -- we always fail when one of the configs fails to parse
        Failure e -> error $ fst $ renderFailure e ""
        Success cfg' -> return $ Right $ cfg'
        CompletionInvoked _ -> error "No completion"
  where
    opts = info (parseOptions <**> helper)
      ( fullDesc
     <> progDesc "ZRE"
     <> header "zre tools" )

-- The order is
-- * path of @ZRECFG@ env iff set
-- * @/etc/zre.conf@
-- * @~/.zre.conf@
-- * @default@
--
-- This also tries to parse subsection for zre programs according to their
-- name and construct correct command line for these so we can do
--
-- @[zrecat]@
-- @bufsize = 1024@
--
-- If @ZRENAME@ env var is set, it overrides name field in the result config.
envZRECfg :: String -> IO (ZRECfg)
envZRECfg exeName = do
  menv  <- lookupEnv "ZRECFG"
  mname <- lookupEnv "ZRENAME"

  hom <- getHomeDirectory

  cfg <- asumOneConfig [
      maybe (pure $ Left "No ZRECFG env") (parseZRECfg exeName) menv
    , parseZRECfg exeName "/etc/zre.conf"
    , parseZRECfg exeName $ hom </> ".zre.conf"
    , return $ Right def
    ]
  return $ maybeUpdateName cfg mname
  where
    maybeUpdateName cfg mname = maybe cfg (\x -> cfg { zreNamed = B.pack x}) mname
    asumOneConfig [] = error "Can't happen"
    asumOneConfig (x:xs) = x >>= \y -> case y of
      Left _e -> asumOneConfig xs
      Right cfg -> return $ cfg