{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}

-- | A module for parsing and using config files in a Shake build system. Config files
--   consist of variable bindings, for example:
--
-- > # This is my Config file
-- > HEADERS_DIR = /path/to/dir
-- > CFLAGS = -g -I${HEADERS_DIR}
-- > CFLAGS = $CFLAGS -O2
-- > include extra/file.cfg
--
--   This defines the variable @HEADERS_DIR@ (equal to @\/path\/to\/dir@), and
--   @CFLAGS@ (equal to @-g -I\/path\/to\/dir -O2@), and also includes the configuration
--   statements in the file @extra/file.cfg@. The full lexical syntax for configuration
--   files is defined here: <https://ninja-build.org/manual.html#_lexical_syntax>.
--   The use of Ninja file syntax is due to convenience and the desire to reuse an
--    externally-defined specification (but the choice of configuration language is mostly arbitrary).
--
--   To use the configuration file either use 'readConfigFile' to parse the configuration file
--   and use the values directly, or 'usingConfigFile' and 'getConfig' to track the configuration
--   values, so they become build dependencies.
module Development.Shake.Config(
    readConfigFile, readConfigFileWithEnv,
    usingConfigFile, usingConfig,
    getConfig, getConfigKeys
    ) where

import Development.Shake
import Development.Shake.Classes
import qualified Development.Ninja.Parse as Ninja
import qualified Development.Ninja.Env as Ninja
import qualified Data.HashMap.Strict as Map
import qualified Data.ByteString.UTF8 as UTF8
import Data.Tuple.Extra
import Data.List


-- | Read a config file, returning a list of the variables and their bindings.
--   Config files use the Ninja lexical syntax:
--   <https://ninja-build.org/manual.html#_lexical_syntax>
readConfigFile :: FilePath -> IO (Map.HashMap String String)
readConfigFile :: FilePath -> IO (HashMap FilePath FilePath)
readConfigFile = [(FilePath, FilePath)]
-> FilePath -> IO (HashMap FilePath FilePath)
readConfigFileWithEnv []


-- | Read a config file with an initial environment, returning a list of the variables and their bindings.
--   Config files use the Ninja lexical syntax:
--   <https://ninja-build.org/manual.html#_lexical_syntax>
readConfigFileWithEnv :: [(String, String)] -> FilePath -> IO (Map.HashMap String String)
readConfigFileWithEnv :: [(FilePath, FilePath)]
-> FilePath -> IO (HashMap FilePath FilePath)
readConfigFileWithEnv [(FilePath, FilePath)]
vars FilePath
file = do
    Env ByteString ByteString
env <- IO (Env ByteString ByteString)
forall k v. IO (Env k v)
Ninja.newEnv
    ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ByteString -> ByteString -> IO ())
-> (ByteString, ByteString) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Env ByteString ByteString -> ByteString -> ByteString -> IO ()
forall k v. (Eq k, Hashable k) => Env k v -> k -> v -> IO ()
Ninja.addEnv Env ByteString ByteString
env) ((ByteString, ByteString) -> IO ())
-> ((FilePath, FilePath) -> (ByteString, ByteString))
-> (FilePath, FilePath)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> ByteString
UTF8.fromString (FilePath -> ByteString)
-> (FilePath -> ByteString)
-> (FilePath, FilePath)
-> (ByteString, ByteString)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** FilePath -> ByteString
UTF8.fromString)) [(FilePath, FilePath)]
vars
    FilePath -> Env ByteString ByteString -> IO Ninja
Ninja.parse FilePath
file Env ByteString ByteString
env
    HashMap ByteString ByteString
mp <- Env ByteString ByteString -> IO (HashMap ByteString ByteString)
forall k v. Env k v -> IO (HashMap k v)
Ninja.fromEnv Env ByteString ByteString
env
    HashMap FilePath FilePath -> IO (HashMap FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FilePath FilePath -> IO (HashMap FilePath FilePath))
