{-# 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 :: [Char] -> Q Exp
err [Char]
str = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: [Char]
prefix = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
[|error (prefix ++ str)|]
err' :: Q Exp
err' :: Q Exp
err' = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: [Char]
prefix = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
[| error . (prefix ++) |]
undef :: Q Exp
undef :: Q Exp
undef = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let prefix :: [Char]
prefix = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
[|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 :: [Char]
msg = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 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 :: [Char]
msg = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 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 Q Exp
lookupE Bool
showElt = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
let msg :: [Char]
msg = (Loc -> [Char]
locationToString Loc
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" indx: Element not in the map"
msgE :: Name -> m Exp
msgE Name
varName = if Bool
showElt
then [| msg ++ ": " ++ show $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
varName) |]
else [| msg |]
[| \_x _m -> fromMaybe (error $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
msgE '_x)) ($(Q Exp
lookupE) _x _m) |]