{-# LANGUAGE TemplateHaskell #-}
-- | see Debug.FileLocation module for more definitions
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)

-- | Like Prelude.error, but gives the file location.
--
-- > $(err "OH NO!")
-- > main:Main main.hs:4:10 OH NO!
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)|]

-- | Like 'err', but the error message (to be appended to the location) is an argument of the generated expression.
--
-- > $(err) "OH NO!"
-- > main:Main main.hs:4:10 OH NO!
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 ++) |]

-- | Like Prelude.undefined, but gives the file location.
--
-- Uses trace to output the location (this way we still use undefined instead of calling error).
--
-- > $(undef)
-- > main:Main main.hs:4:10 undefined
-- > err: Prelude.undefined
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|]

-- | Like 'fromJust', but also shows the file location.
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|]

-- | Like 'fromRight', but also show the file location.
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)|]

-- | Like @(flip ('Data.Map.!')@, but also shows the file location in case the element isn't found.
indx :: Q Exp
indx :: Q Exp
indx = Bool -> Q Exp
indx_common Bool
False

-- | Like 'indx', but also 'show's the looked-up element in case it isn't found.
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) |]