{-# LANGUAGE DataKinds #-} -- for 9.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImplicitParams #-}
module Debug.Breakpoint
  ( -- * Plugin
    plugin
    -- * API
  , breakpoint
  , breakpointM
  , breakpointIO
  , queryVars
  , queryVarsM
  , queryVarsIO
  , excludeVars
    -- * Internals
  , captureVars
  , showLev
  , fromAscList
  , printAndWait
  , printAndWaitM
  , printAndWaitIO
  , runPrompt
  , runPromptM
  , runPromptIO
  , getSrcLoc
  ) where

import           Control.DeepSeq (force)
import           Control.Monad.IO.Class
import           Data.Char (isSpace)
import           Data.Foldable
import           Data.Functor
import qualified Data.List as L
import qualified Data.Map.Lazy as M
import           Data.Maybe
import qualified Data.Text.Lazy as T
import           Debug.Trace (trace, traceIO, traceM)
import qualified GHC.Exts as Exts
import           GHC.Int
import           GHC.Word
import qualified System.Console.ANSI as ANSI
import qualified System.Console.Haskeline as HL
import           System.Environment (lookupEnv)
import           System.IO (stdout)
import           System.IO.Unsafe (unsafePerformIO)
import qualified Text.Pretty.Simple as PS
import qualified Text.Pretty.Simple.Internal.Color as PS

import qualified Debug.Breakpoint.GhcFacade as Ghc
import qualified Debug.Breakpoint.Renamer as Renamer
import qualified Debug.Breakpoint.TimerManager as TM
import qualified Debug.Breakpoint.TypeChecker as TypeChecker

--------------------------------------------------------------------------------
-- API
--------------------------------------------------------------------------------

-- | Constructs a lazy 'Map' from the names of all visible variables at the call
-- site to a string representation of their value. Does not include any variables
-- whose definitions contain it. Be careful not to assign multiple variables to
-- `captureVars` in the same scope as this will result in an infinite recursion.
captureVars :: M.Map String String
captureVars :: Map String String
captureVars = Map String String
forall a. Monoid a => a
mempty

-- re-exported to avoid requiring the client to depend on the containers package
fromAscList :: Ord k => [(k, v)] -> M.Map k v
fromAscList :: forall k v. Ord k => [(k, v)] -> Map k v
fromAscList = [(k, v)] -> Map k v
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList

printAndWait :: String -> M.Map String String -> a -> a
printAndWait :: forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars a
x =
  IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE printAndWait #-}

printAndWaitM :: Applicative m => String -> M.Map String String -> m ()
printAndWaitM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
printAndWaitM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

printAndWaitIO :: MonadIO m => String -> M.Map String String -> m ()
printAndWaitIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
useColor <- Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
  let ?useColor = ?useColor::Bool
Bool
useColor
  Bool
prettyPrint <- IO Bool
usePrettyPrinting
  let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
  let !printedVars :: String
printedVars = String -> String
forall a. NFData a => a -> a
force ((?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
Map String String -> String
printVars Map String String
vars)
  IO () -> IO ()
forall a. IO a -> IO a
TM.suspendTimeouts (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
traceIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n"
      [ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      , String
printedVars
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Press enter to continue"
      ]
    IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Int
blockOnInput

runPrompt :: String -> M.Map String String -> a -> a
runPrompt :: forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars a
x =
  IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE runPrompt #-}

runPromptM :: Applicative m => String -> M.Map String String -> m ()
runPromptM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
runPromptM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runPromptIO :: forall m. MonadIO m => String -> M.Map String String -> m ()
runPromptIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (InputT IO () -> IO ()) -> InputT IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior -> Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Behavior -> Settings m -> InputT m a -> m a
HL.runInputTBehavior Behavior
HL.defaultBehavior Settings IO
settings (InputT IO () -> m ()) -> InputT IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
useColor <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InputT IO Bool) -> IO Bool -> InputT IO Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
    let ?useColor = ?useColor::Bool
Bool
useColor
    Bool
prettyPrint <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
usePrettyPrinting
    let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
    let printVar :: String -> String -> InputT m ()
printVar String
var String
val =
          String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT m ()) -> String -> InputT m ()
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" =\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ (?prettyPrint::Bool) => String -> String
String -> String
prettify String
val
        inputLoop :: InputT IO ()
inputLoop = do
          Maybe String
mInp <- String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
HL.getInputLine (String -> InputT IO (Maybe String))
-> String -> InputT IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Enter variable name: "
          case Maybe String
mInp of
            Just ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace -> String
inp)
              | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
