{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}

-- |
-- Module    : Aura.Settings.External
-- Copyright : (c) Colin Woodbury, 2012 - 2021
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- A simple parser for .conf files, along with types for aura-specific config
-- files.

module Aura.Settings.External
  ( -- * Aura Config
    AuraConfig(..)
  , getAuraConf
  , auraConfig
    -- * Parsing
  , 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

--------------------------------------------------------------------------------
-- Aura-specific Configuration

data AuraConfig = AuraConfig
  { AuraConfig -> Maybe Language
acLang      :: !(Maybe Language)
  , AuraConfig -> Maybe FilePath
acEditor    :: !(Maybe FilePath)
  , AuraConfig -> Maybe User
acUser      :: !(Maybe User)
  , AuraConfig -> Maybe FilePath
acBuildPath :: !(Maybe FilePath)
  , AuraConfig -> Maybe FilePath
acASPath    :: !(Maybe FilePath)
  , AuraConfig -> Maybe FilePath
acVCSPath   :: !(Maybe FilePath)
  , AuraConfig -> Maybe BuildSwitch
acAnalyse   :: !(Maybe BuildSwitch) }
  deriving stock (Int -> AuraConfig -> ShowS
[AuraConfig] -> ShowS
AuraConfig -> FilePath
(Int -> AuraConfig -> ShowS)
-> (AuraConfig -> FilePath)
-> ([AuraConfig] -> ShowS)
-> Show AuraConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AuraConfig] -> ShowS
$cshowList :: [AuraConfig] -> ShowS
show :: AuraConfig -> FilePath
$cshow :: AuraConfig -> FilePath
showsPrec :: Int -> AuraConfig -> ShowS
$cshowsPrec :: Int -> AuraConfig -> ShowS
Show)

userAuraConfPath :: Environment -> Maybe FilePath
userAuraConfPath :: Environment -> Maybe FilePath
userAuraConfPath Environment
env = case Environment -> Maybe User
getTrueUser Environment
env of
  Maybe User
Nothing            -> Maybe FilePath
forall a. Maybe a
Nothing
  Just (User Text
"root") -> Maybe FilePath
forall a. Maybe a
Nothing
  Just (User Text
u)      -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"/home/" FilePath -> ShowS
</> Text -> FilePath
T.unpack Text
u FilePath -> ShowS
</> FilePath
".config/aura/aura.conf"

systemAuraConfPath :: FilePath
systemAuraConfPath :: FilePath
systemAuraConfPath = FilePath
"/etc/aura.conf"

-- | Attempt to get a valid Aura config from a specified path.
getAuraConfFrom :: FilePath -> IO (Maybe Config)
getAuraConfFrom :: FilePath -> IO (Maybe Config)
getAuraConfFrom FilePath
path = do
  Bool
exists <- FilePath -> IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist FilePath
path
  if Bool -> Bool
not Bool
exists
    then Maybe Config -> IO (Maybe Config)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Config
forall a. Maybe a
Nothing
    else do
      Text
file <- ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
BS.readFile FilePath
path
      Maybe Config -> IO (Maybe Config)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Config -> IO (Maybe Config))
-> (Either (ParseErrorBundle Text Void) Config -> Maybe Config)
-> Either (ParseErrorBundle Text Void) Config
-> IO (Maybe Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseErrorBundle Text Void) Config -> Maybe Config
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle Text Void) Config -> IO (Maybe Config))
-> Either (ParseErrorBundle Text Void) Config -> IO (Maybe Config)
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Config
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Config
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Config
config FilePath
"aura config" Text
file

getAuraConf :: Environment -> IO Config
getAuraConf :: Environment -> IO Config
getAuraConf Environment
env = case Environment -> Maybe FilePath
userAuraConfPath Environment
env of
  Maybe FilePath
Nothing   -> IO Config
bad
  Just FilePath
path -> FilePath -> IO (Maybe Config)
getAuraConfFrom FilePath
path IO (Maybe Config) -> (Maybe Config -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Config -> (Config -> IO Config) -> Maybe Config -> IO Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Config
bad Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    bad :: IO Config
bad = Config -> Maybe Config -> Config
forall a. a -> Maybe a -> a
fromMaybe (Map Text [Text] -> Config
Config Map Text [Text]
forall k a. Map k a
M.empty) (Maybe Config -> Config) -> IO (Maybe Config) -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Config)
getAuraConfFrom FilePath
systemAuraConfPath

auraConfig :: Config -> AuraConfig
auraConfig :: Config -> AuraConfig
auraConfig (Config Map Text [Text]
m) = AuraConfig :: Maybe Language
-> Maybe FilePath
-> Maybe User
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe BuildSwitch
-> AuraConfig
AuraConfig
  { acLang :: Maybe Language
acLang = Text -> Maybe Text
one Text
"language" Maybe Text -> (Text -> Maybe Language) -> Maybe Language
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Language
langFromLocale
  , acEditor :: Maybe FilePath
acEditor = Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
one Text
"editor"
  , acUser :: Maybe User
acUser = Text -> User
User (Text -> User) -> Maybe Text -> Maybe User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
one Text
"user"
  , acBuildPath :: Maybe FilePath
acBuildPath = Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
one Text
"buildpath"
  , acASPath :: Maybe FilePath
acASPath = Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
one Text
"allsourcepath"
  , acVCSPath :: Maybe FilePath
acVCSPath = Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
one Text
"vcspath"
  , acAnalyse :: Maybe BuildSwitch
acAnalyse = Text -> Maybe Text
one Text
"analyse" Maybe Text -> (Text -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Bool
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe Bool)
-> (Text -> FilePath) -> Text -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack Maybe Bool -> (Bool -> Maybe BuildSwitch) -> Maybe BuildSwitch
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe BuildSwitch -> Maybe BuildSwitch -> Bool -> Maybe BuildSwitch
forall a. a -> a -> Bool -> a
bool (BuildSwitch -> Maybe BuildSwitch
forall a. a -> Maybe a
Just BuildSwitch
NoPkgbuildCheck) Maybe BuildSwitch
forall a. Maybe a
Nothing
  }
  where
    one :: Text -> Maybe Text
