@@ -4,6 +4,7 @@
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
66{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE ImplicitParams #-}
78{-# LANGUAGE MultiParamTypeClasses #-}
89{-# LANGUAGE OverloadedStrings #-}
910{-# LANGUAGE RankNTypes #-}
@@ -46,6 +47,8 @@ import qualified Data.Text as T
4647import qualified Data.Text.Lazy.Builder as B
4748import Data.Time
4849import GHC.Generics hiding (to)
50+import GHC.SrcLoc
51+import GHC.Stack
4952import Language.Haskell.TH
5053import qualified Language.Haskell.TH.Syntax as TH
5154import Lens.Micro
@@ -721,16 +724,26 @@ liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
721724-------------------------------------------------------------------------------
722725-- | For use when you want to include location in your logs. This will
723726-- fill the 'Maybe Loc' gap in 'logF' of this module.
724−getLoc :: Q Exp
725−getLoc = [| $(location >>= liftLoc) |]
726−
727+getLoc :: (?loc :: CallStack) => Maybe Loc
728+getLoc = case getCallStack ?loc of
729+ [] -> Nothing
730+ xs -> Just . toLoc . last $ xs
731+ where
732+ toLoc :: (String, SrcLoc) -> Loc
733+ toLoc (_, l) = Loc {
734+ loc_filename = srcLocFile l
735+ , loc_package = srcLocPackage l
736+ , loc_module = srcLocModule l
737+ , loc_start = (srcLocStartLine l, srcLocStartCol l)
738+ , loc_end = (srcLocEndLine l, srcLocEndCol l)
739+ }
727740
728741-------------------------------------------------------------------------------
729742-- | 'Loc'-tagged logging when using template-haskell.
730743--
731744-- @$(logT) obj mempty InfoS "Hello world"@
732745logT :: ExpQ
733−logT = [| \ a ns sev msg -> logItem a ns (Just $(getLoc)) sev msg |]
746+logT = [| \ a ns sev msg -> logItem a ns getLoc sev msg |]
734747
735748
736749-- taken from the file-location package