inp) -> do
                  (String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> String -> InputT IO ()
forall {m :: * -> *}.
(MonadIO m, ?useColor::Bool, ?prettyPrint::Bool) =>
String -> String -> InputT m ()
printVar String
inp) (Maybe String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
inp Map String String
vars
                  InputT IO ()
inputLoop
            Maybe String
_ -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT IO ())
-> ([String] -> String) -> [String] -> InputT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> InputT IO ()) -> [String] -> InputT IO ()
forall a b. (a -> b) -> a -> b
$
      [ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
varNames)
    InputT IO ()
inputLoop
  where
    settings :: Settings IO
settings = CompletionFunc IO -> Settings IO -> Settings IO
forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
HL.setComplete CompletionFunc IO
completion Settings IO
forall (m :: * -> *). MonadIO m => Settings m
HL.defaultSettings
    completion :: CompletionFunc IO
completion = Maybe Char
-> (Char -> Bool)
-> (String -> IO [Completion])
-> CompletionFunc IO
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
HL.completeWord' Maybe Char
forall a. Maybe a
Nothing Char -> Bool
isSpace ((String -> IO [Completion]) -> CompletionFunc IO)
-> (String -> IO [Completion]) -> CompletionFunc IO
forall a b. (a -> b) -> a -> b
$ \String
str ->
      [Completion] -> IO [Completion]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> IO [Completion])
-> [Completion] -> IO [Completion]
forall a b. (a -> b) -> a -> b
$ String -> Completion
HL.simpleCompletion
        (String -> Completion) -> [String] -> [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
str String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) [String]
varNames
    varNames :: [String]
varNames = Map String String -> [String]
forall k a. Map k a -> [k]
M.keys Map String String
vars

usePrettyPrinting :: IO Bool
usePrettyPrinting :: IO Bool
usePrettyPrinting = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"NO_PRETTY_PRINT"

color :: (?useColor :: Bool) => String -> String -> String
color :: (?useColor::Bool) => String -> String -> String
color String
c String
s =
  if ?useColor::Bool
Bool
?useColor
     then String
"\ESC[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"m\STX" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\ESC[m\STX"
     else String
s

red, green, grey, cyan :: String
red :: String
red = String
"31"
green :: String
green = String
"32"
grey :: String
grey = String
"37"
cyan :: String
cyan = String
"36"

printVars :: (?useColor :: Bool, ?prettyPrint :: Bool)
          => M.Map String String -> String
