{-# LANGUAGE DerivingStrategies #-}
module Aura.Settings.External
(
AuraConfig(..)
, getAuraConf
, auraConfig
, defaultAuraConf
, Config(..)
, config
) where
import Aura.Languages (langFromLocale)
import Aura.Settings
import Aura.Types
import RIO hiding (first, some, try)
import qualified RIO.ByteString as BS
import RIO.Directory
import qualified RIO.Map as M
import qualified RIO.Text as T
import Text.Megaparsec hiding (single)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
data AuraConfig = AuraConfig
{ acLang :: Maybe Language
, acEditor :: Maybe FilePath
, acUser :: Maybe User
, acBuildPath :: Maybe FilePath
, acASPath :: Maybe FilePath
, acVCSPath :: Maybe FilePath
, acAnalyse :: Maybe BuildSwitch }
deriving stock (Show)
defaultAuraConf :: FilePath
defaultAuraConf = "/etc/aura.conf"
getAuraConf :: FilePath -> IO Config
getAuraConf fp = do
exists <- doesFileExist fp
if not exists
then pure $ Config mempty
else do
file <- decodeUtf8Lenient <$> BS.readFile fp
pure . either (const $ Config M.empty) id $ parse config "aura config" file
auraConfig :: Config -> AuraConfig
auraConfig (Config m) = AuraConfig
{ acLang = one "language" >>= langFromLocale
, acEditor = T.unpack <$> one "editor"
, acUser = User <$> one "user"
, acBuildPath = T.unpack <$> one "buildpath"
, acASPath = T.unpack <$> one "allsourcepath"
, acVCSPath = T.unpack <$> one "vcspath"
, acAnalyse = one "analyse" >>= readMaybe . T.unpack >>= bool (Just NoPkgbuildCheck) Nothing
}
where
one x = M.lookup x m >>= listToMaybe
newtype Config = Config (Map Text [Text]) deriving (Show)
config :: Parsec Void Text Config
config = do
garbage
cs <- some $ fmap Right (try pair) <|> fmap Left single
eof
pure . Config . M.fromList $ rights cs
single :: Parsec Void Text ()
single = L.lexeme garbage . void $ manyTill letterChar newline
pair :: Parsec Void Text (Text, [Text])
pair = L.lexeme garbage $ do
n <- takeWhile1P Nothing (/= ' ')
space
void $ char '='
space
rest <- T.words <$> takeWhile1P Nothing (/= '\n')
pure (n, rest)
garbage :: Parsec Void Text ()
garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")