{-# 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 Control.Applicative
import Data.Tuple.Extra
import Data.List
import Prelude


-- | 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 vars :: [(FilePath, FilePath)]
vars file :: 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 (m :: * -> *) a. Monad m => a -> m a
return (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 file :: 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
        [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) =>
(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 x :: 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) =>
(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 (m :: * -> *) a. Monad m => a -> m a
return ()


-- | 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 mp :: HashMap FilePath FilePath
mp = do
    (Config -> Action (Maybe FilePath))
-> Rules (Config -> Action (Maybe FilePath))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
(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 x :: FilePath
x) -> Maybe FilePath -> Action (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (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) =>
(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 (m :: * -> *) a. Monad m => a -> m a
return ([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 (m :: * -> *) a. Monad m => a -> m a
return ()


-- | 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 ()