packages feed

di-polysemy 0.1.4.0 → 0.2.0.0

raw patch · 3 files changed

+34/−85 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- DiPolysemy: [Reset] :: m a -> Di level path msg m a
- DiPolysemy: reset :: forall level_a9ZJ path_a9ZK msg_a9ZL r_aaDu a_a9ZI. MemberWithError (Di level_a9ZJ path_a9ZK msg_a9ZL) r_aaDu => Sem r_aaDu a_a9ZI -> Sem r_aaDu a_a9ZI
- DiPolysemy: runDiToIOFinal :: forall r level msg a. Members '[Final IO, Embed IO] r => (Log level Path msg -> IO ()) -> Sem (Di level Path msg : r) a -> Sem r a
- DiPolysemy: runDiToStderrIO :: Member (Embed IO) r => Sem (Di Level Path Message : r) a -> Sem r a
- DiPolysemy: runDiToStderrIOFinal :: Members '[Final IO, Embed IO] r => Sem (Di Level Path Message : r) a -> Sem r a
+ DiPolysemy: [Fetch] :: Di level path msg m (Maybe (Di level path msg))
+ DiPolysemy: fetch :: forall level_a8wV path_a8wW msg_a8wX r_achy. MemberWithError (Di level_a8wV path_a8wW msg_a8wX) r_achy => Sem r_achy (Maybe (Di level_a8wV path_a8wW msg_a8wX))
+ DiPolysemy: runDiNoop :: forall r level msg a. Sem (Di level Path msg : r) a -> Sem r a
+ DiPolysemy: runDiToIOReader :: forall r a level msg. Members '[Embed IO, Reader (Di level Path msg)] r => Sem (Di level Path msg : r) a -> Sem r a
- DiPolysemy: flush :: forall level_a9Zy path_a9Zz msg_a9ZA r_aaDq. MemberWithError (Di level_a9Zy path_a9Zz msg_a9ZA) r_aaDq => Sem r_aaDq ()
+ DiPolysemy: flush :: forall level_a8wM path_a8wN msg_a8wO r_achu. MemberWithError (Di level_a8wM path_a8wN msg_a8wO) r_achu => Sem r_achu ()
- DiPolysemy: local :: forall level_a9ZC path_a9ZD msg_a9ZE r_aaDr a_a9ZG. MemberWithError (Di level_a9ZC path_a9ZD msg_a9ZE) r_aaDr => (Di level_a9ZC path_a9ZD msg_a9ZE -> Di level_a9ZC path_a9ZD msg_a9ZE) -> Sem r_aaDr a_a9ZG -> Sem r_aaDr a_a9ZG
+ DiPolysemy: local :: forall level_a8wQ path_a8wR msg_a8wS r_achv a_a8wU. MemberWithError (Di level_a8wQ path_a8wR msg_a8wS) r_achv => (Di level_a8wQ path_a8wR msg_a8wS -> Di level_a8wQ path_a8wR msg_a8wS) -> Sem r_achv a_a8wU -> Sem r_achv a_a8wU
- DiPolysemy: log :: forall level_a9Zu path_a9Zw msg_a9Zv r_aaDn. MemberWithError (Di level_a9Zu path_a9Zw msg_a9Zv) r_aaDn => level_a9Zu -> msg_a9Zv -> Sem r_aaDn ()
+ DiPolysemy: log :: forall level_a8wI path_a8wK msg_a8wJ r_achr. MemberWithError (Di level_a8wI path_a8wK msg_a8wJ) r_achr => level_a8wI -> msg_a8wJ -> Sem r_achr ()
- DiPolysemy: runDiToIO :: forall r level msg a. Member (Embed IO) r => (Log level Path msg -> IO ()) -> Sem (Di level Path msg : r) a -> Sem r a
+ DiPolysemy: runDiToIO :: forall r level msg a. Member (Embed IO) r => Di level Path msg -> Sem (Di level Path msg : r) a -> Sem r a

Files

