{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
-- | Verbose pass tracing for the HSE front end (the haskell-src-exts
--   halves of what ReWire.Pass used to provide; the HSE-free scaffolding
--   stays in rewire-frontend).
module ReWire.HSE.PassInfo
      ( printInfoTop
      , printInfoHSE
      ) where

import ReWire.HSE.Rename (Renamer, allExports)
import ReWire.Pass (printHeader)
import ReWire.Pretty (showt)

import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Text (Text)

import qualified Data.Text.IO                 as T
import qualified Language.Haskell.Exts.Pretty as P
import qualified Language.Haskell.Exts.Syntax as S (Module (..))

-- | Dump the header plus (when verbose) the renamer, exports, imports, and
--   the Show'd module. The imports and module are taken pre-rendered so
--   callers can choose the rendering.
printInfoTop :: MonadIO m => Text -> Renamer -> Text -> Bool -> Text -> m ()
printInfoTop :: forall (m :: * -> *).
MonadIO m =>
Text -> Renamer -> Text -> Bool -> Text -> m ()
printInfoTop Text
hd Renamer
rn Text
imps Bool
verbose Text
m = do
      Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printHeader Text
hd
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
"\n-- ## Renamer:\n"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Renamer -> Text
forall a. TextShow a => a -> Text
showt Renamer
rn
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
"\n-- ## Exports:\n"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Exports -> Text
forall a. TextShow a => a -> Text
showt (Exports -> Text) -> Exports -> Text
forall a b. (a -> b) -> a -> b
$ Renamer -> Exports
allExports Renamer
rn
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
"\n-- ## Show imps:\n"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
imps
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
"\n-- ## Show mod:\n"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
m

printInfoHSE :: MonadIO m => Text -> Renamer -> Text -> Bool -> S.Module a -> m (S.Module a)
printInfoHSE :: forall (m :: * -> *) a.
MonadIO m =>
Text -> Renamer -> Text -> Bool -> Module a -> m (Module a)
printInfoHSE Text
hd Renamer
rn Text
imps Bool
verbose Module a
hse = do
      Text -> Renamer -> Text -> Bool -> Text -> m ()
forall (m :: * -> *).
MonadIO m =>
Text -> Renamer -> Text -> Bool -> Text -> m ()
printInfoTop Text
hd Renamer
rn Text
imps Bool
verbose (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Module () -> Text
forall a. TextShow a => a -> Text
showt (Module () -> Text) -> Module () -> Text
forall a b. (a -> b) -> a -> b
$ Module a -> Module ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Module a
hse
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text -> IO ()
T.putStrLn Text
"\n-- ## Pretty HSE mod:\n"
      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
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Module () -> String
forall a. Pretty a => a -> String
P.prettyPrint (Module () -> String) -> Module () -> String
forall a b. (a -> b) -> a -> b
$ Module a -> Module ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Module a
hse
      Module a -> m (Module a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Module a
hse