{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
module Aura.Settings.External
(
AuraConfig(..)
, getAuraConf
, auraConfig
, Config(..)
, config
) where
import Aura.Languages (langFromLocale)
import Aura.Settings
import Aura.Shell (getTrueUser)
import Aura.Types
import Aura.Utils (hush)
import RIO hiding (some, try)
import qualified RIO.ByteString as BS
import RIO.Directory
import RIO.FilePath ((</>))
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)
userAuraConfPath :: Environment -> Maybe FilePath
userAuraConfPath env = case getTrueUser env of
Nothing -> Nothing
Just (User "root") -> Nothing
Just (User u) -> Just $ "/home/" </> T.unpack u </> ".config/aura/aura.conf"
systemAuraConfPath :: FilePath
systemAuraConfPath = "/etc/aura.conf"
getAuraConfFrom :: FilePath -> IO (Maybe Config)
getAuraConfFrom path = do
exists <- doesFileExist path
if not exists
then pure Nothing
else do
file <- decodeUtf8Lenient <$> BS.readFile path
pure . hush $ parse config "aura config" file
getAuraConf :: Environment -> IO Config
getAuraConf env = case userAuraConfPath env of
Nothing -> bad
Just path -> getAuraConfFrom path >>= maybe bad pure
where
bad = fromMaybe (Config M.empty) <$> getAuraConfFrom systemAuraConfPath
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 "[" "]")