di-polysemy 0.1.1.2 → 0.1.2.0
raw patch · 3 files changed
+65/−57 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- DiPolysemy: [Attr_] :: Key -> Value -> m a -> Di level Path msg m a
- DiPolysemy: [Push] :: Segment -> m a -> Di level Path msg m a
+ DiPolysemy: [Local] :: (Di level path msg -> Di level path msg) -> m a -> Di level path msg m a
+ DiPolysemy: local :: forall level_aaNu path_aaNv msg_aaNw r_abpW a_aaNy. MemberWithError (Di level_aaNu path_aaNv msg_aaNw) r_abpW => (Di level_aaNu path_aaNv msg_aaNw -> Di level_aaNu path_aaNv msg_aaNw) -> Sem r_abpW a_aaNy -> Sem r_abpW a_aaNy
- DiPolysemy: attr_ :: forall level_aaR6 msg_aaR7 r_abuK a_aaR5. MemberWithError (Di level_aaR6 Path msg_aaR7) r_abuK => Key -> Value -> Sem r_abuK a_aaR5 -> Sem r_abuK a_aaR5
+ DiPolysemy: attr_ :: forall level msg r a. Member (Di level Path msg) r => Key -> Value -> Sem r a -> Sem r a
- DiPolysemy: flush :: forall level_aaMi path_aaMj msg_aaMk r_abuG. MemberWithError (Di level_aaMi path_aaMj msg_aaMk) r_abuG => Sem r_abuG ()
+ DiPolysemy: flush :: forall level_aaNq path_aaNr msg_aaNs r_abpV. MemberWithError (Di level_aaNq path_aaNr msg_aaNs) r_abpV => Sem r_abpV ()
- DiPolysemy: log :: forall level_aaMe path_aaMg msg_aaMf r_abuD. MemberWithError (Di level_aaMe path_aaMg msg_aaMf) r_abuD => level_aaMe -> msg_aaMf -> Sem r_abuD ()
+ DiPolysemy: log :: forall level_aaNm path_aaNo msg_aaNn r_abpS. MemberWithError (Di level_aaNm path_aaNo msg_aaNn) r_abpS => level_aaNm -> msg_aaNn -> Sem r_abpS ()
- DiPolysemy: push :: forall level_aaMo msg_aaMp r_abuH a_aaMn. MemberWithError (Di level_aaMo Path msg_aaMp) r_abuH => Segment -> Sem r_abuH a_aaMn -> Sem r_abuH a_aaMn
+ DiPolysemy: push :: forall level msg r a. Member (Di level Path msg) r => Segment -> Sem r a -> Sem r a
Files
- CHANGELOG.md +5/−0
- di-polysemy.cabal +3/−3
- src/DiPolysemy.hs +57/−54
CHANGELOG.md view
@@ -3,6 +3,11 @@ `di-polysemy` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.1.2.0++* 'runDiToIO' now reinterprets in terms of reader+* The effect has been generalised and now has: Log, Flush, and Local+ ## 0.0.0.0 * Initially created.
di-polysemy.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 93f340ca37d94462e42059fc783835ed9e0580694e7d37254908ebabefcc0fb6+-- hash: ae3ff1a37592db18d658e1f2b0ecdf715409297f5e16c9acdf72d1228908a854 name: di-polysemy-version: 0.1.1.2+version: 0.1.2.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
@@ -4,6 +4,7 @@ , runDiToStderrIO , log , flush+ , local , push , attr_ , attr@@ -33,19 +34,19 @@ import qualified Di.Handle as DH import Polysemy+import qualified Polysemy.Reader as P import Prelude hiding ( error, log ) data Di level path msg m a where Log :: level -> msg -> Di level path msg m () Flush :: Di level path msg m ()- Push :: D.Segment -> m a -> Di level D.Path msg m a- Attr_ :: D.Key -> D.Value -> m a -> Di level D.Path msg m a+ Local :: (DC.Di level path msg -> DC.Di level path msg) -> m a -> Di level path msg m a makeSem ''Di data DiIOInner m a where- RunDiIOInner :: (DC.Log level D.Path msg -> IO ()) -> (DC.Di level D.Path msg -> m a) -> DiIOInner m a+ RunDiIOInner :: (DC.Log level Df1.Path msg -> IO ()) -> (DC.Di level Df1.Path msg -> m a) -> DiIOInner m a makeSem ''DiIOInner @@ -67,78 +68,80 @@ runDiToIO :: forall r level msg a. Member (Embed IO) r- => (DC.Log level D.Path msg -> IO ())- -> Sem (Di level D.Path msg ': r) a+ => (DC.Log level Df1.Path msg -> IO ())+ -> Sem (Di level Df1.Path msg ': r) a -> Sem r a-runDiToIO commit m = diToIO $ runDiIOInner commit (`go` raiseUnder m)+runDiToIO commit m = diToIO $ runDiIOInner commit (flip P.runReader $ go (raiseUnder m)) where- go :: Member (Embed IO) r0 => DC.Di level D.Path msg -> Sem (Di level D.Path msg ': r0) a0 -> Sem r0 a0- go di m = (`interpretH` m) $ \case+ go :: Member (Embed IO) r0 => Sem (Di level Df1.Path msg ': r0) a0 -> Sem (P.Reader (DC.Di level Df1.Path msg) ': r0) a0+ go = reinterpretH $ \case Log level msg -> do- t <- embed @IO $ DC.log di level msg- pureT t- Flush -> do- t <- embed @IO $ DC.flush di- pureT t- Push s m' -> do- mm <- runT m'- raise $ go (Df1.push s di) mm- Attr_ k v m' -> do- mm <- runT m'- raise $ go (Df1.attr_ k v di) mm+ di <- P.ask @(DC.Di level Df1.Path msg)+ r <- embed @IO $ DC.log di level msg+ pureT r+ Flush -> P.ask @(DC.Di level Df1.Path msg) >>= embed @IO . DC.flush >>= pureT+ Local f m -> do+ m' <- go <$> runT m+ raise $ subsume $ P.local @(DC.Di level Df1.Path msg) f m' -runDiToStderrIO :: Member (Embed IO) r => Sem (Di D.Level D.Path D.Message ': r) a -> Sem r a+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 -attr :: forall value level msg r a. (D.ToValue value, Member (Di level D.Path msg) r) => D.Key -> value -> Sem r a -> Sem r a-attr k v = attr_ @level @msg k (D.value v)+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) -debug :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-debug = log @D.Level @path D.Debug . D.message+attr_ :: forall level msg r a. Member (Di level Df1.Path msg) r => Df1.Key -> Df1.Value -> Sem r a -> Sem r a+attr_ k v = local @level @Df1.Path @msg (Df1.attr_ k v) -info :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-info = log @D.Level @path D.Info . D.message+attr :: forall value level msg r a. (Df1.ToValue value, Member (Di level Df1.Path msg) r) => Df1.Key -> value -> Sem r a -> Sem r a+attr k v = attr_ @level @msg k (Df1.value v) -notice :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-notice = log @D.Level @path D.Notice . D.message+debug :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+debug = log @Df1.Level @path D.Debug . Df1.message -warning :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-warning = log @D.Level @path D.Warning . D.message+info :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+info = log @Df1.Level @path D.Info . Df1.message -error :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-error = log @D.Level @path D.Error . D.message+notice :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+notice = log @Df1.Level @path D.Notice . Df1.message -alert :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-alert = log @D.Level @path D.Alert . D.message+warning :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+warning = log @Df1.Level @path D.Warning . Df1.message -critical :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-critical = log @D.Level @path D.Critical . D.message+error :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+error = log @Df1.Level @path D.Error . Df1.message -emergency :: forall msg path r. (D.ToMessage msg, Member (Di D.Level path D.Message) r) => msg -> Sem r ()-emergency = log @D.Level @path D.Emergency . D.message+alert :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+alert = log @Df1.Level @path D.Alert . Df1.message -debug_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-debug_ = log @D.Level @path D.Debug+critical :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+critical = log @Df1.Level @path D.Critical . Df1.message -info_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-info_ = log @D.Level @path D.Info+emergency :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()+emergency = log @Df1.Level @path D.Emergency . Df1.message -notice_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-notice_ = log @D.Level @path D.Notice+debug_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+debug_ = log @Df1.Level @path D.Debug -warning_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-warning_ = log @D.Level @path D.Warning+info_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+info_ = log @Df1.Level @path D.Info -error_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-error_ = log @D.Level @path D.Error+notice_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+notice_ = log @Df1.Level @path D.Notice -alert_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-alert_ = log @D.Level @path D.Alert+warning_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+warning_ = log @Df1.Level @path D.Warning -critical_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-critical_ = log @D.Level @path D.Critical+error_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+error_ = log @Df1.Level @path D.Error -emergency_ :: forall path r. Member (Di D.Level path D.Message) r => D.Message -> Sem r ()-emergency_ = log @D.Level @path D.Emergency+alert_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+alert_ = log @Df1.Level @path D.Alert++critical_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+critical_ = log @Df1.Level @path D.Critical++emergency_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()+emergency_ = log @Df1.Level @path D.Emergency