-> HashMap FilePath FilePath -> IO (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> HashMap FilePath FilePath
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(FilePath, FilePath)] -> HashMap FilePath FilePath)
-> [(FilePath, FilePath)] -> HashMap FilePath FilePath
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> (FilePath, FilePath))
-> [(ByteString, ByteString)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> FilePath
UTF8.toString (ByteString -> FilePath)
-> (ByteString -> FilePath)
-> (ByteString, ByteString)
-> (FilePath, FilePath)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** ByteString -> FilePath
UTF8.toString) ([(ByteString, ByteString)] -> [(FilePath, FilePath)])
-> [(ByteString, ByteString)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ HashMap ByteString ByteString -> [(ByteString, ByteString)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap ByteString ByteString
mp


newtype Config = Config String 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,Typeable,Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq,Int -> Config -> Int
Config -> Int
(Int -> Config -> Int) -> (Config -> Int) -> Hashable Config
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Config -> Int
$chash :: Config -> Int
hashWithSalt :: Int -> Config -> Int
$chashWithSalt :: Int -> Config -> Int
Hashable,Get Config
[Config] -> Put
Config -> Put
(Config -> Put) -> Get Config -> ([Config] -> Put) -> Binary Config
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Config] -> Put
$cputList :: [Config] -> Put
get :: Get Config
$cget :: Get Config
put :: Config -> Put
$cput :: Config -> Put
Binary,Config -> ()
(Config -> ()) -> NFData Config
forall a. (a -> ()) -> NFData a
rnf :: Config -> ()
$crnf :: Config -> ()
NFData)

newtype ConfigKeys = ConfigKeys () deriving (Int -> ConfigKeys -> ShowS
[ConfigKeys] -> ShowS
ConfigKeys -> FilePath
(Int -> ConfigKeys -> ShowS)
-> (ConfigKeys -> FilePath)
-> ([ConfigKeys] -> ShowS)
-> Show ConfigKeys
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigKeys] -> ShowS
$cshowList :: [ConfigKeys] -> ShowS
show :: ConfigKeys -> FilePath
$cshow :: ConfigKeys -> FilePath
showsPrec :: Int -> ConfigKeys -> ShowS
$cshowsPrec :: Int -> ConfigKeys -> ShowS
Show,Typeable,ConfigKeys -> ConfigKeys -> Bool
(ConfigKeys -> ConfigKeys -> Bool)
-> (ConfigKeys -> ConfigKeys -> Bool) -> Eq ConfigKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigKeys -> ConfigKeys -> Bool
$c/= :: ConfigKeys -> ConfigKeys -> Bool
== :: ConfigKeys -> ConfigKeys -> Bool
$c== :: ConfigKeys -> ConfigKeys -> Bool
Eq,Int -> ConfigKeys -> Int
ConfigKeys -> Int
(Int -> ConfigKeys -> Int)
-> (ConfigKeys -> Int) -> Hashable ConfigKeys
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ConfigKeys -> Int
$chash :: ConfigKeys -> Int
hashWithSalt :: Int -> ConfigKeys -> Int
$chashWithSalt :: Int -> ConfigKeys -> Int
Hashable,Get ConfigKeys
[ConfigKeys] -> Put
ConfigKeys -> Put
(ConfigKeys -> Put)
-> Get ConfigKeys -> ([ConfigKeys] -> Put) -> Binary ConfigKeys
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ConfigKeys] -> Put
$cputList :: [ConfigKeys] -> Put
get :: Get ConfigKeys
$cget :: Get ConfigKeys
put :: ConfigKeys -> Put
$cput :: ConfigKeys -> Put
Binary,ConfigKeys -> ()
(ConfigKeys -> ()) -> NFData ConfigKeys
forall a. (a -> ()) -> NFData a
rnf :: ConfigKeys -> ()
$crnf :: ConfigKeys -> ()
NFData)

type instance RuleResult Config = Maybe String
type instance RuleResult ConfigKeys = [String]


-- | Specify the file to use with 'getConfig'.
usingConfigFile :: FilePath -> Rules ()
usingConfigFile :: FilePath -> Rules ()
usingConfigFile FilePath
file = do
    () -> Action (HashMap FilePath FilePath)
mp <- (() -> Action (HashMap FilePath FilePath))
-> Rules (() -> Action (HashMap FilePath FilePath))
forall k v.
(Eq k, Hashable k) =>
(k -> Action v) -> Rules (k -> Action v)
newCache ((() -> Action (HashMap FilePath FilePath))
 -> Rules (() -> Action (HashMap FilePath FilePath)))
-> (() -> Action (HashMap FilePath FilePath))
-> Rules (() -> Action (HashMap FilePath FilePath))
forall a b. (a -> b) -> a -> b
$ \() -> do
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
file]
        IO (HashMap FilePath FilePath)
-> Action (HashMap FilePath FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath FilePath)
 -> Action (HashMap FilePath FilePath))
