packages feed

boots (empty) → 0

raw patch · 13 files changed

+529/−0 lines, 13 filesdep +basedep +bootsdep +data-defaultsetup-changed

Dependencies added: base, boots, data-default, exceptions, fast-logger, microlens, monad-logger, mtl, salak, salak-yaml, text, unliftio-core

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Daniel YU++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:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++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.
+ README.md view
@@ -0,0 +1,18 @@+# boots++[![Hackage](https://img.shields.io/hackage/v/boots.svg)](https://hackage.haskell.org/package/boots)+[![stackage LTS package](http://stackage.org/package/boots/badge/lts)](http://stackage.org/lts/package/boots)+[![stackage Nightly package](http://stackage.org/package/boots/badge/nightly)](http://stackage.org/nightly/package/boots)+[![Build Status](https://travis-ci.org/leptonyu/boots.svg?branch=master)](https://travis-ci.org/leptonyu/boots)++Boot applications by using plugins.++```Haskell+main :: IO ()+main = booting (pluginSimple "application") go+  where+    go = forever $ do+      user <- require "user"+      logInfo $ "Hello, " <> user <> "!"+      liftIO $ threadDelay 1000000+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain
+ boots.cabal view
@@ -0,0 +1,68 @@+cabal-version: 1.12+name: boots+version: 0+license: MIT+license-file: LICENSE+copyright: 2019 Daniel YU+maintainer: leptonyu@gmail.com+author: Daniel YU+homepage: https://github.com/leptonyu/boots#readme+synopsis: Boot application by using plugins.+description:+    Boot application.+category: Library+build-type: Simple+extra-source-files:+    README.md++library+    exposed-modules:+        Boots+        Boots.Plugin+        Boots.Plugin.Simple+        Boots.Plugin.Salak+        Boots.Plugin.Logger+    hs-source-dirs: src+    other-modules:+        Boots.Internal+        Boots.Internal.App+        Boots.Internal.Plugin+    default-language: Haskell2010+    default-extensions: FlexibleInstances MultiParamTypeClasses+                        GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards+                        FlexibleContexts+    build-depends:+        base >=4.10 && <5,+        data-default >=0.7.1.1 && <0.8,+        exceptions >=0.10.2 && <0.11,+        fast-logger >=2.4.16 && <2.5,+        microlens >=0.4.10 && <0.5,+        monad-logger >=0.3.30 && <0.4,+        mtl >=2.2.2 && <2.3,+        salak >=0.3.1 && <0.4,+        salak-yaml >=0.3.1 && <0.4,+        text >=1.2.3.1 && <1.3,+        unliftio-core >=0.1.2.0 && <0.2++executable boots-exe+    main-is: Main.hs+    hs-source-dirs: main+    other-modules:+        Paths_boots+    default-language: Haskell2010+    default-extensions: FlexibleInstances MultiParamTypeClasses+                        GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards+                        FlexibleContexts+    build-depends:+        base >=4.10 && <5,+        boots -any,+        data-default >=0.7.1.1 && <0.8,+        exceptions >=0.10.2 && <0.11,+        fast-logger >=2.4.16 && <2.5,+        microlens >=0.4.10 && <0.5,+        monad-logger >=0.3.30 && <0.4,+        mtl >=2.2.2 && <2.3,+        salak >=0.3.1 && <0.4,+        salak-yaml >=0.3.1 && <0.4,+        text >=1.2.3.1 && <1.3,+        unliftio-core >=0.1.2.0 && <0.2
+ main/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import           Boots+import           Control.Concurrent+import           Control.Monad++main :: IO ()+main = booting (pluginSimple "application") go+  where+    go = forever $ do+      logInfo "Hello, world!"+      liftIO $ threadDelay 1000000
+ src/Boots.hs view
@@ -0,0 +1,22 @@+-- |+-- Module:      Boots+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- Boot application by using plugins.+--+-- >>> booting (pluginSimple "application") (logInfo "hello")+-- 2019-07-27 19:35:30  INFO [application] Ghci1 - hello+-- >>> booting (pluginSimple "application") (require "user" >>= logInfo)+-- 2019-07-27 19:37:45  INFO [application] Ghci2 - daniel+--+module Boots(+    module Boots.Internal+  , module Boots.Plugin+  ) where++import           Boots.Internal+import           Boots.Plugin
+ src/Boots/Internal.hs view
@@ -0,0 +1,25 @@+-- |+-- Module:      Boots.Internal+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- Boot cores.+--+module Boots.Internal(+  -- * Main function+    booting+  -- * Application+  , module Boots.Internal.App+  -- * Application plugin+  , module Boots.Internal.Plugin+  ) where++import           Boots.Internal.App+import           Boots.Internal.Plugin++-- | Run application using a plugin. Context @cxt@ can't escape from @m@.+booting :: Plugin () m cxt -> AppT cxt m () -> m ()+booting plugin app = runPlugin () plugin (`runAppT` app)
+ src/Boots/Internal/App.hs view
@@ -0,0 +1,42 @@+-- |+-- Module:      Boots.Internal.Plugin+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- This module defines a generic application monad transformation.+--+module Boots.Internal.App(+    AppT+  , runAppT+  , liftIO+  , ask+  , lift+  , throwM+  ) where++import           Boots.Internal.Plugin+import           Control.Monad.Catch+import           Control.Monad.IO.Unlift+import           Control.Monad.Reader++-- | Application monad transformation.+newtype AppT cxt m a = AppT { unAppT :: ReaderT cxt m a }+  deriving (Functor, Applicative, Monad, MonadTrans, MonadReader cxt, MonadIO, MonadThrow, MonadCatch, MonadMask)++-- | Run application monad transformation.+runAppT :: cxt -> AppT cxt m a -> m a+runAppT cxt ma = runReaderT (unAppT ma) cxt++instance MonadUnliftIO m => MonadUnliftIO (AppT cxt m) where+  {-# INLINE askUnliftIO #-}+  askUnliftIO = AppT $ ReaderT $ \r ->+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . runAppT r))+  {-# INLINE withRunInIO #-}+  withRunInIO inner =+    AppT $ ReaderT $ \r ->+    withRunInIO $ \run ->+    inner (run . runAppT r)
+ src/Boots/Internal/Plugin.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+-- |+-- Module:      Boots.Internal.Plugin+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- This module defines a generic application plugin used when booting application.+--+module Boots.Internal.Plugin(+    Plugin+  , runPlugin+  , promote+  , withPlugin+  , mapPlugin+  , bracketP+  ) where++import           Control.Monad.Catch+import           Control.Monad.Cont+import           Control.Monad.Reader++-- | Plugin generates component @u@ with the context of component @i@ running in monad @m@.+newtype Plugin i m u = Plugin { unPlugin :: ReaderT i (ContT () m) u }+  deriving (Functor, Applicative, Monad, MonadReader i, MonadIO)++-- | Run plugin in given context @i@.+runPlugin :: i -> Plugin i m u -> (u -> m ()) -> m ()+runPlugin i pma = runContT (runReaderT (unPlugin pma) i)++instance MonadTrans (Plugin i) where+  lift = Plugin . lift . lift++instance MonadThrow m => MonadThrow (Plugin i m) where+  throwM = lift . throwM++instance Monad m => MonadCont (Plugin i m) where+  callCC a = do+    i <- ask+    Plugin . lift . ContT . runPlugin i $ callCC a++-- | Promote a plugin into another.+promote :: i -> Plugin i m u -> Plugin x m u+promote i pimu = Plugin $ lift $ ContT (runPlugin i pimu)++-- | Convert a plugin into another.+withPlugin :: (i -> j) -> Plugin j m u -> Plugin i m u+withPlugin f = Plugin . withReaderT f . unPlugin++-- | Apply a function to transform the result of a continuation-passing computation.+mapPlugin :: (m () -> m ()) -> Plugin i m u -> Plugin i m u+mapPlugin f = Plugin . mapReaderT (mapContT f) . unPlugin+++-- | Create bracket style plugin, used for manage resources, which need to open and close.+--+-- A simple example:+--+-- >>> res = bracketP (putStrLn "open") (const $ putStrLn "close")+-- >>> runPlugin () res (const $ putStrLn "using")+-- open+-- using+-- close+bracketP+  :: MonadCatch m+  => m u          -- ^ Open resource.+  -> (u -> m ())  -- ^ Close resource.+  -> Plugin i m u -- ^ Resource plugin.+bracketP op cl = Plugin $ lift $ withContT go (lift op)+  where+    {-# INLINE go #-}+    go f u = do+      v <- try (f u)+      cl u+      case v of+        Left  e -> throwM (e :: SomeException)+        Right x -> return x
+ src/Boots/Plugin.hs view
@@ -0,0 +1,22 @@+-- |+-- Module:      Boots.Plugin+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- Boot plugins.+--+module Boots.Plugin(+  -- * Simple Plugin+    module Boots.Plugin.Simple+  -- * Configuration Plugin+  , module Boots.Plugin.Salak+  -- * Logger Plugin+  , module Boots.Plugin.Logger+  ) where++import           Boots.Plugin.Logger+import           Boots.Plugin.Salak+import           Boots.Plugin.Simple
+ src/Boots/Plugin/Logger.hs view
@@ -0,0 +1,123 @@+-- |+-- Module:      Boots.Plugin.Logger+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- This module wrap a logging function into a plugin.+--+module Boots.Plugin.Logger(+    HasLogger(..)+  , LogConfig(..)+  , LogFunc+  , addTrace+  , pluginLogger+  -- ** Logger functions+  , logInfo+  , logDebug+  , logWarn+  , logError+  , logOther+  ) where++import           Boots.Internal+import           Boots.Plugin.Salak+import           Control.Monad+import           Control.Monad.Logger.CallStack+import           Control.Monad.Reader+import           Data.Default+import           Data.Text                      (Text, toLower, unpack)+import           Data.Word+import           Lens.Micro+import           Lens.Micro.Extras+import           Salak+import           System.Log.FastLogger++-- | Environment providing a logging function.+class HasLogger cxt where+  askLogger :: Lens' cxt LogFunc++instance HasLogger LogFunc where+  askLogger = id++instance (MonadIO m, HasLogger cxt) => MonadLogger (Plugin cxt m) where+  monadLoggerLog a b c d = do+    LogFunc{..} <- asks (view askLogger)+    liftIO $ logfunc a b c (toLogStr d)++instance (MonadIO m, HasLogger cxt) => MonadLogger (AppT cxt m) where+  monadLoggerLog a b c d = do+    LogFunc{..} <- asks (view askLogger)+    liftIO $ logfunc a b c (toLogStr d)++instance Monad m => FromProp m LogLevel where+  fromProp = readEnum (fromEnumProp.toLower)+    where+      fromEnumProp "debug" = Right   LevelDebug+      fromEnumProp "info"  = Right   LevelInfo+      fromEnumProp "warn"  = Right   LevelWarn+      fromEnumProp "error" = Right   LevelError+      fromEnumProp u       = Left $ "unknown level: " ++ unpack u++{-# INLINE toStr #-}+toStr :: LogLevel -> LogStr+toStr LevelDebug     = "DEBUG"+toStr LevelInfo      = " INFO"+toStr LevelWarn      = " WARN"+toStr LevelError     = "ERROR"+toStr (LevelOther l) = toLogStr l++-- | Logger config.+data LogConfig = LogConfig+  { bufferSize    :: Word16         -- ^ Logger buffer size.+  , file          :: Maybe FilePath -- ^ Logger file path.+  , maxSize       :: Word32         -- ^ Max logger file size.+  , rotateHistory :: Word16         -- ^ Max number of logger files should be reserved.+  , level         :: IO LogLevel    -- ^ Log level to show.+  }+instance Default LogConfig where+  def = LogConfig 4096 Nothing 10485760 256 (return LevelInfo)++instance MonadIO m => FromProp m LogConfig where+  fromProp = LogConfig+    <$> "buffer-size" .?: bufferSize+    <*> "file"        .?: file+    <*> "max-size"    .?: maxSize+    <*> "max-history" .?: rotateHistory+    <*> "level"       .?: level++data LogFunc = LogFunc+  { logfunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+  , logend  :: IO ()+  }++newLogger :: Text -> LogConfig -> IO LogFunc+newLogger name LogConfig{..} = do+  tc            <- newTimeCache "%Y-%m-%d %T"+  let ln = " [" <> toLogStr name <> "] "+      ft = case file of+        Just f -> LogFile (FileLogSpec f (toInteger maxSize) (fromIntegral rotateHistory)) $ fromIntegral bufferSize+        _      -> LogStdout $ fromIntegral bufferSize+  (l,close) <- newTimedFastLogger tc ft+  return (LogFunc (toLogger ln l) close)+  where+    toLogger xn f Loc{..} _ ll s = do+      lc <- level+      when (lc <= ll) $ f $ \t ->+        let locate = if ll /= LevelError then "" else " @" <> toLogStr loc_filename <> toLogStr (show loc_start)+        in toLogStr t <> " " <> toStr ll <> xn <> toLogStr loc_module <> locate <> " - " <> s <> "\n"++-- | Add additional trace info into log.+addTrace :: Text -> LogFunc -> LogFunc+addTrace trace lf = lf { logfunc = \a b c d -> let p = "[" <> toLogStr trace <> "] " in logfunc lf a b c (p <> d) }++-- | Plugin providing a logging function.+pluginLogger+  :: (MonadIO m, MonadCatch m, HasSalak cxt)+  => Text -- ^ Application name will be logged in log.+  -> Plugin cxt m LogFunc+pluginLogger name = do+  lc <- require "logging"+  bracketP (liftIO $ newLogger name lc) (\LogFunc{..} -> liftIO logend)
+ src/Boots/Plugin/Salak.hs view
@@ -0,0 +1,43 @@+-- |+-- Module:      Boots.Plugin.Salak+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- This module wrap 'salak' into a plugin.+--+module Boots.Plugin.Salak(+    HasSalak(..)+  , pluginSalak+  -- ** Configuration Functions+  , MonadSalak(..)+  ) where++import           Boots.Internal+import           Control.Monad.Reader+import           Lens.Micro+import           Lens.Micro.Extras+import           Salak+import           Salak.Yaml++-- | Environment providing a configuration parser.+class HasSalak cxt where+  askSourcePack :: Lens' cxt SourcePack++instance HasSalak SourcePack where+  askSourcePack = id++instance HasSalak cxt => MonadSalak (Plugin cxt m) where+  askSalak = asks (view askSourcePack)++instance (Monad m, HasSalak cxt) => MonadSalak (AppT cxt m) where+  askSalak = asks (view askSourcePack)++-- | Plugin used for parse properties.+pluginSalak+  :: (MonadIO m, MonadCatch m)+  => String -- ^ Configuration file name.+  -> Plugin () m SourcePack+pluginSalak name = lift $ runSalakWithYaml name askSalak
+ src/Boots/Plugin/Simple.hs view
@@ -0,0 +1,51 @@+-- |+-- Module:      Boots.Plugin.Simple+-- Copyright:   2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- This module defines simple application plugin.+--+module Boots.Plugin.Simple(+    Simple(..)+  , HasSimple(..)+  , pluginSimple+  ) where++import           Boots.Internal+import           Boots.Plugin.Logger+import           Boots.Plugin.Salak+import           Data.Text           (Text, unpack)+import           Lens.Micro+import           Salak++-- | Simple plugin initialized both configurations 'pluginSalak' and logger 'pluginLogger'.+data Simple = Simple+  { sourcePack :: SourcePack+  , logFunc    :: LogFunc+  }++-- | Environment values with a configuration parser and logging function.+class HasSimple cxt where+  askSimple :: Lens' cxt Simple++instance HasSimple Simple where+  askSimple = id++instance HasLogger Simple where+  askLogger = lens logFunc (\x y -> x { logFunc = y})++instance HasSalak Simple where+  askSourcePack = lens sourcePack (\x y -> x {sourcePack = y})++-- | Simple plugin provides a configuration parser and logging function.+pluginSimple+  :: (MonadCatch m, MonadIO m)+  => Text -- ^ Application name and configuration file name.+  -> Plugin () m Simple+pluginSimple application = do+  sourcePack <- pluginSalak $ unpack application+  logFunc    <- promote sourcePack $ pluginLogger application+  return Simple{..}