diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,21 @@ -Copyright Daniel YU (c) 2018 - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +MIT License - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +Copyright (c) 2019 Daniel YU - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: - * Neither the name of Daniel YU nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,16 +1,17 @@ # salak -[![Hackage](https://img.shields.io/hackage/v/salak.svg)](https://hackage.haskell.org/package/salak) +[![Hackage](https://img.shields.io/hackage/v/salak.svg?logo=haskell)](https://hackage.haskell.org/package/salak) +[![Build](https://img.shields.io/travis/leptonyu/salak.svg?logo=travis)](https://travis-ci.org/leptonyu/salak) [![stackage LTS package](http://stackage.org/package/salak/badge/lts)](http://stackage.org/lts/package/salak) [![stackage Nightly package](http://stackage.org/package/salak/badge/nightly)](http://stackage.org/nightly/package/salak) -[![Build Status](https://travis-ci.org/leptonyu/salak.svg?branch=master)](https://travis-ci.org/leptonyu/salak) +[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/leptonyu/salak/blob/master/LICENSE) Configuration (re)loader in Haskell. ## salak-yaml -[![salak-yaml](https://img.shields.io/hackage/v/salak-yaml.svg)](https://hackage.haskell.org/package/salak-yaml) +[![salak-yaml](https://img.shields.io/hackage/v/salak-yaml.svg?logo=haskell)](https://hackage.haskell.org/package/salak-yaml) ## salak-toml -[![salak-toml](https://img.shields.io/hackage/v/salak-toml.svg)](https://hackage.haskell.org/package/salak-toml) +[![salak-toml](https://img.shields.io/hackage/v/salak-toml.svg?logo=haskell)](https://hackage.haskell.org/package/salak-toml) ## Introduction This library defines a universal procedure to load configurations and parse properties, also supports reload configuration files. @@ -33,7 +34,7 @@ > 1. loadCommandLine > 2. loadEnvironment > 3. loadConfFiles -> 4. load file from folder `salak.conf.dir` if defined +> 4. load file from folder `application.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. diff --git a/salak.cabal b/salak.cabal --- a/salak.cabal +++ b/salak.cabal @@ -1,9 +1,9 @@ cabal-version: 1.12 name: salak -version: 0.3.1 -license: BSD3 +version: 0.3.2 +license: MIT license-file: LICENSE -copyright: (c) 2018 Daniel YU +copyright: 2019 Daniel YU maintainer: Daniel YU author: Daniel YU homepage: https://github.com/leptonyu/salak#readme diff --git a/src/Salak.hs b/src/Salak.hs --- a/src/Salak.hs +++ b/src/Salak.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NoOverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoOverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module: Salak -- Copyright: 2019 Daniel YU @@ -36,6 +37,7 @@ , readPrimitive , readEnum , SourcePack + , Salak , SalakException(..) -- * Load Functions -- ** Monad for Loader @@ -67,6 +69,7 @@ import Control.Monad.IO.Unlift import Control.Monad.Reader import Data.Default +import Data.Maybe import Data.Text (Text) import Salak.Internal import Salak.Internal.Prop @@ -74,29 +77,40 @@ import System.Directory import System.FilePath (()) - --- | Configuration file name -type FileName = String +-- | Type synonyms of 'SourcePack' +type Salak = SourcePack -- | Prop load configuration data PropConfig = PropConfig - { configName :: Maybe FileName -- ^ Config name - , configDirKey :: Text -- ^ Specify config dir - , searchCurrent :: Bool -- ^ Search current directory, default true + { configKey :: Text -- ^ Specify config key, default is @application@. + , configName :: String -- ^ Specify config name, default is @application@. + , searchCurrent :: Bool -- ^ Search current directory, default true. , searchHome :: Bool -- ^ Search home directory, default false. - , commandLine :: ParseCommandLine -- ^ How to parse commandline + , commandLine :: ParseCommandLine -- ^ How to parse commandline. + , loggerF :: LFunc , loadExt :: FilePath -> LoadSalak () } instance Default PropConfig where def = PropConfig - Nothing - "salak.conf.dir" + "application" + "application" True False defaultParseCommandLine + putStrLn (\_ -> return ()) +data FileConfig = FileConfig + { configNm :: Maybe String + , configDir :: Maybe FilePath + } + +instance Monad m => FromProp m FileConfig where + fromProp = FileConfig + <$> "name" .?= Nothing + <*> "dir" .?= Nothing + -- | Load file by extension type ExtLoad = (String, FilePath -> LoadSalak ()) @@ -128,21 +142,22 @@ -- loadSalak :: (MonadThrow m, MonadIO m) => PropConfig -> LoadSalakT m () loadSalak PropConfig{..} = do + setLogF loggerF loadCommandLine commandLine loadEnv - dir <- require configDirKey - forM_ configName $ forM_ - [ return dir + FileConfig{..} <- require configKey + forM_ + [ return configDir , ifS searchCurrent getCurrentDirectory , ifS searchHome getHomeDirectory - ] . loadConf + ] (loadConf $ fromMaybe configName configNm) where ifS True gxd = Just <$> liftIO gxd ifS _ _ = return Nothing loadConf n mf = lift mf >>= mapM_ (liftNT . loadExt . ( n)) -loadSalakWith :: (MonadThrow m, MonadIO m, HasLoad file) => file -> FileName -> LoadSalakT m () -loadSalakWith file name = loadSalak def { configName = Just name, loadExt = loadByExt file } +loadSalakWith :: (MonadThrow m, MonadIO m, HasLoad file) => file -> String -> LoadSalakT m () +loadSalakWith file name = loadSalak def { configName = name, loadExt = loadByExt file } -- | Standard salak functions, by load and run with `RunSalakT`. loadAndRunSalak :: (MonadThrow m, MonadIO m) => LoadSalakT m () -> RunSalakT m a -> m a @@ -153,7 +168,7 @@ runSalak c = loadAndRunSalak (loadSalak c) -- | Run salak, load strategy refer to `loadSalakWith` -runSalakWith :: (MonadCatch m, MonadIO m, HasLoad file) => FileName -> file -> RunSalakT m a -> m a +runSalakWith :: (MonadCatch m, MonadIO m, HasLoad file) => String -> file -> RunSalakT m a -> m a runSalakWith name file = loadAndRunSalak (loadSalakWith file name) -- $use @@ -169,7 +184,7 @@ -- > 1. loadCommandLine -- > 2. loadEnvironment -- > 3. loadConfFiles --- > 4. load file from folder `salak.conf.dir` if defined +-- > 4. load file from folder `application.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. diff --git a/src/Salak/Internal.hs b/src/Salak/Internal.hs --- a/src/Salak/Internal.hs +++ b/src/Salak/Internal.hs @@ -78,6 +78,7 @@ { ref :: MVar Source , refNo :: Int , refMap :: HashMap Int String + , lfunc :: MVar LFunc , qfunc :: MVar QFunc , update :: MVar (IO ( TraceSource -- Updated Tries , IO ())) -- Confirm action @@ -91,13 +92,21 @@ type LoadSalak = LoadSalakT IO runLoad :: Monad m => LoadSalakT m a -> UpdateSource -> m a -runLoad (LoadSalakT ma) us = MS.evalStateT ma us +runLoad (LoadSalakT ma) = MS.evalStateT ma liftNT :: MonadIO m => LoadSalak () -> LoadSalakT m () liftNT a = MS.get >>= liftIO . runLoad a instance MonadIO m => MonadSalak (LoadSalakT m) where askSalak = MS.get >>= toSourcePack + setLogF f = do + UpdateSource{..} <- MS.get + liftIO $ void $ swapMVar lfunc f + logSalak msg = do + UpdateSource{..} <- MS.get + liftIO $ do + f <- readMVar lfunc + f msg instance (MonadThrow m, IU.MonadUnliftIO m) => IU.MonadUnliftIO (LoadSalakT m) where askUnliftIO = do @@ -112,7 +121,7 @@ type RunSalak = RunSalakT IO runRun :: Monad m => RunSalakT m a -> SourcePack -> m a -runRun (RunSalakT ma) us = runReaderT ma us +runRun (RunSalakT ma) = runReaderT ma instance Monad m => MonadSalak (RunSalakT m) where askSalak = RunSalakT ask @@ -125,6 +134,7 @@ -- | Basic loader loadTrie :: (MonadThrow m, MonadIO m) => Bool -> String -> (Int -> IO TraceSource) -> LoadSalakT m () loadTrie canReload name f = do + logSalak $ "Loading " ++ (if canReload then "[reloadable]" else "") ++ name UpdateSource{..} <- MS.get v <- liftIO $ readMVar ref ts <- liftIO $ loadSource f refNo (fmap ([],) v) @@ -132,7 +142,7 @@ if null es then do liftIO $ modifyMVar_ update $ \u -> go ts u refNo - let nut = UpdateSource ref (refNo + 1) (HM.insert refNo name refMap) qfunc update + let nut = UpdateSource ref (refNo + 1) (HM.insert refNo name refMap) lfunc qfunc update _ <- liftIO $ swapMVar ref t MS.put nut else throwM $ PropException $ unlines es @@ -156,10 +166,11 @@ r <- liftIO $ newMVar T.empty q <- liftIO $ newMVar $ \s -> Right $ void $ swapMVar r s u <- liftIO $ newMVar $ return (T.empty, return ()) - runLoad (lm >> MS.get) (UpdateSource r 0 HM.empty q u) >>= toSourcePack + l <- liftIO $ newMVar $ \_ -> return () + runLoad (lm >> MS.get) (UpdateSource r 0 HM.empty l q u) >>= toSourcePack toSourcePack :: MonadIO m => UpdateSource -> m SourcePack -toSourcePack UpdateSource{..} = liftIO (readMVar ref) >>= \s -> return $ SourcePack s [] qfunc go +toSourcePack UpdateSource{..} = liftIO (readMVar ref) >>= \s -> return $ SourcePack s [] qfunc lfunc go where go = do t <- readMVar ref @@ -204,7 +215,7 @@ tryLoadFile :: MonadIO m => (FilePath -> LoadSalakT m ()) -> FilePath -> LoadSalakT m () tryLoadFile f file = do b <- liftIO $ doesFileExist file - when b $ do - liftIO $ putStrLn $ "Load " ++ file - f file + if b + then f file + else logSalak $ "File does not exist, ignore load " ++ file diff --git a/src/Salak/Internal/Prop.hs b/src/Salak/Internal/Prop.hs --- a/src/Salak/Internal/Prop.hs +++ b/src/Salak/Internal/Prop.hs @@ -30,7 +30,7 @@ import Data.Menshen import Data.Scientific import Data.Semigroup -import Data.Text (Text) +import Data.Text (Text, unpack) import qualified Data.Text as T import qualified Data.Text.Encoding as TB import qualified Data.Text.Lazy as TL @@ -72,9 +72,21 @@ askSalak :: m SourcePack -- | Get reload action which used for reload profiles - askReload :: MonadSalak m => m (IO ReloadResult) + askReload :: m (IO ReloadResult) askReload = reload <$> askSalak + setLogF :: MonadIO m => (String -> IO ()) -> m () + setLogF f = do + SourcePack{..} <- askSalak + liftIO $ void $ swapMVar lref f + + logSalak :: MonadIO m => String -> m () + logSalak msg = do + SourcePack{..} <- askSalak + liftIO $ do + f <- readMVar lref + f msg + -- | Parse properties using `FromProp`. For example: -- -- > a :: Bool <- require "bool.key" @@ -88,8 +100,15 @@ require ks = do sp@SourcePack{..} <- askSalak case search ks source of - Left e -> throwM $ PropException e - Right (k,t) -> runProp1 sp { source = t, pref = pref ++ unKeys k} fromProp + Left e -> throwM $ SalakException (unpack ks) (toException $ PropException e) + Right (k,t) -> do + v <- runProp2 sp { source = t, pref = pref ++ unKeys k} fromProp + case v of + Left e -> case fromException e of + Just (SalakException a b) -> throwM $ SalakException a b + Just pe -> throwM $ SalakException (unpack ks) (toException pe) + _ -> throwM $ SalakException (unpack ks) e + Right x -> return x instance {-# OVERLAPPABLE #-} (m ~ t m', Monad m', Monad m, MonadTrans t, MonadSalak m') => MonadSalak m where askSalak = lift askSalak @@ -132,7 +151,10 @@ v <- try fromProp case v of Left e -> case fromException e of - Just NullException -> return Nothing + Just NullException -> return Nothing + Just (SalakException _ e2) -> case fromException e2 of + Just NullException -> return Nothing + _ -> throwM e _ -> throwM e Right a -> return (Just a) @@ -141,10 +163,7 @@ SourcePack{..} <- ask v <- try fromProp return $ case v of - Left e -> case fromException e of - Just (PropException x) -> Left x - Just NullException -> Left $ show (Keys pref) ++ " is null" - _ -> Left $ show e + Left e -> Left $ show (e :: SomeException) Right a -> Right a instance {-# OVERLAPPABLE #-} FromProp m a => FromProp m [a] where @@ -178,6 +197,7 @@ data SalakException = PropException String -- ^ Parse failed | NullException -- ^ Not found + | SalakException String SomeException deriving Show instance Exception SalakException @@ -187,13 +207,15 @@ fromString ks = do sp@SourcePack{..} <- askSalak case search ks source of - Left e -> throwM $ PropException e + Left e -> throwM $ SalakException + (if null pref then ks else show (Keys pref) ++ "." ++ ks) + (toException $ PropException e) Right (k,t) -> runProp sp { source = t, pref = pref ++ unKeys k} fromProp notFound :: Monad m => Prop m a notFound = do SourcePack{..} <- askSalak - throwM NullException + throwM $ SalakException (show (Keys pref)) $ toException NullException err :: Monad m => String -> Prop m a err e = do diff --git a/src/Salak/Internal/Source.hs b/src/Salak/Internal/Source.hs --- a/src/Salak/Internal/Source.hs +++ b/src/Salak/Internal/Source.hs @@ -23,10 +23,13 @@ type QFunc = Source -> Either String (IO ()) +type LFunc = String -> IO () + data SourcePack = SourcePack { source :: Source , pref :: [Key] , qref :: MVar QFunc + , lref :: MVar LFunc , reload :: IO ReloadResult }