-> IO (HashMap FilePath FilePath)
-> Action (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (HashMap FilePath FilePath)
readConfigFile FilePath
file
    (Config -> Action (Maybe FilePath))
-> Rules (Config -> Action (Maybe FilePath))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((Config -> Action (Maybe FilePath))
 -> Rules (Config -> Action (Maybe FilePath)))
-> (Config -> Action (Maybe FilePath))
-> Rules (Config -> Action (Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ \(Config FilePath
x) -> FilePath -> HashMap FilePath FilePath -> Maybe FilePath
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
x (HashMap FilePath FilePath -> Maybe FilePath)
-> Action (HashMap FilePath FilePath) -> Action (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> Action (HashMap FilePath FilePath)
mp ()
    (ConfigKeys -> Action [FilePath])
-> Rules (ConfigKeys -> Action [FilePath])
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((ConfigKeys -> Action [FilePath])
 -> Rules (ConfigKeys -> Action [FilePath]))
-> (ConfigKeys -> Action [FilePath])
-> Rules (ConfigKeys -> Action [FilePath])
forall a b. (a -> b) -> a -> b
$ \(ConfigKeys ()) -> [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> (HashMap FilePath FilePath -> [FilePath])
-> HashMap FilePath FilePath
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap FilePath FilePath -> [FilePath]
forall k v. HashMap k v -> [k]
Map.keys (HashMap FilePath FilePath -> [FilePath])
-> Action (HashMap FilePath FilePath) -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> Action (HashMap FilePath FilePath)
mp ()
    () -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Specify the values to use with 'getConfig', generally prefer
--   'usingConfigFile' unless you also need access to the values
--   of variables outside 'Action'.
usingConfig :: Map.HashMap String String -> Rules ()
usingConfig :: HashMap FilePath FilePath -> Rules ()
usingConfig HashMap FilePath FilePath
mp = do
    (Config -> Action (Maybe FilePath))
-> Rules (Config -> Action (Maybe FilePath))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((Config -> Action (Maybe FilePath))
 -> Rules (Config -> Action (Maybe FilePath)))
-> (Config -> Action (Maybe FilePath))
-> Rules (Config -> Action (Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ \(Config FilePath
x) -> Maybe FilePath -> Action (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Action (Maybe FilePath))
-> Maybe FilePath -> Action (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> HashMap FilePath FilePath -> Maybe FilePath
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
x HashMap FilePath FilePath
mp
    (ConfigKeys -> Action [FilePath])
-> Rules (ConfigKeys -> Action [FilePath])
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((ConfigKeys -> Action [FilePath])
 -> Rules (ConfigKeys -> Action [FilePath]))
-> (ConfigKeys -> Action [FilePath])
-> Rules (ConfigKeys -> Action [FilePath])
forall a b. (a -> b) -> a -> b
$ \(ConfigKeys ()) -> [FilePath] -> Action [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> Action [FilePath])
-> [FilePath] -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ HashMap FilePath FilePath -> [FilePath]
forall k v. HashMap k v -> [k]
Map.keys HashMap FilePath FilePath
mp
    () -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Obtain the value of a configuration variable, returns 'Nothing' to indicate the variable
--   has no binding. Any build system using 'getConfig' /must/ call either 'usingConfigFile'
--   or 'usingConfig'. The 'getConfig' function will introduce a dependency on the configuration
--   variable (but not the whole configuration file), and if the configuration variable changes, the rule will be rerun.
--   As an example:
--
-- @
-- 'usingConfigFile' \"myconfiguration.cfg\"
-- \"*.o\" '%>' \\out -> do
--     cflags <- 'getConfig' \"CFLAGS\"
--     'cmd' \"gcc\" [out '-<.>' \"c\"] (fromMaybe \"\" cflags)
-- @
getConfig :: String -> Action (Maybe String)
getConfig :: FilePath -> Action (Maybe FilePath)
getConfig = Config -> Action (Maybe FilePath)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (Config -> Action (Maybe FilePath))
-> (FilePath -> Config) -> FilePath -> Action (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Config
Config


-- | Obtain the configuration keys.
--   Any build system using 'getConfigKeys' /must/ call either 'usingConfigFile' or 'usingConfig'.
--   The 'getConfigKeys' function will introduce a dependency on the configuration keys
--   (but not the whole configuration file), and if the configuration keys change, the rule will be rerun.
--   Usually use as part of an action.
--   As an example:
--
-- @
-- 'usingConfigFile' \"myconfiguration.cfg\"
-- 'action' $ need =<< getConfigKeys
-- @
getConfigKeys :: Action [String]
getConfigKeys :: Action [FilePath]
getConfigKeys = ConfigKeys -> Action [FilePath]
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (ConfigKeys -> Action [FilePath])
-> ConfigKeys -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ () -> ConfigKeys
ConfigKeys ()