git-annex/standalone/android/haskell-patches/monad-logger-0.2.3.2_0001-remove-TH-logging-stuff.patch
Joey Hess 1bc5734037 add patches porting necessary Haskell libraries to Android
This goes all the way up to Yesod, but everything above Wai is a real hack
job, removing TH left and right.
2013-02-28 23:43:26 -04:00

124 lines
3.9 KiB
Diff

From ca88563e63cc31f0b96b00d3a4fe1f0c56b1e1eb Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 28 Feb 2013 23:32:01 -0400
Subject: [PATCH] remove TH logging stuff
---
Control/Monad/Logger.hs | 76 -----------------------------------------------
monad-logger.cabal | 2 +-
2 files changed, 1 insertion(+), 77 deletions(-)
diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
index fd1282b..80b8ed9 100644
--- a/Control/Monad/Logger.hs
+++ b/Control/Monad/Logger.hs
@@ -27,18 +27,6 @@ module Control.Monad.Logger
, LoggingT (..)
, runStderrLoggingT
, runStdoutLoggingT
- -- * TH logging
- , logDebug
- , logInfo
- , logWarn
- , logError
- , logOther
- -- * TH logging with source
- , logDebugS
- , logInfoS
- , logWarnS
- , logErrorS
- , logOtherS
) where
import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
@@ -91,13 +79,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) )
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
deriving (Eq, Prelude.Show, Prelude.Read, Ord)
-instance Lift LogLevel where
- lift LevelDebug = [|LevelDebug|]
- lift LevelInfo = [|LevelInfo|]
- lift LevelWarn = [|LevelWarn|]
- lift LevelError = [|LevelError|]
- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|]
-
type LogSource = Text
class Monad m => MonadLogger m where
@@ -128,63 +109,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF
instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF
#undef DEF
-logTH :: LogLevel -> Q Exp
-logTH level =
- [|monadLoggerLog $(qLocation >>= liftLoc) $(lift level) . (id :: Text -> Text)|]
-
--- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
---
--- > $(logDebug) "This is a debug log message"
-logDebug :: Q Exp
-logDebug = logTH LevelDebug
-
--- | See 'logDebug'
-logInfo :: Q Exp
-logInfo = logTH LevelInfo
--- | See 'logDebug'
-logWarn :: Q Exp
-logWarn = logTH LevelWarn
--- | See 'logDebug'
-logError :: Q Exp
-logError = logTH LevelError
-
--- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
---
--- > $(logOther "My new level") "This is a log message"
-logOther :: Text -> Q Exp
-logOther = logTH . LevelOther
-
-liftLoc :: Loc -> Q Exp
-liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
- $(lift a)
- $(lift b)
- $(lift c)
- ($(lift d1), $(lift d2))
- ($(lift e1), $(lift e2))
- |]
-
--- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:
---
--- > $logDebug "SomeSource" "This is a debug log message"
-logDebugS :: Q Exp
-logDebugS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
-
--- | See 'logDebugS'
-logInfoS :: Q Exp
-logInfoS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
--- | See 'logDebugS'
-logWarnS :: Q Exp
-logWarnS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
--- | See 'logDebugS'
-logErrorS :: Q Exp
-logErrorS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelError (b :: Text)|]
-
--- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:
---
--- > $logOther "SomeSource" "My new level" "This is a log message"
-logOtherS :: Q Exp
-logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
-
-- | Monad transformer that adds a new logging function.
--
-- Since 0.2.2
diff --git a/monad-logger.cabal b/monad-logger.cabal
index ab71424..fa3d292 100644
--- a/monad-logger.cabal
+++ b/monad-logger.cabal
@@ -24,4 +24,4 @@ library
, transformers-base
, monad-control
, mtl
- , bytestring
+ , bytestring >= 0.10.3.0
--
1.7.10.4