salak-0.2.7: src/Salak.hs

{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
-- |
-- Module:      Salak
-- Copyright:   (c) 2019 Daniel YU
-- License:     BSD3
-- Maintainer:  leptonyu@gmail.com
-- Stability:   experimental
-- Portability: portable
--
-- Configuration Loader for Production in Haskell.
--
module Salak(
  -- * How to use this library
  -- $use

  -- * Salak
    loadAndRunSalak
  , runSalak
  , PropConfig(..)
  -- * Static Get Properties
  , HasSourcePack(..)
  , fetch
  , require
  -- * Dynamic Get Properties
  , ReloadableSourcePack
  , ReloadableSourcePackT
  , ReloadResult(..)
  , reloadable
  , reloadAction
  , fetchD
  , requireD
  -- * Prop Parser
  , Prop
  , FromProp(..)
  , FromEnumProp(..)
  , (.?=)
  , (.?:)
  -- * SourcePack
  , SourcePack
  , SourcePackT
  -- * Load configurations
  , loadCommandLine
  , loadEnv
  , loadMock
  -- ** Load By Extension
  , ExtLoad
  , loadByExt
  , HasLoad(..)
  , (:|:)(..)
  -- * Other
  , ParseCommandLine
  , defaultParseCommandLine
  , Priority
  , Value(..)
  , defaultLoadSalak
  ) 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.Load.Dynamic
import           Salak.Load.Env
import           Salak.Prop
import           Salak.Types
import           Salak.Types.Value
import           System.Directory
import           System.FilePath        ((</>))

-- | Prop load configuration
data PropConfig = PropConfig
  { configName    :: Maybe String  -- ^ Config name
  , configDirKey  :: Text          -- ^ Specify config dir
  , searchCurrent :: Bool          -- ^ Search current directory, default true
  , searchHome    :: Bool          -- ^ Search home directory, default false.
  , commandLine   :: ParseCommandLine -- ^ How to parse commandline
  , loadExt       :: FilePath -> SourcePackT IO ()
  }

instance Default PropConfig where
  def = PropConfig
    Nothing
    "salak.conf.dir"
    True
    False
    defaultParseCommandLine
    (\_ -> return ())

-- | Load and run salak `SourcePack` and fetch properties.
loadAndRunSalak
  :: Monad m
  => SourcePackT m ()       -- ^ Load properties monad.
  -> ReaderT SourcePack m a -- ^ Fetch properties monad.
  -> m a
loadAndRunSalak spm a = do
  sp <- runSourcePackT spm
  let es = errs sp
  unless (null es) $ fail (head es)
  runReaderT a sp


-- | Load file by extension
type ExtLoad = (String, FilePath -> SourcePackT IO ())

class HasLoad a where
  loaders :: a -> [ExtLoad]

data a :|: b = a :|: b
infixr 3 :|:

instance (HasLoad a, HasLoad b) => HasLoad (a :|: b) where
  loaders (a :|: b) = loaders a ++ loaders b

loadByExt :: (HasLoad a, MonadIO m) => a -> FilePath -> SourcePackT m ()
loadByExt xs f = mapM_ go (loaders xs)
  where
    go (ext, ly) = tryLoadFile (jump . ly) $ f ++ "." ++ ext

jump :: MonadIO m => StateT SourcePack IO a -> StateT SourcePack m ()
jump a = get >>= lift . liftIO . execStateT a >>= put

-- | Default load salak.
-- All these configuration sources has orders, from highest priority to lowest priority:
--
-- > 1. loadCommandLine
-- > 2. loadEnvironment
-- > 3. loadConfFiles
-- > 4. load file from folder `salak.conf.dir` if defined
-- > 5. load file from current folder if enabled
-- > 6. load file from home folder if enabled
-- > 7. file extension matching, support yaml or toml or any other loader.
--
runSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a
runSalak PropConfig{..} = loadAndRunSalak $ do
  loadCommandLine commandLine
  loadEnv
  forM_ configName $ forM_
    [ require configDirKey
    , ifS searchCurrent getCurrentDirectory
    , ifS searchHome    getHomeDirectory
    ] . loadConf
  where
    ifS True gxd = Just <$> liftIO gxd
    ifS _    _   = return Nothing
    loadConf n mf = mf >>= mapM_ (jump . loadExt . (</> n))

{-# DEPRECATED defaultLoadSalak "use runSalak instead" #-}
defaultLoadSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a
defaultLoadSalak = runSalak


  --   loadC ffa n = (mapM_ . mapM_) g
  -- cf <- fetch configDirKey
  -- where
  --   go ck n = do
  --     case ck of
  --       Left  _ -> return ()
  --       Right d -> defaultLoadByExt $ d </> n
  --     c <- liftIO getCurrentDirectory
  --     when searchCurrent $ defaultLoadByExt $ c </> n
  --     h <- liftIO getHomeDirectory
  --     when searchHome    $ defaultLoadByExt $ 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

-- | Try fetch properties from `SourcePack`
fetch
  :: (HasSourcePack m, FromProp a)
  => Text -- ^ Properties key
  -> m (Either String a)
fetch key = search key <$> askSourcePack

-- | Fetch properties from `SourcePack`, or throw fail
require
  :: (HasSourcePack m, FromProp a)
  => Text -- ^ Properties key
  -> m a
require k = do
  x <- fetch k
  case x of
    Left  e -> fail e
    Right v -> return v

-- | Fetch dynamic properties from `SourcePack`, or throw fail
requireD
  :: (MonadIO m, FromProp a)
  => Text -- ^ Properties key
  -> ReloadableSourcePackT m (IO a)
requireD k = do
  x <- fetchD k
  case x of
    Left  e -> fail e
    Right v -> return v

-- | Try fetch dynamic properties from `SourcePack`
fetchD
  :: (MonadIO m, FromProp a)
  => Text -- ^ Properties key
  -> ReloadableSourcePackT m (Either String (IO a))
fetchD = search'

-- | Lift to reloadable environment for dynamic properties.
reloadable :: (MonadIO m, HasSourcePack m) => ReloadableSourcePackT m a -> m a
reloadable f = askSourcePack >>= runReloadable f

-- | Optional value.
infixl 5 .?=
(.?=) :: Alternative f => f a -> a -> f a
(.?=) a b = a <|> pure b

-- | Default value.
infixl 5 .?:
(.?:) :: (Alternative f, Default b) => f a -> (b -> a) -> f a
(.?:) fa b = fa .?= b def

-- $use
--
-- | This library define a universal procedure to load configurations and parse properties, also supports reload configuration files.
--
--
-- We can load configurations from command line, environment, configuration files such as yaml or toml etc, and we may want to have our own strategies to load configurations from multi sources and overwrite properties by orders of these sources.
--
-- `PropConfig` defines a common loading strategy:
--
-- > 1. loadCommandLine
-- > 2. loadEnvironment
-- > 3. loadConfFiles
-- > 4. load file from folder `salak.conf.dir` if defined
-- > 5. load file from current folder if enabled
-- > 6. load file from home folder if enabled
-- > 7. file extension matching, support yaml or toml or any other loader.
--
-- Load earlier has higher priority, priorities cannot be changed.
--
--
-- Usage:
--
--
-- Environment:
--
-- > export TEST_CONFIG_NAME=daniel
--
-- Current Directory:  salak.yaml
--
-- > test.config:
-- >   name: noop
-- >   dir: ls
--
-- Current Directory:  salak.toml
--
-- > [test.config]
-- > ext=2
--
-- > data Config = Config
-- >   { name :: Text
-- >   , dir  :: Maybe Text
-- >   , ext  :: Int
-- >   } deriving (Eq, Show)
-- >
-- > instance FromProp Config where
-- >   fromProp = Config
-- >     <$> "user" ? pattern "[a-z]{5,16}"
-- >     <*> "pwd"
-- >     <*> "ext" .?= 1
-- >
-- > main = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML } $ do
-- >   c :: Config <- require "test.config"
-- >   lift $ print c
--
-- GHCi play
--
-- > λ> import Salak
-- > λ> import Salak.Load.YAML
-- > λ> import Salak.Load.TOML
-- > λ> :set -XTypeApplications
-- > λ> instance FromProp Config where fromProp = Config <$> "user" <*> "dir" <*> "ext" .?= 1
-- > λ> f = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML }
-- > λ> f (require "") >>= print @Config
-- > Config {name = "daniel", dir = Just "ls", ext = 2}
--