{-# OPTIONS_GHC -Wno-missing-methods #-} -- For TH.Quasi
-- | This module enables to 'showCode'
-- without requiring to be in 'IO'.
module Language.Haskell.TH.Show where

import Data.Function (($), (.))
import Data.String (String)
import Prelude (Integer, error, succ)
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Functor (Functor)
import qualified Control.Monad as CM
import qualified Control.Monad.IO.Class as CM
import qualified Control.Monad.Trans.State as MT
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import qualified Language.Haskell.TH.Ppr as TH
import qualified Language.Haskell.TH.PprLib as TH
import qualified Text.PrettyPrint as Doc

newtype ShowQ a = ShowQ { unShowQ :: MT.State Integer a }
  deriving (Functor, Applicative, Monad)

runShowQ :: ShowQ a -> a
runShowQ = (`MT.evalState` 0) . unShowQ

showCode :: TH.Precedence -> TH.CodeQ a -> String
showCode p q = runShowQ $ do
  texp <- TH.runQ (TH.examineCode q)
  return $ Doc.render $ TH.to_HPJ_Doc $ TH.pprExp p $ TH.unType texp

-- | The whole point of ShowQ is to remove the need for IO,
-- but GHC's 'TH.Quasi' class forces it...
instance CM.MonadIO ShowQ
instance CM.MonadFail ShowQ where
  fail = error
-- | Only 'TH.qNewName' is needed and thus implemented.
instance TH.Quasi ShowQ where
  qNewName n = ShowQ $ do
    i <- MT.get
    MT.put (succ i)
    return (TH.mkNameU n i)

-- | Like 'TH.liftString' but on 'TH.Code'.
-- Useful to get a 'TH.StringL' instead of a 'TH.ListE'.
liftTypedString :: String -> TH.Code TH.Q a
liftTypedString = TH.unsafeCodeCoerce . TH.liftString