{-# LANGUAGE TemplateHaskell #-}
module FileLocation
( err, err', undef, fromJst, fromRht, indx, indxShow
, debug, debugM, debugMsg, debugMsgIf, dbg, dbgMsg, trc, ltrace, ltraceM, strace
, locationToString
, thrwIO, thrwsIO
, reThrow
)
where
import FileLocation.LocationString (locationToString)
import Debug.FileLocation (debug, debugM, debugMsg, dbg, dbgMsg, trc, ltrace, ltraceM, strace)
import Debug.Util (debugMsgIf)
import Control.Exception.FileLocation (thrwIO, thrwsIO, reThrow)
import Debug.Trace (trace)
import Language.Haskell.TH.Syntax
import Language.Haskell.TH(varE)
import Data.Maybe(fromMaybe)
import qualified Data.Map as M (lookup)
err :: String -> Q Exp
err :: String -> Q Exp
err str :: String
str = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: String
prefix = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
[|error (prefix ++ str)|]
err' :: Q Exp
err' :: Q Exp
err' = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: String
prefix = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
[| error . (prefix ++) |]
undef :: Q Exp
undef :: Q Exp
undef = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: String
prefix = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
[|trace (prefix ++ "undefined") undefined|]
fromJst :: Q Exp
fromJst :: Q Exp
fromJst = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let msg :: String
msg = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " fromJst: Nothing"
[|\_m -> case _m of
Just _v -> _v
Nothing -> error msg|]
fromRht :: Q Exp
fromRht :: Q Exp
fromRht = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let msg :: String
msg = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " fromRht: Left: "
[|\_m -> case _m of
Right _v -> _v
Left _e -> error (msg ++ show _e)|]
indx :: Q Exp
indx :: Q Exp
indx = Bool -> Q Exp
indx_common Bool
False
indxShow :: Q Exp
indxShow :: Q Exp
indxShow = Bool -> Q Exp
indx_common Bool
True
indx_common :: Bool -> Q Exp
indx_common :: Bool -> Q Exp
indx_common = Q Exp -> Bool -> Q Exp
indxWith_common [| M.lookup |]
indxWith_common :: Q Exp -> Bool -> Q Exp
indxWith_common :: Q Exp -> Bool -> Q Exp
indxWith_common lookupE :: Q Exp
lookupE showElt :: Bool
showElt = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let msg :: String
msg = (Loc -> String
locationToString Loc
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " indx: Element not in the map"
msgE :: Name -> Q Exp
msgE varName :: Name
varName = if Bool
showElt
then [| msg ++ ": " ++ show $(varE varName) |]
else [| msg |]
[| \_x _m -> fromMaybe (error $(msgE '_x)) ($(lookupE) _x _m) |]