@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveFunctor #-}
23{-# LANGUAGE DeriveGeneric #-}
34{-# LANGUAGE ExistentialQuantification #-}
@@ -47,8 +48,10 @@ import qualified Data.Text as T
4748import qualified Data.Text.Lazy.Builder as B
4849import Data.Time
4950import GHC.Generics hiding (to)
51+#if MIN_VERSION_base(4, 8, 0)
5052import GHC.SrcLoc
5153import GHC.Stack
54+#endif
5255import Language.Haskell.TH
5356import qualified Language.Haskell.TH.Syntax as TH
5457import Lens.Micro
@@ -723,7 +726,9 @@ liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
723726
724727-------------------------------------------------------------------------------
725728-- | For use when you want to include location in your logs. This will
726−-- fill the 'Maybe Loc' gap in 'logF' of this module.
729+-- fill the 'Maybe Loc' gap in 'logF' of this module, and relies on implicit
730+-- callstacks when available (GHC > 7.8).
731+#if MIN_VERSION_base(4, 8, 0)
727732getLoc :: (?loc :: CallStack) => Maybe Loc
728733getLoc = case getCallStack ?loc of
729734 [] -> Nothing
@@ -737,18 +742,45 @@ getLoc = case getCallStack ?loc of
737742 , loc_start = (srcLocStartLine l, srcLocStartCol l)
738743 , loc_end = (srcLocEndLine l, srcLocEndCol l)
739744 }
745+#else
746+getLoc :: Maybe Loc
747+getLoc = Nothing
748+#endif
749+
750+
751+-------------------------------------------------------------------------------
752+-- Like `getLoc`, but uses template-haskell and works with older versions of
753+-- the compiler (GHC 7.8 or older).
754+getLocTH :: ExpQ
755+getLocTH = [| $(location >>= liftLoc) |]
756+
740757
741758-------------------------------------------------------------------------------
742759-- | 'Loc'-tagged logging when using template-haskell.
743760--
744−-- @logT obj mempty InfoS "Hello world"@
745−logT :: (A.Applicative m, LogItem a, Katip m)
746− => a
747− -> Namespace
748− -> Severity
749− -> LogStr
750− -> m ()
751−logT a ns = logItem a ns getLoc
761+-- @$(logT) obj mempty InfoS "Hello world"@
762+logT :: ExpQ
763+logT = [| \ a ns sev msg -> logItem a ns (Just $(getLocTH)) sev msg |]
764+
765+
766+-------------------------------------------------------------------------------
767+-- | 'Loc'-tagged logging using implicit-callstacks when available.
768+--
769+-- This function does not require template-haskell as it
770+-- automatically uses <https://hackage.haskell.org/package/base-4.8.2.0/docs/GHC-Stack.html#v:getCallStack implicit-callstacks>
771+-- when the code is compiled using GHC > 7.8. Using an older version of the
772+-- compiler will result in the emission of a log line without any location information,
773+-- so be aware of it. Users using GHC <= 7.8 may want to use the template-haskell function
774+-- `logT` for maximum compatibility.
775+--
776+-- @logLoc obj mempty InfoS "Hello world"@
777+logLoc :: (Applicative m, LogItem a, Katip m)
778+ => a
779+ -> Namespace
780+ -> Severity
781+ -> LogStr
782+ -> m ()
783+logLoc a ns = logItem a ns getLoc
752784
753785
754786-- taken from the file-location package