one Text
x = Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
x Map Text [Text]
m Maybe [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe

--------------------------------------------------------------------------------
-- Parsing

-- | The (meaningful) contents of a .conf file.
newtype Config = Config (Map Text [Text]) deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
(Int -> Config -> ShowS)
-> (Config -> FilePath) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- | Parse a `Config`.
config :: Parsec Void Text Config
config :: Parsec Void Text Config
config = do
  Parsec Void Text ()
garbage
  [Either () (Text, [Text])]
cs <- ParsecT Void Text Identity (Either () (Text, [Text]))
-> ParsecT Void Text Identity [Either () (Text, [Text])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity (Either () (Text, [Text]))
 -> ParsecT Void Text Identity [Either () (Text, [Text])])
-> ParsecT Void Text Identity (Either () (Text, [Text]))
-> ParsecT Void Text Identity [Either () (Text, [Text])]
forall a b. (a -> b) -> a -> b
$ ((Text, [Text]) -> Either () (Text, [Text]))
-> ParsecT Void Text Identity (Text, [Text])
-> ParsecT Void Text Identity (Either () (Text, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, [Text]) -> Either () (Text, [Text])
forall a b. b -> Either a b
Right (ParsecT Void Text Identity (Text, [Text])
-> ParsecT Void Text Identity (Text, [Text])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity (Text, [Text])
pair) ParsecT Void Text Identity (Either () (Text, [Text]))
-> ParsecT Void Text Identity (Either () (Text, [Text]))
-> ParsecT Void Text Identity (Either () (Text, [Text]))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (() -> Either () (Text, [Text]))
-> Parsec Void Text ()
-> ParsecT Void Text Identity (Either () (Text, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either () (Text, [Text])
forall a b. a -> Either a b
Left Parsec Void Text ()
single
  Parsec Void Text ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  Config -> Parsec Void Text Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Parsec Void Text Config)
-> ([(Text, [Text])] -> Config)
-> [(Text, [Text])]
-> Parsec Void Text Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [Text] -> Config
Config (Map Text [Text] -> Config)
-> ([(Text, [Text])] -> Map Text [Text])
-> [(Text, [Text])]
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, [Text])] -> Parsec Void Text Config)
-> [(Text, [Text])] -> Parsec Void Text Config
forall a b. (a -> b) -> a -> b
$ [Either () (Text, [Text])] -> [(Text, [Text])]
forall a b. [Either a b] -> [b]
rights [Either () (Text, [Text])]
cs

single :: Parsec Void Text ()
single :: Parsec Void Text ()
single = Parsec Void Text () -> Parsec Void Text () -> Parsec Void Text ()
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parsec Void Text ()
garbage (Parsec Void Text () -> Parsec Void Text ())
-> (ParsecT Void Text Identity FilePath -> Parsec Void Text ())
-> ParsecT Void Text Identity FilePath
-> Parsec Void Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity FilePath -> Parsec Void Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity FilePath -> Parsec Void Text ())
-> ParsecT Void Text Identity FilePath -> Parsec Void Text ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

pair :: Parsec Void Text (Text, [Text])
pair :: ParsecT Void Text Identity (Text, [Text])
pair = Parsec Void Text ()
-> ParsecT Void Text Identity (Text, [Text])
-> ParsecT Void Text Identity (Text, [Text])
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parsec Void Text ()
garbage (ParsecT Void Text Identity (Text, [Text])
 -> ParsecT Void Text Identity (Text, [Text]))
-> ParsecT Void Text Identity (Text, [Text])
-> ParsecT Void Text Identity (Text, [Text])
forall a b. (a -> b) -> a -> b
$ do
  Text
n <- Text -> Text
T.stripEnd (Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe FilePath
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
  ParsecT Void Text Identity Char -> Parsec Void Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> Parsec Void Text ())
-> ParsecT Void Text Identity Char -> Parsec Void Text ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Parsec Void Text ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  [Text]
rest <- Text -> [Text]
T.words (Text -> [Text])
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe FilePath
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  (Text, [Text]) -> ParsecT Void Text Identity (Text, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
n, [Text]
rest)

-- Thu 23 Apr 2020 06:57:59 PM PDT
-- Thank you me-from-the-past for documenting this.
-- | All skippable content. Using `[]` as block comment markers is a trick to
-- skip conf file "section" lines.
garbage :: Parsec Void Text ()
garbage :: Parsec Void Text ()
garbage = Parsec Void Text ()
-> Parsec Void Text ()
-> Parsec Void Text ()
-> Parsec Void Text ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parsec Void Text ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (Tokens Text -> Parsec Void Text ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"#") (Tokens Text -> Tokens Text -> Parsec Void Text ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"[" Tokens Text
"]")