CHANGELOG.md view
@@ -3,6 +3,15 @@ `di-polysemy` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.2.0.0++* `runDiToStderrIO`, `runDiToIOFinal`, `runDiToStderrIOFinal` and the `Reset`+  action have been removed.+* The `Fetch` action has been added.+* `runDiToIOReader`, and `runDiNoop` has been added.+* `runDiToIO` now needs a `Di` value to be passed to it, the library now doesn't+  create the Di value.+ ## 0.1.4.0  * `runDiToIOFinal` and `runDiToStderrIOFinal` have been added
di-polysemy.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7d5a66b6c7f2d80869176c92262777e8ff5e62c94a600d922c5ee4a2d4a75b77+-- hash: a0bb51a5a8806c6d7ff483420aa6c02be35a5f140268a5366b07fecb070832d0  name:           di-polysemy-version:        0.1.4.0+version:        0.2.0.0 synopsis:       DI logger wrapped for Polysemy description:    Please see the README on GitHub at <https://github.com/nitros12/di-polysemy> category:       Logging
src/DiPolysemy.hs view
@@ -1,13 +1,12 @@ module DiPolysemy     ( Di(..)+    , runDiToIOReader     , runDiToIO-    , runDiToStderrIO-    , runDiToIOFinal-    , runDiToStderrIOFinal+    , runDiNoop     , log     , flush     , local-    , reset+    , fetch     , push     , attr_     , attr@@ -34,109 +33,50 @@  import qualified Di.Core                    as DC import qualified Di.Df1                     as Df1-import qualified Di.Handle                  as DH  import           Polysemy import qualified Polysemy.Reader as P  import           Prelude                    hiding ( error, log )-import Control.Concurrent (takeMVar, MVar, putMVar, newEmptyMVar)-import Polysemy.Async (asyncToIOFinal, async)-import Polysemy.Resource (resourceToIOFinal, bracket)  data Di level path msg m a where   Log    :: level -> msg -> Di level path msg m ()   Flush  :: Di level path msg m ()   Local  :: (DC.Di level path msg -> DC.Di level path msg) -> m a -> Di level path msg m a-  Reset  :: m a -> Di level path msg m a+  -- | Fetch the current Di value, 'Maybe' to allow for no-op implementations+  Fetch  :: Di level path msg m (Maybe (DC.Di level path msg))  makeSem ''Di -data DiIOInner m a where-  RunDiIOInner :: (DC.Log level Df1.Path msg -> IO ()) -> (DC.Di level Df1.Path msg -> m a) -> DiIOInner m a--makeSem ''DiIOInner--diToIO :: forall r a. Member (Embed IO) r => Sem (DiIOInner ': r) a -> Sem r a-diToIO = interpretH-  (\case RunDiIOInner commit a -> do-           istate <- getInitialStateT-           ma <- bindT a--           withLowerToIO $ \lower finish -> do-             let done :: Sem (DiIOInner ': r) x -> IO x-                 done = lower . raise . diToIO--             DC.new commit (\di -> do-                               res <- done (ma $ istate $> di)-                               finish-                               pure res))--type DiR level msg = (DC.Di level Df1.Path msg, DC.Di level Df1.Path msg)--interpretDi :: forall r a level msg. Members '[Embed IO, P.Reader (DiR level msg)] r+runDiToIOReader :: forall r a level msg. Members '[Embed IO, P.Reader (DC.Di level Df1.Path msg)] r       => Sem (Di level Df1.Path msg ': r) a       -> Sem r a-interpretDi = interpretH $ \case+runDiToIOReader = interpretH $ \case       Log level msg -> do-        (_, di) <- P.ask @(DiR level msg)+        di <- P.ask @(DC.Di level Df1.Path msg)         (embed @IO $ DC.log di level msg) >>= pureT       Flush         -> do-        (_, di) <- P.ask @(DiR level msg)+        di <- P.ask @(DC.Di level Df1.Path msg)         (embed @IO $ DC.flush di) >>= pureT       Local f m     -> do-        m' <- interpretDi <$> runT m-        raise $ P.local @(DiR level msg) (fmap f) m'-      Reset m       -> do-        m' <- interpretDi <$> runT m-        raise $ P.local @(DiR level msg) (\(odi, _) -> (odi, odi)) m'--dup :: a -> (a, a)-dup a = (a, a)--runDiToIOFinal-  :: forall r level msg a.-  Members '[Final IO, Embed IO] r-  => (DC.Log level Df1.Path msg -> IO ())-  -> Sem (Di level Df1.Path msg ': r) a-  -> Sem r a-runDiToIOFinal commit m = do-  diIn <- embedFinal newEmptyMVar-  diOut <- embedFinal newEmptyMVar-  void . asyncToIOFinal . async . embedFinal $ DC.new commit $ outer diIn diOut-  inner diIn diOut-  where-    outer :: MVar (DC.Di level Df1.Path msg) -> MVar (DC.Di level Df1.Path msg) -> (DC.Di level Df1.Path msg) -> IO ()-    outer aIn aOut a = do-      putMVar aIn a-      void $ takeMVar aOut--    inner :: MVar (DC.Di level Df1.Path msg) -> MVar (DC.Di level Df1.Path msg) -> Sem r a-    inner diIn diOut = resourceToIOFinal $ bracket-                       (embedFinal $ takeMVar diIn)-                       (embedFinal . putMVar diOut)-                       (\di -> raise . P.runReader (di, di) $ interpretDi (raiseUnder $ m))--runDiToStderrIOFinal :: Members '[Final IO, Embed IO] r => Sem (Di Df1.Level Df1.Path Df1.Message ': r) a -> Sem r a-runDiToStderrIOFinal m = do-  commit <- embedFinal @IO $ DH.stderr Df1.df1-  runDiToIOFinal commit m+        m' <- runDiToIOReader <$> runT m+        raise $ P.local @(DC.Di level Df1.Path msg) f m'+      Fetch -> do+        di <- Just <$> P.ask @(DC.Di level Df1.Path msg)+        pureT di -runDiToIO-  :: forall r level msg a.-  Member (Embed IO) r-  => (DC.Log level Df1.Path msg -> IO ())+runDiToIO :: forall r level msg a. Member (Embed IO) r+  => DC.Di level Df1.Path msg   -> Sem (Di level Df1.Path msg ': r) a   -> Sem r a-runDiToIO commit m = diToIO inner-  where inner :: Sem (DiIOInner ': r) a-        inner = runDiIOInner commit (raise . flip (P.runReader . dup) (interpretDi $ raiseUnder m))-+runDiToIO di = P.runReader di . runDiToIOReader . raiseUnder -runDiToStderrIO :: Member (Embed IO) r => Sem (Di Df1.Level Df1.Path Df1.Message ': r) a -> Sem r a-runDiToStderrIO m = do-  commit <- embed @IO $ DH.stderr Df1.df1-  runDiToIO commit m+runDiNoop :: forall r level msg a. Sem (Di level Df1.Path msg ': r) a -> Sem r a+runDiNoop = interpretH \case+      Log _level _msg -> pureT ()+      Flush           -> pureT ()+      Local _f  m     -> runDiNoop <$> runT m >>= raise+      Fetch           -> pureT Nothing  push :: forall level msg r a. Member (Di level Df1.Path msg) r => Df1.Segment -> Sem r a -> Sem r a push s = local @level @Df1.Path @msg (Df1.push s)