printVars :: (?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
printVars Map String String
vars =
  let eqSign :: String
eqSign | ?prettyPrint::Bool
Bool
?prettyPrint = String
" =\n"
             | Bool
otherwise = String
" = "
      mkLine :: (String, String) -> String
mkLine (String
k, String
v) = (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
eqSign) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (?prettyPrint::Bool) => String -> String
String -> String
prettify String
v
   in [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
L.intersperse String
"" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool, ?prettyPrint::Bool) => (String, String) -> String
(String, String) -> String
mkLine ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList Map String String
vars

-- TODO don't apply parsing to things inside angle brackets
prettify :: (?prettyPrint :: Bool) => String -> String
prettify :: (?prettyPrint::Bool) => String -> String
prettify =
  if ?prettyPrint::Bool
Bool
?prettyPrint
  then Text -> String
T.unpack
     (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> String -> Text
PS.pStringOpt
         OutputOptions
PS.defaultOutputOptionsDarkBg
           { PS.outputOptionsInitialIndent = 2
           , PS.outputOptionsIndentAmount = 2
           , PS.outputOptionsColorOptions = Just PS.ColorOptions
             { PS.colorQuote = PS.colorNull
             , PS.colorString = PS.colorBold PS.Vivid PS.Blue
             , PS.colorError = PS.colorBold PS.Vivid PS.Red
             , PS.colorNum = PS.colorBold PS.Vivid PS.Green
             , PS.colorRainbowParens = [PS.colorBold PS.Vivid PS.Cyan]
             }
           }
  else String -> String
forall a. a -> a
id

inactivePluginStr :: String
inactivePluginStr :: String
inactivePluginStr =
  String
"Cannot set breakpoint: the Debug.Trace plugin is not active"

-- | Sets a breakpoint in pure code
breakpoint :: a -> a
breakpoint :: forall a. a -> a
breakpoint = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr

-- | When evaluated, displays the names of variables visible from the callsite
-- and starts a prompt where entering a variable will display its value. You
-- may want to use this instead of 'breakpoint' if there are value which should
-- stay unevaluated or you are only interested in certain values. Only the
-- current thread is blocked while the prompt is active. To resume execution,
-- press enter with a blank prompt.
queryVars :: a -> a
queryVars :: forall a. a -> a
queryVars = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr

-- | Similar to 'queryVars' but for use in an arbitrary 'Applicative' context.
-- This uses 'unsafePerformIO' which means that laziness and common sub-expression
-- elimination can result in unexpected behavior. For this reason you should
-- prefer 'queryVarsIO' if a 'MonadIO' instance is available.
queryVarsM :: Applicative m => m ()
queryVarsM :: forall (m :: * -> *). Applicative m => m ()
queryVarsM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr

-- | Similar to 'queryVars' but specialized to an 'IO' context. You should favor
-- this over 'queryVarsM' if a 'MonadIO' instance is available.
queryVarsIO :: MonadIO m => m ()
queryVarsIO :: forall (m :: * -> *). MonadIO m => m ()
queryVarsIO =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)

-- | Sets a breakpoint in an arbitrary 'Applicative'. Uses 'unsafePerformIO'
-- which means that laziness and common sub-expression elimination can result
-- in the breakpoint not being hit as expected. For this reason, you should
-- prefer 'breakpointIO' if a `MonadIO` instance is available.
breakpointM :: Applicative m => m ()
breakpointM :: forall (m :: * -> *). Applicative m => m ()
breakpointM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr

-- | Sets a breakpoint in an 'IO' based 'Monad'. You should favor this over
-- 'breakpointM' if the monad can perform IO.
breakpointIO :: MonadIO m => m ()
breakpointIO :: forall (m :: * -> *). MonadIO m => m ()
breakpointIO =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)

-- | Pretty prints the source code location of its call site
getSrcLoc :: String
getSrcLoc :: String
getSrcLoc = String
""

-- Use an "unsafe" foreign function to more or less stop the runtime.
foreign import ccall unsafe "stdio.h getchar" blockOnInput :: IO Int

-- | Excludes the given variable names from appearing in the output of any
-- breakpoints occurring in the given expression.
excludeVars :: [String] -> a -> a
excludeVars :: forall a. [String] -> a -> a
excludeVars [String]
_ = a -> a
forall a. a -> a
id

--------------------------------------------------------------------------------
-- Plugin
--------------------------------------------------------------------------------

plugin :: Ghc.Plugin
plugin :: Plugin
plugin = Plugin
Ghc.defaultPlugin
  { Ghc.pluginRecompile = Ghc.purePlugin
  , Ghc.renamedResultAction = const Renamer.renameAction
  , Ghc.tcPlugin = const $ Just TypeChecker.tcPlugin
  }

