{-# language NoImplicitPrelude #-} module Exon.Debug where import qualified Data.Text as Text import GHC.Stack (SrcLoc (..)) import Relude import System.IO.Unsafe (unsafePerformIO) srcLoc :: CallStack -> SrcLoc srcLoc :: CallStack -> SrcLoc srcLoc = \case (CallStack -> [([Char], SrcLoc)] getCallStack -> ([Char] _, SrcLoc loc) : [([Char], SrcLoc)] _) -> SrcLoc loc CallStack _ -> Text -> SrcLoc forall a t. (HasCallStack, IsText t) => t -> a error Text "Debug.srcLoc: empty CallStack" debugPrint :: SrcLoc -> Text -> IO () debugPrint :: SrcLoc -> Text -> IO () debugPrint SrcLoc{srcLocModule :: SrcLoc -> [Char] srcLocModule = [Char] -> Text forall a. ToText a => a -> Text toText -> Text slm, Int srcLocStartLine :: SrcLoc -> Int srcLocStartLine :: Int srcLocStartLine} Text msg = [Char] -> IO () forall (m :: * -> *). MonadIO m => [Char] -> m () putStrLn ([Char] moduleName [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ":" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall b a. (Show a, IsString b) => a -> b show Int srcLocStartLine [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] " " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Text -> [Char] forall a. ToString a => a -> [Char] toString Text msg) where moduleName :: [Char] moduleName = Text -> [Char] forall a. ToString a => a -> [Char] toString (Text -> [Char]) -> Text -> [Char] forall a b. (a -> b) -> a -> b $ Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text slm (Maybe Text -> Text) -> Maybe Text -> Text forall a b. (a -> b) -> a -> b $ [Text] -> Maybe Text forall a. [a] -> Maybe a listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text forall a b. (a -> b) -> a -> b $ [Text] -> [Text] forall a. [a] -> [a] reverse ([Text] -> [Text]) -> [Text] -> [Text] forall a b. (a -> b) -> a -> b $ Text -> Text -> [Text] Text.splitOn Text "." Text slm debugPrintWithLoc :: Monad m => SrcLoc -> Text -> m () debugPrintWithLoc :: SrcLoc -> Text -> m () debugPrintWithLoc SrcLoc loc Text msg = do () <- () -> m () forall (m :: * -> *) a. Monad m => a -> m a return (IO () -> () forall a. IO a -> a unsafePerformIO (SrcLoc -> Text -> IO () debugPrint SrcLoc loc Text msg)) () -> m () forall (f :: * -> *) a. Applicative f => a -> f a pure () dbg :: HasCallStack => Monad m => Text -> m () dbg :: Text -> m () dbg = SrcLoc -> Text -> m () forall (m :: * -> *). Monad m => SrcLoc -> Text -> m () debugPrintWithLoc (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) {-# inline dbg #-} dbgsWith :: HasCallStack => Monad m => Show a => Text -> a -> m () dbgsWith :: Text -> a -> m () dbgsWith Text prefix a a = SrcLoc -> Text -> m () forall (m :: * -> *). Monad m => SrcLoc -> Text -> m () debugPrintWithLoc (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) (Text prefix Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ": " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> a -> Text forall b a. (Show a, IsString b) => a -> b show a a) {-# inline dbgsWith #-} dbgs :: HasCallStack => Monad m => Show a => a -> m () dbgs :: a -> m () dbgs a a = SrcLoc -> Text -> m () forall (m :: * -> *). Monad m => SrcLoc -> Text -> m () debugPrintWithLoc (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) (a -> Text forall b a. (Show a, IsString b) => a -> b show a a) {-# inline dbgs_ #-} dbgs_ :: HasCallStack => Monad m => Show a => a -> m a dbgs_ :: a -> m a dbgs_ a a = a a a -> m () -> m a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ SrcLoc -> Text -> m () forall (m :: * -> *). Monad m => SrcLoc -> Text -> m () debugPrintWithLoc (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) (a -> Text forall b a. (Show a, IsString b) => a -> b show a a) {-# inline dbgs #-} tr :: HasCallStack => Text -> a -> a tr :: Text -> a -> a tr Text msg a a = IO a -> a forall a. IO a -> a unsafePerformIO (a a a -> IO () -> IO a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ SrcLoc -> Text -> IO () debugPrint (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) Text msg) {-# inline tr #-} trs :: Show a => HasCallStack => a -> a trs :: a -> a trs a a = IO a -> a forall a. IO a -> a unsafePerformIO (a a a -> IO () -> IO a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ SrcLoc -> Text -> IO () debugPrint (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) (a -> Text forall b a. (Show a, IsString b) => a -> b show a a)) {-# inline trs #-} trs' :: Show b => HasCallStack => b -> a -> a trs' :: b -> a -> a trs' b b a a = IO a -> a forall a. IO a -> a unsafePerformIO (a a a -> IO () -> IO a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ SrcLoc -> Text -> IO () debugPrint (CallStack -> SrcLoc srcLoc CallStack HasCallStack => CallStack callStack) (b -> Text forall b a. (Show a, IsString b) => a -> b show b b)) {-# inline trs' #-}