{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Salak(
defaultLoadSalak
, loadSalak
, PropConfig(..)
, HasSourcePack(..)
, fetch
, require
, ReloadableSourcePack
, ReloadableSourcePackT
, ReloadResult(..)
, reloadable
, fetchD
, requireD
, Prop
, FromProp(..)
, FromEnumProp(..)
, (.?=)
, (.?:)
, SourcePack
, SourcePackT
, loadYaml
, loadCommandLine
, loadEnv
, loadMock
, defaultParseCommandLine
, ParseCommandLine
, Priority
, Value(..)
) where
import Control.Applicative
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader
import Control.Monad.State
import Data.Default
import Data.Text (Text)
import Salak.Dynamic
import Salak.Env
import Salak.Json
import Salak.Prop
import Salak.Types
import System.Directory
import System.FilePath ((</>))
data PropConfig = PropConfig
{ configName :: Maybe String
, configDirKey :: Text
, searchCurrent :: Bool
, searchHome :: Bool
, commandLine :: ParseCommandLine
}
instance Default PropConfig where
def = PropConfig Nothing "salak.conf" True False defaultParseCommandLine
loadSalak
:: Monad m
=> ReaderT SourcePack m a
-> SourcePackT m ()
-> m a
loadSalak a spm = do
(es, sp) <- runSourcePackT spm
unless (null es) $ fail (head es)
runReaderT a sp
defaultLoadSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a
defaultLoadSalak PropConfig{..} a = loadSalak a $ do
loadCommandLine commandLine
loadEnv
cf <- fetch configDirKey
maybe (return ()) (go cf) configName
where
go ck n = do
case ck of
Left _ -> return ()
Right d -> loadYaml $ d </> n
c <- liftIO getCurrentDirectory
when searchCurrent $ tryLoadYaml $ c </> n
h <- liftIO getHomeDirectory
when searchHome $ tryLoadYaml $ h </> n
class Monad m => HasSourcePack m where
askSourcePack :: m SourcePack
instance Monad m => HasSourcePack (ReaderT SourcePack m) where
askSourcePack = ask
instance Monad m => HasSourcePack (StateT SourcePack m) where
askSourcePack = get
fetch
:: (HasSourcePack m, FromProp a)
=> Text
-> m (Either String a)
fetch key = search key <$> askSourcePack
require
:: (HasSourcePack m, FromProp a)
=> Text
-> m a
require k = do
x <- fetch k
case x of
Left e -> fail e
Right v -> return v
requireD
:: (MonadIO m, FromProp a)
=> Text
-> ReloadableSourcePackT m (IO a)
requireD k = do
x <- fetchD k
case x of
Left e -> fail e
Right v -> return v
fetchD
:: (MonadIO m, FromProp a)
=> Text
-> ReloadableSourcePackT m (Either String (IO a))
fetchD = search'
reloadable :: (MonadIO m, HasSourcePack m) => ReloadableSourcePackT m a -> m a
reloadable f = askSourcePack >>= runReloadable f
infixl 5 .?=
(.?=) :: Alternative f => f a -> a -> f a
(.?=) a b = a <|> pure b
infixl 5 .?:
(.?:) :: (Alternative f, Default b) => f a -> (b -> a) -> f a
(.?:) fa b = fa .?= b def