--------------------------------------------------------------------------------
-- Showing
--------------------------------------------------------------------------------

-- | Levity polymorphic 'Show'
class ShowLev (rep :: Exts.RuntimeRep) (a :: Exts.TYPE rep) where
  showLev :: a -> String

instance ShowLev 'Exts.IntRep Exts.Int# where
  showLev :: Int# -> String
showLev Int#
i = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
i

instance ShowLev 'Exts.Int8Rep Exts.Int8# where
  showLev :: Int8# -> String
showLev Int8#
i = Int8 -> String
forall a. Show a => a -> String
show (Int8 -> String) -> Int8 -> String
forall a b. (a -> b) -> a -> b
$ Int8# -> Int8
I8# Int8#
i

instance ShowLev 'Exts.Int16Rep Exts.Int16# where
  showLev :: Int16# -> String
showLev Int16#
i = Int16 -> String
forall a. Show a => a -> String
show (Int16 -> String) -> Int16 -> String
forall a b. (a -> b) -> a -> b
$ Int16# -> Int16
I16# Int16#
i

instance ShowLev 'Exts.Int32Rep Exts.Int32# where
  showLev :: Int32# -> String
showLev Int32#
i = Int32 -> String
forall a. Show a => a -> String
show (Int32 -> String) -> Int32 -> String
forall a b. (a -> b) -> a -> b
$ Int32# -> Int32
I32# Int32#
i

#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Int64Rep Exts.Int64# where
  showLev :: Int64# -> String
showLev Int64#
i = Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Int64# -> Int64
I64# Int64#
i
#endif

instance ShowLev 'Exts.WordRep Exts.Word# where
  showLev :: Word# -> String
showLev Word#
w = Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
w

instance ShowLev 'Exts.Word8Rep Exts.Word8# where
  showLev :: Word8# -> String
showLev Word8#
w = Word8 -> String
forall a. Show a => a -> String
show (Word8 -> String) -> Word8 -> String
forall a b. (a -> b) -> a -> b
$ Word8# -> Word8
W8# Word8#
w

instance ShowLev 'Exts.Word16Rep Exts.Word16# where
  showLev :: Word16# -> String
showLev Word16#
w = Word16 -> String
forall a. Show a => a -> String
show (Word16 -> String) -> Word16 -> String
forall a b. (a -> b) -> a -> b
$ Word16# -> Word16
W16# Word16#
w

instance ShowLev 'Exts.Word32Rep Exts.Word32# where
  showLev :: Word32# -> String
showLev Word32#
w = Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String) -> Word32 -> String
forall a b. (a -> b) -> a -> b
$ Word32# -> Word32
W32# Word32#
w

#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Word64Rep Exts.Word64# where
  showLev :: Word64# -> String
showLev Word64#
w = Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Word64# -> Word64
W64# Word64#
w
#endif

instance ShowLev 'Exts.FloatRep Exts.Float# where
  showLev :: Float# -> String
showLev Float#
f = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Float# -> Float
Exts.F# Float#
f

instance ShowLev 'Exts.DoubleRep Exts.Double# where
  showLev :: Double# -> String
showLev Double#
d = Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double# -> Double
Exts.D# Double#
d

newtype ShowWrapper a = MkShowWrapper a

instance ShowLev Exts.LiftedRep a => Show (ShowWrapper a) where
  show :: ShowWrapper a -> String
show (MkShowWrapper a
a) = a -> String
forall a. ShowLev LiftedRep a => a -> String
showLev a
a

class Succeed a where
  _succeed :: a -> String

-- Looking up an instance of this class for any type will always succeed. To
-- produce actual evidence, a Show dict must be provided.
instance Show a => Succeed a where
  _succeed :: a -> String
_succeed = a -> String
forall a. Show a => a -> String
show